diff options
Diffstat (limited to 'lib/kernel/test')
169 files changed, 46067 insertions, 0 deletions
diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile new file mode 100644 index 0000000000..ffad998d96 --- /dev/null +++ b/lib/kernel/test/Makefile @@ -0,0 +1,149 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 1997-2009. 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% +# +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +MODULES= \ + rpc_SUITE \ + pdict_SUITE \ + bif_SUITE \ + kernel_SUITE \ + application_SUITE \ + myApp \ + topApp \ + topApp2 \ + topApp3 \ + ch \ + ch_sup \ + appinc1 \ + appinc1x \ + appinc2 \ + appinc2top \ + appinc2A \ + appinc2B \ + code_SUITE \ + code_b_test \ + disk_log_SUITE \ + erl_boot_server_SUITE \ + erl_distribution_SUITE \ + erl_distribution_wb_SUITE \ + erl_prim_loader_SUITE \ + error_logger_SUITE \ + error_logger_warn_SUITE \ + file_SUITE \ + prim_file_SUITE \ + ram_file_SUITE \ + gen_tcp_api_SUITE \ + gen_tcp_echo_SUITE \ + gen_tcp_misc_SUITE \ + gen_udp_SUITE \ + gen_sctp_SUITE \ + global_SUITE \ + global_group_SUITE \ + heart_SUITE \ + inet_SUITE \ + inet_sockopt_SUITE \ + inet_res_SUITE \ + interactive_shell_SUITE \ + init_SUITE \ + kernel_config_SUITE \ + os_SUITE \ + pg2_SUITE \ + seq_trace_SUITE \ + wrap_log_reader_SUITE \ + cleanup \ + zlib_SUITE \ + loose_node + +APP_FILES = \ + appinc.app \ + appinc1.app \ + appinc1x.app \ + appinc2.app \ + appinc2top.app \ + appinc2A.app \ + appinc2B.app \ + myApp.app \ + topApp.app \ + topApp2.app \ + topApp3.app + +ERL_FILES= $(MODULES:%=%.erl) code_a_test.erl + +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) +INSTALL_PROGS= $(TARGET_FILES) + +EMAKEFILE=Emakefile +COVERFILE=kernel.cover + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/kernel_test + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +ERL_MAKE_FLAGS += +ERL_COMPILE_FLAGS += -I$(ERL_TOP)/lib/test_server/include + +EBIN = . + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +make_emakefile: + $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' \ + >> $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ + >> $(EMAKEFILE) + +tests debug opt: make_emakefile + erl $(ERL_MAKE_FLAGS) -make + +clean: + rm -f $(EMAKEFILE) + rm -f $(TARGET_FILES) $(GEN_FILES) + rm -f core + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + +release_tests_spec: make_emakefile + $(INSTALL_DIR) $(RELSYSDIR) + $(INSTALL_DATA) $(ERL_FILES) $(RELSYSDIR) + $(INSTALL_DATA) $(APP_FILES) $(RELSYSDIR) + $(INSTALL_DATA) kernel.dynspec $(EMAKEFILE)\ + $(COVERFILE) $(RELSYSDIR) + chmod -f -R u+w $(RELSYSDIR) + @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) + +release_docs_spec: diff --git a/lib/kernel/test/appinc.app b/lib/kernel/test/appinc.app new file mode 100644 index 0000000000..43c475530f --- /dev/null +++ b/lib/kernel/test/appinc.app @@ -0,0 +1,10 @@ +{application, appinc, + [{description, "Test of new app file, including appnew"}, + {id, "CXC 138 ai"}, + {vsn, "2.0"}, + {applications, [kernel]}, + {modules, []}, + {registered, []}, + {included_applications, [appinc1, appinc2]}, + {start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]}, + {mod, {application_starter, [ch_sup, {appinc, 41, 43}] }}]}. diff --git a/lib/kernel/test/appinc1.app b/lib/kernel/test/appinc1.app new file mode 100644 index 0000000000..8ff8c7fd89 --- /dev/null +++ b/lib/kernel/test/appinc1.app @@ -0,0 +1,9 @@ +{application, appinc1, + [{description, "Test of new start, no inc file"}, + {id, "CXC 138 xx1"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {start_phases, [{go, [goArgs1]}]}, + {mod, {appinc1, [ch_sup, start, {app1, 55, 57}] }}]}. diff --git a/lib/kernel/test/appinc1.erl b/lib/kernel/test/appinc1.erl new file mode 100644 index 0000000000..8456b0eac2 --- /dev/null +++ b/lib/kernel/test/appinc1.erl @@ -0,0 +1,49 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(appinc1). + +%% External exports +-export([start/2, stop/1]). +-export([start_phase/3]). + +%% Internal exports +-export([init/1]). + +start(_Type, [_M,_F,{_AppN, Low, High}]) -> + Name = list_to_atom(lists:concat([ch_sup, Low])), + {ok, P} = supervisor:start_link({local, Name}, appinc1, + lists:seq(Low, High)), + {ok, P, []}. + +stop(_) -> + ok. + +init(Nos) -> + SupFlags = {one_for_one, 12, 60}, + Chs = lists:map(fun(No) -> + {list_to_atom(lists:concat([ch,No])), + {ch, start_link, [{ch, No}]}, + permanent, 2000, worker, [ch]} + end, + Nos), + {ok, {SupFlags, Chs}}. + +start_phase(Phase, _Type, _Args) -> + (catch global:send(start_phase,{sp, Phase})), + ok. diff --git a/lib/kernel/test/appinc1x.app b/lib/kernel/test/appinc1x.app new file mode 100644 index 0000000000..5b374c7735 --- /dev/null +++ b/lib/kernel/test/appinc1x.app @@ -0,0 +1,9 @@ +{application, appinc1x, + [{description, "Test of new start"}, + {id, "CXC 138 xx1"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {start_phases, [{spec, [specArgs1]}, {go, [goArgs1]}]}, + {mod, {appinc1x, [arg1, arg2, arg3] }}]}. diff --git a/lib/kernel/test/appinc1x.erl b/lib/kernel/test/appinc1x.erl new file mode 100644 index 0000000000..2e177727f2 --- /dev/null +++ b/lib/kernel/test/appinc1x.erl @@ -0,0 +1,49 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(appinc1x). + +%% External exports +-export([start/2, stop/1]). +-export([start_phase/3]). + +%% Internal exports +-export([init/1]). + +start(_Type, [_M,_F,{_AppN, Low, High}]) -> + Name = list_to_atom(lists:concat([ch_sup, Low])), + {ok, P} = supervisor:start_link({local, Name}, appinc1x, + lists:seq(Low, High)), + {ok, P, []}. + +stop(_) -> + ok. + +init(Nos) -> + SupFlags = {one_for_one, 12, 60}, + Chs = lists:map(fun(No) -> + {list_to_atom(lists:concat([ch,No])), + {ch, start_link, [{ch, No}]}, + permanent, 2000, worker, [ch]} + end, + Nos), + {ok, {SupFlags, Chs}}. + +start_phase(Phase, _Type, _Args) -> + (catch global:send(start_phase,{sp, Phase})), + ok. diff --git a/lib/kernel/test/appinc2.app b/lib/kernel/test/appinc2.app new file mode 100644 index 0000000000..9dd2dc6d05 --- /dev/null +++ b/lib/kernel/test/appinc2.app @@ -0,0 +1,9 @@ +{application, appinc2, + [{description, "Test of new start, no inc file"}, + {id, "CXC 138 xx2"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {start_phases, [{init, [initArgs2]}, {go, [goArgs2]}]}, + {mod, {appinc2, [ch_sup, start, {app1, 55, 57}] }}]}. diff --git a/lib/kernel/test/appinc2.erl b/lib/kernel/test/appinc2.erl new file mode 100644 index 0000000000..e41d58bb71 --- /dev/null +++ b/lib/kernel/test/appinc2.erl @@ -0,0 +1,49 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(appinc2). + +%% External exports +-export([start/2, stop/1]). +-export([start_phase/3]). + +%% Internal exports +-export([init/1]). + +start(_Type, [_M,_F,{_AppN, Low, High}]) -> + Name = list_to_atom(lists:concat([ch_sup, Low])), + {ok, P} = supervisor:start_link({local, Name}, appinc2, + lists:seq(Low, High)), + {ok, P, []}. + +stop(_) -> + ok. + +init(Nos) -> + SupFlags = {one_for_one, 12, 60}, + Chs = lists:map(fun(No) -> + {list_to_atom(lists:concat([ch,No])), + {ch, start_link, [{ch, No}]}, + permanent, 2000, worker, [ch]} + end, + Nos), + {ok, {SupFlags, Chs}}. + +start_phase(Phase, _Type, _Args) -> + (catch global:send(start_phase,{sp, Phase})), + ok. diff --git a/lib/kernel/test/appinc2A.app b/lib/kernel/test/appinc2A.app new file mode 100644 index 0000000000..2b04ae2190 --- /dev/null +++ b/lib/kernel/test/appinc2A.app @@ -0,0 +1,9 @@ +{application, appinc2A, + [{description, "Test of new start"}, + {id, "CXC 138 xx2"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {start_phases, [{some, [someArgs2A]}, {go, [goArgs2A]}]}, + {mod, {appinc2A, [arg1, arg2] }}]}. diff --git a/lib/kernel/test/appinc2A.erl b/lib/kernel/test/appinc2A.erl new file mode 100644 index 0000000000..b51a1f5035 --- /dev/null +++ b/lib/kernel/test/appinc2A.erl @@ -0,0 +1,49 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(appinc2A). + +%% External exports +-export([start/2, stop/1]). +-export([start_phase/3]). + +%% Internal exports +-export([init/1]). + +start(_Type, [_M,_F,{_AppN, Low, High}]) -> + Name = list_to_atom(lists:concat([ch_sup, Low])), + {ok, P} = supervisor:start_link({local, Name}, appinc2A, + lists:seq(Low, High)), + {ok, P, []}. + +stop(_) -> + ok. + +init(Nos) -> + SupFlags = {one_for_one, 12, 60}, + Chs = lists:map(fun(No) -> + {list_to_atom(lists:concat([ch,No])), + {ch, start_link, [{ch, No}]}, + permanent, 2000, worker, [ch]} + end, + Nos), + {ok, {SupFlags, Chs}}. + +start_phase(Phase, _Type, _Args) -> + (catch global:send(start_phase,{sp, Phase})), + ok. diff --git a/lib/kernel/test/appinc2B.app b/lib/kernel/test/appinc2B.app new file mode 100644 index 0000000000..a1d7e3529d --- /dev/null +++ b/lib/kernel/test/appinc2B.app @@ -0,0 +1,9 @@ +{application, appinc2B, + [{description, "Test of new start"}, + {id, "CXC 138 xx2"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {start_phases, [{init, [initArgs2B]}]}, + {mod, {appinc2B, [arg1, arg2] }}]}. diff --git a/lib/kernel/test/appinc2B.erl b/lib/kernel/test/appinc2B.erl new file mode 100644 index 0000000000..cafb061ae3 --- /dev/null +++ b/lib/kernel/test/appinc2B.erl @@ -0,0 +1,49 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(appinc2B). + +%% External exports +-export([start/2, stop/1]). +-export([start_phase/3]). + +%% Internal exports +-export([init/1]). + +start(_Type, [_M,_F,{_AppN, Low, High}]) -> + Name = list_to_atom(lists:concat([ch_sup, Low])), + {ok, P} = supervisor:start_link({local, Name}, appinc2B, + lists:seq(Low, High)), + {ok, P, []}. + +stop(_) -> + ok. + +init(Nos) -> + SupFlags = {one_for_one, 12, 60}, + Chs = lists:map(fun(No) -> + {list_to_atom(lists:concat([ch,No])), + {ch, start_link, [{ch, No}]}, + permanent, 2000, worker, [ch]} + end, + Nos), + {ok, {SupFlags, Chs}}. + +start_phase(Phase, _Type, _Args) -> + (catch global:send(start_phase,{sp, Phase})), + ok. diff --git a/lib/kernel/test/appinc2top.app b/lib/kernel/test/appinc2top.app new file mode 100644 index 0000000000..b7758a33cf --- /dev/null +++ b/lib/kernel/test/appinc2top.app @@ -0,0 +1,10 @@ +{application, appinc2top, + [{description, "Test of new start"}, + {id, "CXC 138 xx2"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {included_applications, [appinc2A, appinc2B]}, + {applications, [kernel]}, + {start_phases, [{init, []}, {some, []}, {go, []}]}, + {mod, {application_starter, [appinc2top, {app1, 107, 109}] }}]}. diff --git a/lib/kernel/test/appinc2top.erl b/lib/kernel/test/appinc2top.erl new file mode 100644 index 0000000000..5bd19a59e7 --- /dev/null +++ b/lib/kernel/test/appinc2top.erl @@ -0,0 +1,49 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(appinc2top). + +%% External exports +-export([start/2, stop/1]). +-export([start_phase/3]). + +%% Internal exports +-export([init/1]). + +start(_Type, [_M,_F,{_AppN, Low, High}]) -> + Name = list_to_atom(lists:concat([ch_sup, Low])), + {ok, P} = supervisor:start_link({local, Name}, appinc2top, + lists:seq(Low, High)), + {ok, P, []}. + +stop(_) -> + ok. + +init(Nos) -> + SupFlags = {one_for_one, 12, 60}, + Chs = lists:map(fun(No) -> + {list_to_atom(lists:concat([ch,No])), + {ch, start_link, [{ch, No}]}, + permanent, 2000, worker, [ch]} + end, + Nos), + {ok, {SupFlags, Chs}}. + +start_phase(Phase, _Type, _Args) -> + (catch global:send(start_phase,{sp, Phase})), + ok. diff --git a/lib/kernel/test/application_SUITE.erl b/lib/kernel/test/application_SUITE.erl new file mode 100644 index 0000000000..313b50f976 --- /dev/null +++ b/lib/kernel/test/application_SUITE.erl @@ -0,0 +1,2734 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. 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(application_SUITE). + +-include("test_server.hrl"). + +-export([all/1, failover/1, failover_comp/1, permissions/1, load/1, reported_bugs/1, + load_use_cache/1, + otp_1586/1, otp_2078/1, otp_2012/1, otp_2718/1, otp_2973/1, + otp_3002/1, otp_3184/1, otp_4066/1, otp_4227/1, otp_5363/1, + otp_5606/1, + start_phases/1, get_key/1, + permit_false_start_local/1, permit_false_start_dist/1, script_start/1, + nodedown_start/1, init2973/0, loop2973/0, loop5606/1]). + +-export([config_change/1, + distr_changed/1, distr_changed_tc1/1, distr_changed_tc2/1, + shutdown_func/1, do_shutdown/1]). + +-define(TESTCASE, testcase_name). +-define(testcase, ?config(?TESTCASE, Config)). + +-export([init_per_testcase/2, fin_per_testcase/2, start_type/0, + start_phase/0, conf_change/0]). +% Default timetrap timeout (set in init_per_testcase). +-define(default_timeout, ?t:minutes(2)). + +all(suite) -> + [failover, failover_comp, permissions, load, + load_use_cache, reported_bugs, + start_phases, script_start, nodedown_start, + permit_false_start_local, permit_false_start_dist, + get_key, distr_changed, config_change, shutdown_func]. + + +init_per_testcase(otp_2973=Case, Config) -> + code:add_path(?config(data_dir,Config)), + ?line Dog = test_server:timetrap(?default_timeout), + [{?TESTCASE, Case}, {watchdog, Dog}|Config]; +init_per_testcase(Case, Config) -> + ?line Dog = test_server:timetrap(?default_timeout), + [{?TESTCASE, Case}, {watchdog, Dog}|Config]. + +fin_per_testcase(otp_2973, Config) -> + code:del_path(?config(data_dir,Config)), + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok; +fin_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +-define(UNTIL(Seq), loop_until_true(fun() -> Seq end)). + +-record(st, { + normal = 0, + local = 0, + takeover = 0, + failover = 0 + }). + +loop_until_true(Fun) -> + case Fun() of + true -> + ok; + _ -> + timer:sleep(100), + loop_until_true(Fun) + end. + +%%----------------------------------------------------------------- +%% Should be started in a CC view with: +%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3] +%%----------------------------------------------------------------- +failover(suite) -> []; +failover(doc) -> + ["Tests failover and takeover for distributed applications. Tests", + "start, load etc implicitly."]; +failover(Conf) when is_list(Conf) -> + %% start a help process to check the start type + StPid = spawn_link(?MODULE, start_type, []), + ?line yes = global:register_name(st_type, StPid), + + NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf), + NoSyncTime = config_fun_fast(config_fo(NodeNames)), + WithSyncTime = config_fun(config_fo(NodeNames)), + + % Test [cp1, cp2, cp3] + ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line {ok, Cp2} = start_node_config(Ncp2, NoSyncTime, Conf), + ?line {ok, Cp3} = start_node_config(Ncp3, WithSyncTime, Conf), + Cps = [Cp1, Cp2, Cp3], + ?line wait_for_ready_net(), + + % Start app1 and make sure cp1 starts it + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, load, [app1()]), + ?line ?UNTIL(is_loaded(app1, Cps)), + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, start, [app1, permanent]), + ?line ?UNTIL(is_started(app1, Cp1)), + ?line false = is_started(app1, Cp2), + ?line ok = get_start_type(#st{normal = 3}), + + % Stop cp1 and make sure cp2 starts app1 + stop_node_nice(Cp1), + ?line ?UNTIL(is_started(app1, Cp2)), + ?line ok = get_start_type(#st{normal = 3}), + + % Restart cp1 and make sure it restarts app1 + ?line {ok, Cp1_2} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line global:sync(), + ?line ok = rpc:call(Cp1_2, application, load, [app1()]), + ?line ok = rpc:call(Cp1_2, application, start, [app1, permanent]), + ?line ?UNTIL(is_started(app1, Cp1)), + ?line ?UNTIL(not is_started(app1, Cp2)), + ?line ok = get_start_type(#st{takeover = 3}), + + % Test [{cp1, cp2}, cp3] + % Start app_sp and make sure cp2 starts it (cp1 has more apps started) + ?line {[ok,ok,ok],[]} = + rpc:multicall([Cp1_2, Cp2, Cp3], application, load, [app_sp()]), + ?line {[ok,ok,ok],[]} = + rpc:multicall([Cp1_2, Cp2, Cp3], application, start,[app_sp,permanent]), + ?line ?UNTIL(is_started(app_sp, Cp2)), + ?line false = is_started(app_sp, Cp1), + ?line false = is_started(app_sp, Cp3), + ?line ok = get_start_type(#st{normal = 3}), + + % Stop cp2 and make sure cp1 starts app_sp + stop_node_nice(Cp2), + ?line ?UNTIL(is_started(app_sp, Cp1_2)), + ?line ok = get_start_type(#st{failover = 3}), + + % Stop cp1 and make sure cp3 starts app_sp + stop_node_nice(Cp1_2), + ?line ?UNTIL(is_started(app_sp, Cp3)), + ?line ok = get_start_type(#st{normal = 3, failover = 3}), + + % Restart cp2 and make sure it restarts app_sp + ?line {ok, Cp2_2} = start_node_config(Ncp2, NoSyncTime, Conf), + ?line global:sync(), + ?line ok = rpc:call(Cp2_2, application, load, [app_sp()]), + ?line ok = rpc:call(Cp2_2, application, start, [app_sp, permanent]), + ?line ?UNTIL(is_started(app_sp, Cp2_2)), + ?line ?UNTIL(not is_started(app_sp, Cp3)), + ?line ok = get_start_type(#st{takeover = 3}), + + % Restart cp1 and make sure it doesn't restart app_sp + ?line {ok, Cp1_3} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line global:sync(), + ?line ok = rpc:call(Cp1_3, application, load, [app_sp()]), + ?line ok = rpc:call(Cp1_3, application, start, [app_sp, permanent]), + test_server:sleep(500), + ?line false = is_started(app_sp, Cp1_3), + ?line true = is_started(app_sp, Cp2_2), + + % Force takeover to cp1 + ?line ok = rpc:call(Cp1_3, application, takeover, [app_sp, permanent]), + ?line ?UNTIL(is_started(app_sp, Cp1_3)), + ?line ?UNTIL(not is_started(app_sp, Cp2_2)), + ?line ok = get_start_type(#st{takeover = 3}), + + %% Kill one child process and see that it is started with type local + PP = global:whereis_name({ch,3}), + exit(PP, kill), + ?line ok = get_start_type(#st{local = 1}), + + global:send(st_type, kill), + + stop_node_nice(Cp1_3), + stop_node_nice(Cp2_2), + stop_node_nice(Cp3), + ok. + +%%----------------------------------------------------------------- +%% Should be started in a CC view with: +%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3] +%%----------------------------------------------------------------- +failover_comp(suite) -> []; +failover_comp(doc) -> + ["Tests failover and takeover for distributed applications. Tests", + "start, load etc implicitly. The applications do not use start_phases," + "i.e the failover should be trasfered to normal start type."]; +failover_comp(Conf) when is_list(Conf) -> + %% start a help process to check the start type + StPid = spawn_link(?MODULE, start_type, []), + ?line yes = global:register_name(st_type, StPid), + + NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf), + NoSyncTime = config_fun_fast(config(NodeNames)), + WithSyncTime = config_fun(config(NodeNames)), + + % Test [cp1, cp2, cp3] + ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line {ok, Cp2} = start_node_config(Ncp2, NoSyncTime, Conf), + ?line {ok, Cp3} = start_node_config(Ncp3, WithSyncTime, Conf), + Cps = [Cp1, Cp2, Cp3], + ?line wait_for_ready_net(), + + % Start app1 and make sure cp1 starts it + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, load, [app1()]), + ?line ?UNTIL(is_loaded(app1, Cps)), + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, start, [app1, permanent]), + ?line ?UNTIL(is_started(app1, Cp1)), + ?line false = is_started(app1, Cp2), + ?line ok = get_start_type(#st{normal = 3}), + + % Stop cp1 and make sure cp2 starts app1 + stop_node_nice(Cp1), + ?line ?UNTIL(is_started(app1, Cp2)), + ?line ok = get_start_type(#st{normal = 3}), + + % Restart cp1 and make sure it restarts app1 + ?line {ok, Cp1_2} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line global:sync(), + ?line ok = rpc:call(Cp1_2, application, load, [app1()]), + ?line ?UNTIL(is_loaded(app1, Cp1_2)), + ?line ok = rpc:call(Cp1_2, application, start, [app1, permanent]), + ?line ?UNTIL(is_started(app1, Cp1_2)), + ?line ?UNTIL(not is_started(app1, Cp2)), + ?line ok = get_start_type(#st{takeover = 3}), + + % Test [{cp1, cp2}, cp3] + % Start app3 and make sure cp2 starts it (cp1 has more apps started) + ?line {[ok,ok,ok],[]} = + rpc:multicall([Cp1_2, Cp2, Cp3], application, load, [app3()]), + ?line ?UNTIL(is_loaded(app3, [Cp1_2, Cp2, Cp3])), + ?line {[ok,ok,ok],[]} = + rpc:multicall([Cp1_2, Cp2, Cp3], application, start,[app3,permanent]), + ?line ?UNTIL(is_started(app3, Cp2)), + ?line false = is_started(app3, Cp1), + ?line false = is_started(app3, Cp3), + ?line ok = get_start_type(#st{normal = 3}), + + % Stop cp2 and make sure cp1 starts app3 + stop_node_nice(Cp2), + ?line ?UNTIL(is_started(app3, Cp1_2)), + ?line ok = get_start_type(#st{normal = 3}), + + % Stop cp1 and make sure cp3 starts app3 + stop_node_nice(Cp1_2), + ?line ?UNTIL(is_started(app3, Cp3)), + ?line ok = get_start_type(#st{normal = 6}), + + % Restart cp2 and make sure it restarts app3 + ?line {ok, Cp2_2} = start_node_config(Ncp2, NoSyncTime, Conf), + ?line global:sync(), + ?line ok = rpc:call(Cp2_2, application, load, [app3()]), + ?line ?UNTIL(is_loaded(app3, Cp2_2)), + ?line ok = rpc:call(Cp2_2, application, start, [app3, permanent]), + ?line ?UNTIL(is_started(app3, Cp2_2)), + ?line ?UNTIL(not is_started(app3, Cp3)), + ?line ok = get_start_type(#st{takeover = 3}), + + % Restart cp1 and make sure it doesn't restart app3 + ?line {ok, Cp1_3} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line global:sync(), + ?line ok = rpc:call(Cp1_3, application, load, [app3()]), + ?line true = is_loaded(app3, Cp1_3), + ?line ok = rpc:call(Cp1_3, application, start, [app3, permanent]), + test_server:sleep(5000), + ?line false = is_started(app3, Cp1_3), + ?line true = is_started(app3, Cp2_2), + + % Force takeover to cp1 + ?line ok = rpc:call(Cp1_3, application, takeover, [app3, permanent]), + ?line ?UNTIL(is_started(app3, Cp1_3)), + ?line ?UNTIL(not is_started(app3, Cp2_2)), + ?line ok = get_start_type(#st{takeover = 3}), + + %% Kill one child process and see that it is started with type local + PP = global:whereis_name({ch,3}), + exit(PP, kill), + ?line ok = get_start_type(#st{local = 1}), + + global:send(st_type, kill), + + stop_node_nice(Cp1_3), + stop_node_nice(Cp2_2), + stop_node_nice(Cp3), + ok. + +%%----------------------------------------------------------------- +%% Should be started in a CC view with: +%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3] +%%----------------------------------------------------------------- +permissions(suite) -> []; +permissions(doc) -> + ["Tests permissions for distributed applications."]; +permissions(Conf) when is_list(Conf) -> + + NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf), + NoSyncTime = config_fun_fast(config2(NodeNames)), + WithSyncTime = config_fun(config2(NodeNames)), + + % Test [cp1, cp2, cp3] + ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line {ok, Cp2} = start_node_config(Ncp2, NoSyncTime, Conf), + ?line {ok, Cp3} = start_node_config(Ncp3, WithSyncTime, Conf), + Cps = [Cp1, Cp2, Cp3], + ?line wait_for_ready_net(), + + % Start app1 and make sure cp1 starts it + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, load, [app1()]), + ?line ?UNTIL(is_loaded(app1, Cps)), + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, start, [app1, permanent]), + ?line ?UNTIL(is_started(app1, Cp1)), + ?line false = is_started(app1, Cp2), + + % Unpermit app1 on cp1, make sure cp2 starts it + ?line ok = rpc:call(Cp1, application, permit, [app1, false]), + ?line false = is_started(app1, Cp1), + ?line true = is_started(app1, Cp2), + + % Unpermit app1 on cp2, make sure cp3 starts it + ?line ok = rpc:call(Cp2, application, permit, [app1, false]), + ?line false = is_started(app1, Cp1), + ?line false = is_started(app1, Cp2), + ?line true = is_started(app1, Cp3), + + % Permit cp2 again + ?line ok = rpc:call(Cp2, application, permit, [app1, true]), + ?line false = is_started(app1, Cp1), + ?line false = is_started(app1, Cp3), + ?line true = is_started(app1, Cp2), + + % Start app3, make sure noone starts it + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, load, [app3()]), + ?line ?UNTIL(is_loaded(app3, Cps)), + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, start, [app3, permanent]), + test_server:sleep(1000), + ?line false = is_started(app3, Cp1), + ?line false = is_started(app3, Cp2), + ?line false = is_started(app3, Cp3), + + % Permit app3 on Cp3 + ?line ok = rpc:call(Cp3, application, permit, [app3, true]), + ?line true = is_started(app3, Cp3), + + % Permit app3 on Cp2, make sure it starts it + ?line ok = rpc:call(Cp2, application, permit, [app3, true]), + ?line true = is_started(app3, Cp2), + ?line false = is_started(app3, Cp3), + + % Permit app3 on Cp1, make sure it doesn't start it + ?line ok = rpc:call(Cp1, application, permit, [app3, true]), + ?line false = is_started(app3, Cp1), + ?line true = is_started(app3, Cp2), + ?line false = is_started(app3, Cp3), + + % Stop Cp2, make sure Cp1 starts app3 + stop_node_nice(Cp2), + ?line ?UNTIL(is_started(app3, Cp1)), + + stop_node_nice(Cp1), + stop_node_nice(Cp3), + ok. + +%%----------------------------------------------------------------- +%% Should be started in a CC view with: +%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3] +%%----------------------------------------------------------------- +load(suite) -> []; +load(doc) -> + ["Tests loading of distributed applications."]; +load(Conf) when is_list(Conf) -> + NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf), + NoSyncTime = config_fun_fast(config3(NodeNames)), + WithSyncTime = config_fun(config3(NodeNames)), + + % Test [cp1, cp2, cp3] + ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line {ok, Cp2} = start_node_config(Ncp2, NoSyncTime, Conf), + ?line {ok, Cp3} = start_node_config(Ncp3, WithSyncTime, Conf), + Cps = [Cp1, Cp2, Cp3], + ?line wait_for_ready_net(), + + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, load, [app1(), d1(NodeNames)]), + ?line ?UNTIL(is_loaded(app1, Cps)), + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, start, [app1, permanent]), + ?line ?UNTIL(is_started(app1, Cp1)), + ?line false = is_started(app1, Cp2), + ?line false = is_started(app1, Cp3), + + % Load app1 with different specs and make sure we get an error + ?line {[{error,_},{error,_}],[]} = + rpc:multicall([Cp1, Cp2], application, load, [app1(), d1(NodeNames)]), + ?line {error, _} = rpc:call(Cp3, application, load, [app1(), d2(NodeNames)]), + + stop_node_nice(Cp1), + stop_node_nice(Cp2), + stop_node_nice(Cp3), + ok. + +%%----------------------------------------------------------------- +%% Same test as load/1, only with code path cache enabled. +%%----------------------------------------------------------------- +load_use_cache(suite) -> []; +load_use_cache(doc) -> + ["Tests loading of distributed applications. Code path cache enabled."]; +load_use_cache(Conf) when is_list(Conf) -> + NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf), + NoSyncTime = config_fun_fast(config3(NodeNames)), + WithSyncTime = config_fun(config3(NodeNames)), + + % Test [cp1, cp2, cp3] + ?line {ok, Cp1} = start_node_with_cache(Ncp1, NoSyncTime, Conf), + ?line {ok, Cp2} = start_node_with_cache(Ncp2, NoSyncTime, Conf), + ?line {ok, Cp3} = start_node_with_cache(Ncp3, WithSyncTime, Conf), + Cps = [Cp1, Cp2, Cp3], + ?line wait_for_ready_net(), + + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, load, [app1(), d1(NodeNames)]), + ?line ?UNTIL(is_loaded(app1, Cps)), + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, start, [app1, permanent]), + ?line ?UNTIL(is_started(app1, Cp1)), + ?line false = is_started(app1, Cp2), + + % Load app1 with different specs and make sure we get an error + ?line {[{error,_},{error,_}],[]} = + rpc:multicall([Cp1, Cp2], application, load, [app1(), d1(NodeNames)]), + ?line {error, _} = rpc:call(Cp3, application, load, [app1(), d2(NodeNames)]), + + stop_node_nice(Cp1), + stop_node_nice(Cp2), + stop_node_nice(Cp3), + ok. + +%%----------------------------------------------------------------- +%% Should be started in a CC view with: +%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3] +%%----------------------------------------------------------------- +start_phases(suite) -> []; +start_phases(doc) -> + ["Tests new start phases and failover."]; +start_phases(Conf) when is_list(Conf) -> + %% start a help process to check the start type + SpPid = spawn_link(?MODULE, start_phase, []), + ?line yes = global:register_name(start_phase, SpPid), + + NodeNames = [Ncp1, _Ncp2, _Ncp3] = node_names([cp1, cp2, cp3], Conf), + WithSyncTime = config_fun(config_sf(NodeNames)), + + ?line {ok, Cp1} = start_node_config_sf(Ncp1, WithSyncTime, Conf), + ?line wait_for_ready_net(), + + %%============================= + %%Example 1 in the user's guide + %%============================= + ?line ok = rpc:call(Cp1, application, load, [myApp, + d_any3(myApp, NodeNames)]), + ?line ?UNTIL(is_loaded(myApp, Cp1)), + ?line ok = rpc:call(Cp1, application, start, [myApp, permanent]), + ?line ?UNTIL(is_started(myApp, Cp1)), + ?line ok = get_start_phase({sp, 0, 1, 0, 0, 1}), + ?line ok = rpc:call(Cp1, application, stop, [myApp]), + + %%============================= + %%Example 2 in the user's guide + %%============================= + ?line ok = rpc:call(Cp1, application, load, [topApp, + d_any3(topApp, NodeNames)]), + ?line ?UNTIL(is_loaded(topApp, Cp1)), + ?line ok = rpc:call(Cp1, application, start, [topApp, permanent]), + ?line ?UNTIL(is_started(topApp, Cp1)), + ?line ok = get_start_phase({sp, 0, 1, 0, 0, 1}), + ?line ok = rpc:call(Cp1, application, stop, [topApp]), + + %%============================= + %%Example 3 in the user's guide + %%============================= + ?line ok = rpc:call(Cp1, application, load, [topApp2, + d_any3(topApp2, NodeNames)]), + ?line ?UNTIL(is_loaded(topApp2, Cp1)), + ?line ok = rpc:call(Cp1, application, start, [topApp2, permanent]), + ?line ?UNTIL(is_started(topApp2, Cp1)), + ?line ok = get_start_phase({sp, 0, 2, 0, 0, 3}), + ?line ok = rpc:call(Cp1, application, stop, [topApp2]), + + %%============================= + %%Example 4 in the user's guide + %%============================= + ?line ok = rpc:call(Cp1, application, load, [topApp3, + d_any3(topApp3, NodeNames)]), + ?line ?UNTIL(is_loaded(topApp3, Cp1)), + ?line ok = rpc:call(Cp1, application, start, [topApp3, permanent]), + ?line ?UNTIL(is_started(topApp3, Cp1)), + ?line ok = get_start_phase({sp, 1, 3, 3, 2, 4}), + ?line ok = rpc:call(Cp1, application, stop, [topApp3]), + + global:send(start_phase, kill), + + stop_node_nice(Cp1), + ok. + + +script_start(doc) -> + ["Start distributed applications from within a boot script. Test ", + "same as failover."]; +script_start(suite) -> []; +script_start(Conf) when is_list(Conf) -> + %% start a help process to check the start type + StPid = spawn_link(?MODULE, start_type, []), + ?line yes = global:register_name(st_type, StPid), + + + % Create the .app files and the boot script + ?line ok = create_app(), + ?line {{KernelVer,StdlibVer}, _} = create_script("latest"), + ?line case is_real_system(KernelVer, StdlibVer) of + true -> + Options = []; + false -> + Options = [local] + end, + ?line ok = systools:make_script("latest", Options), + + NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf), + NoSyncTime = config_fun_fast(config_fo(NodeNames)), + WithSyncTime = config_fun(config_fo(NodeNames)), + + % Test [cp1, cp2, cp3] + ?line {ok, Cp1} = start_node_boot_config(Ncp1, NoSyncTime, Conf, latest), + ?line {ok, Cp2} = start_node_boot_config(Ncp2, NoSyncTime, Conf, latest), + ?line {ok, Cp3} = start_node_boot_config(Ncp3, WithSyncTime, Conf, latest), + ?line wait_for_ready_net(), + + ?line ?UNTIL(is_started(app1, Cp1)), + ?line ?UNTIL(is_started(app2, Cp1)), + ?line ?UNTIL(is_started(app_sp, Cp1)), + ?line false = is_started(app1, Cp2), + ?line ok = get_start_type(#st{normal = 9}), + + % Stop cp1 and make sure cp2 starts app1, app2 normally (no + % start_phases defined) and app_sp as failover (start_phases + % defined) + stop_node_nice(Cp1), + ?line ?UNTIL(is_started(app1, Cp2)), + ?line ?UNTIL(is_started(app2, Cp2)), + ?line ?UNTIL(is_started(app_sp, Cp2)), + ?line ok = get_start_type(#st{normal = 6, failover = 3}), + + % Restart cp1, Cp1 takesover app1 and app2 + ?line {ok, Cp1_2} = start_node_boot_config(Ncp1, NoSyncTime, Conf, latest), + ?line global:sync(), + ?line ?UNTIL(is_started(app1, Cp1_2)), + ?line false = is_started(app1, Cp2), + ?line ?UNTIL(is_started(app2, Cp1_2)), + ?line true = is_started(app_sp, Cp2), + ?line ?UNTIL(not is_started(app1, Cp2)), + ?line ?UNTIL(not is_started(app2, Cp2)), + ?line ok = get_start_type(#st{takeover = 6}), + + % Stop cp2 and make sure cp1 starts app_sp. + ?line false = is_started(app_sp, Cp1_2), + stop_node_nice(Cp2), + ?line ?UNTIL(is_started(app_sp, Cp1_2)), + ?line ok = get_start_type(#st{failover = 3}), + + % Stop cp1 and make sure cp3 starts app1, app2 and app_sp + stop_node_nice(Cp1_2), + ?line ?UNTIL(is_started(app_sp, Cp3)), + ?line ?UNTIL(is_started(app1, Cp3)), + ?line ?UNTIL(is_started(app2, Cp3)), + ?line ok = get_start_type(#st{normal = 6, failover = 3}), + + % Restart cp2 and make sure it takesover app1, app2 and app_sp + ?line {ok, Cp2_2} = start_node_boot_config(Ncp2, NoSyncTime, Conf, latest), + ?line global:sync(), + ?line ?UNTIL(is_started(app_sp, Cp2_2)), + ?line ?UNTIL(is_started(app1, Cp2_2)), + ?line ?UNTIL(is_started(app2, Cp2_2)), + ?line ?UNTIL(not is_started(app_sp, Cp3)), + ?line ?UNTIL(not is_started(app1, Cp3)), + ?line ?UNTIL(not is_started(app2, Cp3)), + ?line ok = get_start_type(#st{takeover = 9}), + + % Restart cp1 and make sure it takesover app1, app2 + ?line {ok, Cp1_3} = start_node_boot_config(Ncp1, NoSyncTime, Conf, latest), + ?line global:sync(), + ?line ?UNTIL(is_started(app1, Cp1_3)), + ?line ?UNTIL(is_started(app2, Cp1_3)), + ?line false = is_started(app_sp, Cp1_3), + ?line true = is_started(app_sp, Cp2_2), + ?line ?UNTIL(not is_started(app1, Cp2_2)), + ?line ?UNTIL(not is_started(app2, Cp2_2)), + ?line ok = get_start_type(#st{takeover = 6}), + + % Force takeover to cp1 + ?line ok = rpc:call(Cp1_3, application, takeover, [app_sp, permanent]), + ?line ?UNTIL(is_started(app_sp, Cp1_3)), + ?line ?UNTIL(not is_started(app_sp, Cp2_2)), + ?line ok = get_start_type(#st{takeover = 3}), + + %% Kill one child process and see that it is started with type local + PP = global:whereis_name({ch,3}), + exit(PP, kill), + ?line ok = get_start_type(#st{local = 1}), + + global:send(st_type, kill), + + stop_node_nice(Cp1_3), + stop_node_nice(Cp2_2), + stop_node_nice(Cp3), + + ?line ok = file:delete("latest.boot"), + ?line ok = file:delete("latest.rel"), + ?line ok = file:delete("latest.script"), + + ok. + +permit_false_start_local(doc) -> + ["Start local applications with permission false. Set", + "permit true on different nodes."]; +permit_false_start_local(suite) -> []; +permit_false_start_local(Conf) when is_list(Conf) -> + %% This configuration does not start dist_ac. + Config = write_config_file(fun config_perm/1, Conf), + + % Test [cp1, cp2, cp3] + [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf), + ?line {ok, Cp1} = start_node(Ncp1, Config), + ?line {ok, Cp2} = start_node(Ncp2, Config), + ?line {ok, Cp3} = start_node(Ncp3, Config), + ?line wait_for_ready_net(), + + ?line {[ok,ok,ok],[]} = + rpc:multicall([Cp1, Cp2, Cp3], application, load, [app1()]), + ?line {[ok,ok,ok],[]} = + rpc:multicall([Cp1, Cp2, Cp3], application, start, [app1, permanent]), + ?line {[ok,ok,ok],[]} = + rpc:multicall([Cp1, Cp2, Cp3], application, load, [app2()]), + ?line {[ok,ok,ok],[]} = + rpc:multicall([Cp1, Cp2, Cp3], application, start, [app2, permanent]), + ?line {[ok,ok,ok],[]} = + rpc:multicall([Cp1, Cp2, Cp3], application, load, [app3()]), + + test_server:sleep(1000), + ?line false = is_started(app1, Cp1), + ?line false = is_started(app1, Cp2), + ?line false = is_started(app1, Cp3), + + %Permit a not started application + ?line ok = rpc:call(Cp1, application, permit, [app3, true]), + test_server:sleep(1000), + ?line false = is_started(app3, Cp1), + ?line false = is_started(app3, Cp2), + ?line false = is_started(app3, Cp3), + + %Permit a not loaded application + ?line {error,{not_loaded,app_notloaded}} = + rpc:call(Cp1, application, permit, [app_notloaded, true]), + test_server:sleep(1000), + ?line false = is_started(app_notloaded, Cp1), + ?line false = is_started(app_notloaded, Cp2), + ?line false = is_started(app_notloaded, Cp3), + + %Unpermit a not started application + ?line ok = rpc:call(Cp1, application, permit, [app3, false]), + test_server:sleep(1000), + ?line false = is_started(app3, Cp1), + ?line false = is_started(app3, Cp2), + ?line false = is_started(app3, Cp3), + + %Unpermit a not loaded application + ?line {error,{not_loaded,app_notloaded}} = + rpc:call(Cp1, application, permit, [app_notloaded, false]), + test_server:sleep(1000), + ?line false = is_started(app_notloaded, Cp1), + ?line false = is_started(app_notloaded, Cp2), + ?line false = is_started(app_notloaded, Cp3), + + % Permit app1 on CP1 and make sure it is started + ?line ok = rpc:call(Cp1, application, permit, [app1, true]), + ?line ?UNTIL(is_started(app1, Cp1)), + ?line false = is_started(app1, Cp2), + ?line false = is_started(app1, Cp3), + + % Permit it again + ?line ok = rpc:call(Cp1, application, permit, [app1, true]), + test_server:sleep(1000), + ?line true = is_started(app1, Cp1), + ?line false = is_started(app1, Cp2), + ?line false = is_started(app1, Cp3), + + % Permit app2 on CP1 and make sure it is started + ?line ok = rpc:call(Cp1, application, permit, [app2, true]), + ?line ?UNTIL(is_started(app2, Cp1)), + ?line false = is_started(app2, Cp2), + ?line false = is_started(app2, Cp3), + + % Permit app1 on CP2 and make sure it is started + ?line ok = rpc:call(Cp2, application, permit, [app1, true]), + ?line ?UNTIL(is_started(app1, Cp2)), + ?line true = is_started(app1, Cp1), + ?line false = is_started(app1, Cp3), + + % Unpermit app1 on CP1 and make sure it is stopped + ?line ok = rpc:call(Cp1, application, permit, [app1, false]), + ?line ?UNTIL(false =:= is_started(app1, Cp1)), + ?line true = is_started(app1, Cp2), + ?line false = is_started(app1, Cp3), + + % Unpermit it agin + ?line ok = rpc:call(Cp1, application, permit, [app1, false]), + test_server:sleep(1000), + ?line false = is_started(app1, Cp1), + ?line true = is_started(app1, Cp2), + ?line false = is_started(app1, Cp3), + + % Permit app1 on CP1 and make sure it is started + ?line ok = rpc:call(Cp1, application, permit, [app1, true]), + ?line ?UNTIL(is_started(app1, Cp1)), + ?line true = is_started(app1, Cp2), + ?line false = is_started(app1, Cp3), + + % Unpermit app1 on CP1 and make sure it is stopped + ?line ok = rpc:call(Cp1, application, permit, [app1, false]), + ?line ?UNTIL(false =:= is_started(app1, Cp1)), + ?line true = is_started(app1, Cp2), + ?line false = is_started(app1, Cp3), + + % Unpermit app1 on CP2 and make sure it is stopped + ?line ok = rpc:call(Cp2, application, permit, [app1, false]), + test_server:sleep(1000), + ?line ?UNTIL(false =:= is_started(app1, Cp2)), + ?line false = is_started(app1, Cp1), + ?line false = is_started(app1, Cp3), + + % Unpermit app2 on CP1 and make sure it is stopped + ?line ok = rpc:call(Cp1, application, permit, [app2, false]), + ?line ?UNTIL(false =:= is_started(app2, Cp2)), + ?line false = is_started(app2, Cp1), + ?line false = is_started(app2, Cp3), + + stop_node_nice(Cp1), + stop_node_nice(Cp2), + stop_node_nice(Cp3), + ok. + + +permit_false_start_dist(doc) -> + ["Start distributed applications with permission false. Set", + "permit true on different nodes."]; +permit_false_start_dist(suite) -> []; +permit_false_start_dist(Conf) when is_list(Conf) -> + NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf), + NoSyncTime = config_fun_fast(config_perm2(NodeNames)), + WithSyncTime = config_fun(config_perm2(NodeNames)), + + % Test [cp1, cp2, cp3] + ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line {ok, Cp2} = start_node_config(Ncp2, NoSyncTime, Conf), + ?line {ok, Cp3} = start_node_config(Ncp3, WithSyncTime, Conf), + Cps = [Cp1, Cp2, Cp3], + ?line wait_for_ready_net(), + + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, load, [app1()]), + ?line ?UNTIL(is_loaded(app1, Cps)), + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, start, [app1, permanent]), + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, load, [app2()]), + + test_server:sleep(1000), + ?line false = is_started(app1, Cp1), + ?line false = is_started(app1, Cp2), + ?line false = is_started(app1, Cp3), + + %Permit a not started application + ?line ok = rpc:call(Cp1, application, permit, [app2, true]), + test_server:sleep(1000), + ?line false = is_started(app2, Cp1), + ?line false = is_started(app2, Cp2), + ?line false = is_started(app2, Cp3), + + %Permit a not loaded application + ?line {error,{not_loaded,app3}} = + rpc:call(Cp1, application, permit, [app3, true]), + test_server:sleep(1000), + ?line false = is_started(app3, Cp1), + ?line false = is_started(app3, Cp2), + ?line false = is_started(app3, Cp3), + + %Unpermit a not started application + ?line ok = rpc:call(Cp1, application, permit, [app2, false]), + ?line {[ok,ok,ok],[]} = + rpc:multicall([Cp1, Cp2, Cp3], application, start, [app2, permanent]), + test_server:sleep(1000), + ?line false = is_started(app2, Cp1), + ?line false = is_started(app2, Cp2), + ?line false = is_started(app2, Cp3), + + %Unpermit a not loaded application + ?line {error,{not_loaded,app3}} = + rpc:call(Cp1, application, permit, [app3, false]), + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, load, [app3()]), + ?line ?UNTIL(is_loaded(app3, Cps)), + ?line {[ok,ok,ok],[]} = + rpc:multicall(Cps, application, start, [app3, permanent]), + test_server:sleep(1000), + ?line false = is_started(app3, Cp1), + ?line false = is_started(app3, Cp2), + ?line false = is_started(app3, Cp3), + + % Permit app1 on CP1 and make sure it is started + ?line ok = rpc:call(Cp1, application, permit, [app1, true]), + ?line ?UNTIL(is_started(app1, Cp1)), + ?line false = is_started(app1, Cp2), + ?line false = is_started(app1, Cp3), + + % Permit it again + ?line ok = rpc:call(Cp1, application, permit, [app1, true]), + ?line ?UNTIL(is_started(app1, Cp1)), + ?line false = is_started(app1, Cp2), + ?line false = is_started(app1, Cp3), + + % Permit app2 on CP1 and make sure it is started + ?line ok = rpc:call(Cp1, application, permit, [app2, true]), + ?line ?UNTIL(is_started(app2, Cp1)), + ?line false = is_started(app2, Cp2), + ?line false = is_started(app2, Cp3), + + % Permit app1 on CP2 and make sure it is not started + ?line ok = rpc:call(Cp2, application, permit, [app1, true]), + test_server:sleep(1000), + ?line true = is_started(app1, Cp1), + ?line false = is_started(app1, Cp2), + ?line false = is_started(app1, Cp3), + + % Crash CP1 and make sure app1, but not app2, is started on CP2 + stop_node_nice(Cp1), + ?line ?UNTIL(is_started(app1, Cp2)), + ?line false = is_started(app2, Cp2), + + % Restart CP1 again, check nothing is running on it + ?line {ok, Cp1_2} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line global:sync(), + ?line ok = rpc:call(Cp1_2, application, load, [app1()]), + ?line ?UNTIL(is_loaded(app1, Cp1_2)), + ?line ok = rpc:call(Cp1_2, application, start, [app1, permanent]), + ?line ok = rpc:call(Cp1_2, application, load, [app2()]), + ?line ?UNTIL(is_loaded(app2, Cp1_2)), + ?line ok = rpc:call(Cp1_2, application, start, [app2, permanent]), + ?line ok = rpc:call(Cp1_2, application, load, [app3()]), + ?line ?UNTIL(is_loaded(app3, Cp1_2)), + ?line ok = rpc:call(Cp1_2, application, start, [app3, permanent]), + ?line false = is_started(app1, Cp1_2), + ?line false = is_started(app2, Cp1_2), + + % Permit app3 on CP3 and make sure it is started + ?line ok = rpc:call(Cp3, application, permit, [app3, true]), + ?line ?UNTIL(is_started(app3, Cp3)), + ?line false = is_started(app3, Cp1_2), + ?line false = is_started(app3, Cp2), + + % Permit app3 on CP1 and make sure it is moved there from CP3 + ?line ok = rpc:call(Cp1_2, application, permit, [app3, true]), + ?line ?UNTIL(is_started(app3, Cp1_2)), + ?line false = is_started(app3, Cp2), + ?line false = is_started(app3, Cp3), + + % Unpermit app3 on CP3 and CP1 and make sure it is stopped + ?line ok = rpc:call(Cp3, application, permit, [app3, false]), + ?line ok = rpc:call(Cp1_2, application, permit, [app3, false]), + ?line ?UNTIL(false =:= is_started(app3, Cp1_2)), + ?line false = is_started(app3, Cp2), + ?line false = is_started(app3, Cp3), + + stop_node_nice(Cp1_2), + stop_node_nice(Cp2), + stop_node_nice(Cp3), + ok. + +nodedown_start(doc) -> + ["app1 distributed as [cp1, cp2]. Call application:start(app1) on", + "cp2, but not on cp1. Kill cp1. Make sure app1 is started on cp2."]; +nodedown_start(suite) -> []; +nodedown_start(Conf) when is_list(Conf) -> + NodeNames = [Ncp1, Ncp2] = node_names([cp1, cp2], Conf), + NoSyncTime = config_fun_fast(config4(NodeNames)), + WithSyncTime = config_fun(config4(NodeNames)), + + % Test [cp1, cp2] + ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line {ok, Cp2} = start_node_config(Ncp2, WithSyncTime, Conf), + ?line wait_for_ready_net(), + + % Start app1 and make sure cp1 starts it + ?line {[ok,ok],[]} = + rpc:multicall([Cp1, Cp2], application, load, [app1()]), + ?line _ = rpc:cast(Cp2, application, start, [app1, permanent]), + test_server:sleep(1000), + + % Crash CP1 and make sure app1 is started on CP2 + stop_node_nice(Cp1), + ?line ?UNTIL(is_started(app1, Cp2)), + + stop_node_nice(Cp2), + ok. + +%%%----------------------------------------------------------------- +%%% Testing of reported bugs and other tickets. +%%%----------------------------------------------------------------- +reported_bugs(suite) -> [otp_1586, otp_2078, otp_2012, otp_2718, + otp_2973, otp_3002, otp_3184, otp_4066, + otp_4227, otp_5363, otp_5606]. + +%%----------------------------------------------------------------- +%% Ticket: OTP-1586 +%% Slogan: recursive load of applications fails +%%----------------------------------------------------------------- +otp_1586(suite) -> []; +otp_1586(doc) -> + ["Test recursive load of applications."]; +otp_1586(Conf) when is_list(Conf) -> + Dir = ?config(priv_dir,Conf), + {ok, Fd} = file:open(filename:join(Dir, "app5.app"), write), + w_app5(Fd), + file:close(Fd), + ?line code:add_patha(Dir), + ?line ok = application:load(app4()), + ?line ok = application:unload(app4), + ok. + +%%----------------------------------------------------------------- +%% Ticket: OTP-2078 +%% Slogan: start of distrib apps fails when the nodes start +%% simultaneously +%%----------------------------------------------------------------- +otp_2078(suite) -> []; +otp_2078(doc) -> + ["Test start of distrib apps fails when the nodes start simultaneously."]; +otp_2078(Conf) when is_list(Conf) -> + NodeNames = [Ncp1, Ncp2] = node_names([cp1, cp2], Conf), + NoSyncTime = config_fun_fast(config4(NodeNames)), + WithSyncTime = config_fun(config4(NodeNames)), + + % Test [cp1, cp2] + ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line {ok, Cp2} = start_node_config(Ncp2, WithSyncTime, Conf), + Cps = [Cp1, Cp2], + ?line wait_for_ready_net(), + + % Start app1 and make sure cp1 starts it + ?line {[ok,ok],[]} = + rpc:multicall(Cps, application, load, [app1()]), + ?line ?UNTIL(is_loaded(app1, Cps)), + ?line ok = rpc:call(Cp1, application, start, [app1, permanent]), + ?line ?UNTIL(is_started(app1, Cp1)), + ?line false = is_started(app1, Cp2), + + % Start app1 on cp2; make sure it works (the bug was that this start + % returned error) + ?line ok = rpc:call(Cp2, application, start, [app1, permanent]), + ?line true = is_started(app1, Cp1), + ?line false = is_started(app1, Cp2), + + stop_node_nice(Cp1), + stop_node_nice(Cp2), + ok. + +otp_2012(suite) -> []; +otp_2012(doc) -> + ["Test change of configuration parameters without changing code."]; +otp_2012(Conf) when is_list(Conf) -> + %% start a help process to check the config change + CcPid = spawn_link(?MODULE, conf_change, []), + ?line yes = global:register_name(conf_change, CcPid), + + % Write a .app file + {ok, Fd} = file:open("app1.app", write), + w_app1(Fd), + file:close(Fd), + {ok, Fd2} = file:open("app2.app", write), + w_app1(Fd2), + file:close(Fd2), + + % Start app1 + ?line ok = application:load(app1()), + ?line ok = application:start(app1, permanent), + + %% Read the current configuration parameters, and change them + EnvBefore = application_controller:prep_config_change(), + application_controller:test_change_apps([app1],[[{app1,[{new1, hi}, + {new2, moi}]}]]), + ?line ok = application_controller:config_change(EnvBefore), + ?line ok = get_conf_change([{[], [{new1, hi}, {new2, moi}], []}]), + + % Start app2 + ?line ok = application:load(app2()), + ?line ok = application:start(app2, permanent), + + %% Read the current configuration parameters, and change them again + EnvBefore2 = application_controller:prep_config_change(), + application_controller:test_change_apps([app1],[[{app1,[{new1, hello}, + {new3, mors}]}]]), + application_controller:test_change_apps([app2],[[{app2,[{new1, si}, + {new2, no}]}]]), + _EnvBefore22 = application_controller:prep_config_change(), + ?line ok = application_controller:config_change(EnvBefore2), + + ?line ok = get_conf_change([{[],[{new1,si},{new2,no}],[]}, + {[{new1,hello}],[{new3,mors}],[new2]}]), + + ?line ok = application:stop(app1), + ?line ok = application:stop(app2), + ok. + +%%----------------------------------------------------------------- +%% Ticket: OTP-2718 +%% Slogan: transient app which fails during start is ignored +%%----------------------------------------------------------------- +otp_2718(suite) -> []; +otp_2718(doc) -> + ["Test fail of transient app at start."]; +otp_2718(Conf) when is_list(Conf) -> + ?line {ok, Cp1} = start_node_args(cp1, "-pa " ++ ?config(data_dir,Conf)), + ?line wait_for_ready_net(), + + %% normal exit from the application + ?line ok = rpc:call(Cp1, application, load, [app_trans_normal()]), + ?line ?UNTIL(is_loaded(trans_normal, Cp1)), + ?line {error, {{'EXIT',normal},_}} = + rpc:call(Cp1, application, start, [trans_normal, transient]), + test_server:sleep(2000), + ?line false = is_started(trans_normal, Cp1), + + %% abnormal exit from the application + ?line ok = rpc:call(Cp1, application, load, [app_trans_abnormal()]), + ?line {error, {bad_return,{{trans_abnormal_sup,start,[normal,[]]}, + {'EXIT',abnormal}}}} = + rpc:call(Cp1, application, start, [trans_abnormal, transient]), + test_server:sleep(3000), + ?line {badrpc,nodedown} = which_applications(Cp1), + ok. + +%%----------------------------------------------------------------- +%% Ticket: OTP-2973 +%% Slogan: application:start does not test if an appl is already starting... +%%----------------------------------------------------------------- +otp_2973(suite) -> []; +otp_2973(doc) -> + ["Test of two processes simultanously starting the same application."]; +otp_2973(Conf) when is_list(Conf) -> + % Write a .app file + {ok, Fd} = file:open("app0.app", write), + w_app(Fd, app0()), + file:close(Fd), + + ?line Pid1 = spawn_link(?MODULE, init2973, []), + ?line Pid2 = spawn_link(?MODULE, init2973, []), + + ?line Pid1 ! {start, self(), app0}, + ?line Pid2 ! {start, self(), app0}, + + ?line {Res1, Res2} = receive + {Pid1, res, Res1x} -> + receive + {Pid2, res, Res2x} -> + {Res1x, Res2x} + after 2000 -> + ?line test_server:fail(timeout_pid2) + end; + {Pid2, res, Res2x} -> + receive + {Pid1, res, Res1x} -> + {Res1x, Res2x} + after 2000 -> + ?line test_server:fail(timeout_pid1) + end + end, + + %% Stop it. Inteferes with other global. + ?line ok = application:stop(app0), + + %% Test result. + case {Res1, Res2} of + {ok, ok} -> + ok; + _ -> + ?line Txt = io_lib:format("Illegal results from start: ~p ~p ", + [Res1, Res2]), + ?line test_server:fail(lists:flatten(Txt)) + end, + + + % Write a .app file + ?line {ok, Fda} = file:open("app_start_error.app", write), + ?line w_app_start_error(Fda), + ?line file:close(Fda), + + ?line Pid1 ! {start, self(), app_start_error}, + ?line Pid2 ! {start, self(), app_start_error}, + + ?line {Res1a, Res2a} = receive + {Pid1, res, Res1y} -> + receive + {Pid2, res, Res2y} -> + {Res1y, Res2y} + after 2000 -> + ?line test_server:fail(timeout_pid2) + end; + {Pid2, res, Res2y} -> + receive + {Pid1, res, Res1y} -> + {Res1y, Res2y} + after 2000 -> + ?line test_server:fail(timeout_pid1) + end + end, + + case {Res1a, Res2a} of + {{error,{'start error',{app_start_error,start,[normal,[]]}}}, + {error,{'start error',{app_start_error,start,[normal,[]]}}}} -> + ok; + _ -> + ?line Txta = io_lib:format("Illegal results from start ~p ~p ",[Res1a, Res2a]), + ?line test_server:fail(lists:flatten(Txta)) + end, + + ok. + + + +%%----------------------------------------------------------------- +%% Ticket: OTP-3184 +%% Slogan: crash the node if permanent appl has illegal env parameter values +%%----------------------------------------------------------------- +otp_3184(suite) -> []; +otp_3184(doc) -> + ["When a distributed application is started the permit flag is checked " + "that the permit flag is not changed during the start. " + "Te check must only be made if the application is started on the own node"]; +otp_3184(Conf) when is_list(Conf) -> + NodeNames = [Ncp1, Ncp2] = node_names([cp1, cp2], Conf), + NoSyncTime = config_fun_fast(config3184(NodeNames)), + WithSyncTime = config_fun(config3184(NodeNames)), + + % Test [cp1, cp2] + ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line {ok, Cp2} = start_node_config(Ncp2, WithSyncTime, Conf), + ?line wait_for_ready_net(), + + % Start app1 and make sure it is not started + ?line {[ok,ok],[]} = + rpc:multicall([Cp1, Cp2], application, load, [app1()]), + test_server:sleep(3000), + ?line false = is_started(app1, Cp1), + ?line false = is_started(app1, Cp2), + + % Start app1 on cp1 + ?line ok = rpc:call(Cp1, application, permit, [app1, true]), + ?line ok = rpc:call(Cp1, application, start, [app1, permanent]), + ?line ok = rpc:call(Cp2, application, start, [app1, permanent]), + ?line ?UNTIL(is_started(app1, Cp1)), + ?line false = is_started(app1, Cp2), + + % Check that the application is marked as running in application_controller + ?line X = rpc:call(Cp1, application_controller, info, []), + ?line {value, {running, Xrunning}} = lists:keysearch(running, 1, X), + ?line {value, Xapp1} = lists:keysearch(app1, 1, Xrunning), + ?line {app1, _Xpid} = Xapp1, + + ?line Y = rpc:call(Cp2, application_controller, info, []), + ?line {value, {running, Yrunning}} = lists:keysearch(running, 1, Y), + ?line {value, Yapp1} = lists:keysearch(app1, 1, Yrunning), + ?line {app1, {distributed, Cp1}} = Yapp1, + + stop_node_nice(Cp1), + stop_node_nice(Cp2), + ok. + +%%----------------------------------------------------------------- +%% Ticket: OTP-3002 +%% Slogan: crash the node if permanent appl has illegal env parameter values +%%----------------------------------------------------------------- +otp_3002(suite) -> []; +otp_3002(doc) -> + ["crash the node if permanent appl has illegal env parameter values."]; +otp_3002(Conf) when is_list(Conf) -> + % Create the boot script + ?line {{KernelVer,StdlibVer}, {LatestDir, LatestName}} = + create_script_3002("script_3002"), + ?t:format(0, "LatestDir = ~p~n", [LatestDir]), + ?t:format(0, "LatestName = ~p~n", [LatestName]), + + ?line case is_real_system(KernelVer, StdlibVer) of + true -> + Options = []; + false -> + Options = [local] + end, + + ?line ok = systools:make_script("script_3002", Options), + ?line ok = systools:script2boot("script_3002"), + + ?line {error, timeout} = start_node_boot_3002(cp1, "script_3002"), + + ?line ok = file:delete("script_3002.boot"), + ?line ok = file:delete("script_3002.rel"), + ?line ok = file:delete("script_3002.script"), + ok. + +%%----------------------------------------------------------------- +%% Ticket: OTP-4066 +%% Slogan: dist_ac crashed if a distributed application that it +%% didn't know of was stopped by another dist_ac (bad_match +%% when it received dist_ac_app_stopped). +%%----------------------------------------------------------------- + +otp_4066(suite) -> []; +otp_4066(doc) -> ["Check that application stop don't cause dist_ac crash"]; +otp_4066(Conf) when is_list(Conf) -> + % Write config files + [Ncp1, Ncp2] = node_names([cp1, cp2], Conf), + Host = from($@, atom_to_list(node())), + Cp1 = list_to_atom(Ncp1 ++ "@" ++ Host), + Cp2 = list_to_atom(Ncp2 ++ "@" ++ Host), + AllNodes = [Cp1, Cp2], + App1Nodes = {app1, AllNodes}, + + Dir = ?config(priv_dir,Conf), + ?line {ok, FdC} = file:open(filename:join(Dir, "otp_4066.config"), write), + ?line write_config(FdC, config_4066(AllNodes, 5000, [App1Nodes])), + ?line file:close(FdC), + + % Write the app1.app file + ?line {ok, FdA12} = file:open(filename:join(Dir, "app1.app"), write), + ?line w_app1(FdA12), + ?line file:close(FdA12), + + Args1 = "-pa " ++ Dir ++ " -config " ++ filename:join(Dir, "otp_4066"), + Args2 = "-pa " ++ Dir ++ " -kernel start_dist_ac true", + + ?line {ok, Cp2} = start_node_args(Ncp2, Args2), + %% Cp1 syncs with cp2 (which is known to be up). + ?line {ok, Cp1} = start_node_args(Ncp1, Args1), + ?line wait_for_ready_net(), + + ?line ok = rpc:call(Cp1, application, start, [app1]), + ?line wait_until_started(app1, [Cp1]), + ?line test_server:format("--- App1 started at Cp1 ---~n", []), + ?line print_dac_state(AllNodes), + + % Cp2 previously crashed on this stop + ?line ok = rpc:call(Cp1, application, stop, [app1]), + ?line wait_until_stopped(app1, [Cp1]), + ?line test_server:format("--- App1 stopped at Cp1 ---~n", []), + ?line print_dac_state(AllNodes), + + ?line ok = rpc:call(Cp1, application, start, [app1]), + ?line wait_until_started(app1, [Cp1]), + ?line test_server:format("--- App1 started at Cp1 ---~n", []), + ?line print_dac_state(AllNodes), + + ?line ok = rpc:call(Cp2, application, load, [app1, App1Nodes]), + ?line ok = rpc:call(Cp2, application, start, [app1]), + ?line test_server:format("--- App1 started at Cp2 ---~n", []), + ?line print_dac_state(AllNodes), + + + ?line stop_node_nice(Cp1), + ?line wait_until_started(app1, [Cp2]), + ?line test_server:format("--- Cp1 crashed; failover to Cp2 ---~n", []), + ?line print_dac_state(Cp2), + + ?line stop_node_nice(Cp2), + ok. + +config_4066(SyncNodesOptional, SyncNodesTimeout, Distributed) -> + [{kernel, [{sync_nodes_optional,SyncNodesOptional}, + {sync_nodes_timeout, SyncNodesTimeout}, + {distributed, Distributed}]}]. + +write_config(Fd, Config) -> + io:format(Fd, "~p.~n", [Config]). + +print_dac_state(Node) when is_atom(Node) -> + State = gen_server:call({dist_ac, Node}, info), + test_server:format(" * dist_ac state on node ~p:~n ~p~n", + [Node, State]); +print_dac_state(Nodes) when is_list(Nodes) -> + lists:foreach(fun (N) -> print_dac_state(N) end, Nodes). + + +%%----------------------------------------------------------------- +%% Ticket: OTP-4227 +%% Slogan: Bad return value from application. +%%----------------------------------------------------------------- +otp_4227(suite) -> []; +otp_4227(doc) -> + ["Test start of depending app when required app crashed."]; +otp_4227(Conf) when is_list(Conf) -> + NodeNames = [Ncp1, Ncp2] = node_names([cp1, cp2], Conf), + NoSyncTime = config_fun_fast(config_4227(NodeNames)), + WithSyncTime = config_fun(config_4227(NodeNames)), + + %% Test [cp1, cp2] + ?line {ok, Cp1} = start_node_config(Ncp1, NoSyncTime, Conf), + ?line {ok, Cp2} = start_node_config(Ncp2, WithSyncTime, Conf), + Cps = [Cp1, Cp2], + ?line wait_for_ready_net(), + + %% Try to start app10 which should fail since app9 is not started + ?line {[ok,ok],[]} = + rpc:multicall(Cps, application, load, [app9()]), + ?line ?UNTIL(is_loaded(app9, Cps)), + ?line {[ok,ok],[]} = + rpc:multicall(Cps, application, load, [app10_dep9()]), + ?line {error, {not_started, app9}} = + rpc:call(Cp1, application, start, [app10]), + + %% Start app9 and brutally kill it, then try to start app10 + ?line ok = rpc:call(Cp1, application, start, [app9]), + ?line test_server:sleep(1000), + ?line Pid9 = rpc:call(Cp1, erlang, whereis, [ch_sup19]), + ?line true = erlang:is_pid(Pid9), + ?line true = erlang:exit(Pid9, kill), + ?line test_server:sleep(1000), + + %% This gave {error, no_report} before the patch + ?line {error, {not_running, app9}} = + rpc:call(Cp1, application, start, [app10]), + + ?line stop_node_nice(Cp1), + ?line stop_node_nice(Cp2), + ok. + +config_4227([Ncp1, Ncp2]) -> + fun(Fd, SyncNodesTimeout) -> + M = from($@, atom_to_list(node())), + io:format(Fd, + "[{kernel, " + " [{sync_nodes_optional, ['~s@~s','~s@~s']}," + " {sync_nodes_timeout, ~w}," + " {start_dist_ac, true}," + " {distributed, " + " [{app9, ['~s@~s','~s@~s']}, " + " {app10, ['~s@~s','~s@~s']}]}]}].~n", + [Ncp1, M, Ncp2, M, + SyncNodesTimeout, + Ncp1, M, Ncp2, M, + Ncp1, M, Ncp2, M]) + end. + +%%----------------------------------------------------------------- +%% Ticket: OTP-5363 +%% Slogan: Slow termination in application_master +%%----------------------------------------------------------------- +otp_5363(Conf) when is_list(Conf) -> + %% When stopping an application, all processes having the + %% application master as group leader should get killed. + %% The killing was done in an inefficient way. + %% In this test case, we will not test the efficiency of + %% the code, but only that the correct processes ARE killed. + + OldPath = code:get_path(), + code:add_patha(?config(data_dir,Conf)), + try + ?line ok = application:load(app_group_leader()), + ?line ok = application:start(group_leader), + ?line case whereis(nisse) of + Pid when is_pid(Pid) -> + ?line Mref = erlang:monitor(process, Pid), + ?line ok = application:stop(group_leader), + receive + {'DOWN',Mref,_,_,_} -> ok + end, + ?line undefined = whereis(nisse); + Bad -> + ?line io:format("~p\n", [Bad]), + ?t:fail() + end + after + code:set_path(OldPath) + end, + ok. + +%%----------------------------------------------------------------- +%% Ticket: OTP-5606 +%% Slogan: Problems with starting a distributed application +%%----------------------------------------------------------------- +otp_5606(suite) -> []; +otp_5606(doc) -> + ["Test of several processes simultanously starting the same " + "distributed application."]; +otp_5606(Conf) when is_list(Conf) -> + + %% Write a config file + Dir = ?config(priv_dir, Conf), + {ok, Fd} = file:open(filename:join(Dir, "sys.config"), write), + NodeNames = [Ncp1, Ncp2] = node_names([cp1, cp2], Conf), + (config4(NodeNames))(Fd, 10000), + file:close(Fd), + Config = filename:join(Dir, "sys"), + + %% Test [cp1, cp2] + ?line {ok, Cp1} = start_node(Ncp1, Config), + ?line {ok, Cp2} = start_node(Ncp2, Config), + Cps = [Cp1, Cp2], + ?line wait_for_ready_net(), + + %% Load app1 on both nodes + ?line {[ok, ok], []} = + rpc:multicall(Cps, application, load, [app1()]), + + %% Attempt to start app1 from different processes simultaneously + ?line Pid11 = spawn_link(Cp1, ?MODULE, loop5606, [self()]), + ?line Pid12 = spawn_link(Cp1, ?MODULE, loop5606, [self()]), + ?line Pid13 = spawn_link(Cp1, ?MODULE, loop5606, [self()]), + ?line Pid2 = spawn_link(Cp2, ?MODULE, loop5606, [self()]), + + ?line Pid2 ! start, + ?line Pid11 ! start, + ?line Pid12 ! start, + ?line Pid13 ! start, + + ResL = otp_5606_loop([]), + + case ResL of + [ok, ok, ok, ok] -> + ok; + [Res1, Res2, Res3, Res4] -> + Txt = io_lib:format("Illegal results from start ~p ~p ~p ~p", + [Res1, Res2, Res3, Res4]), + ?line test_server:fail(lists:flatten(Txt)) + end, + + ?line {error, {already_started, app1}} = + rpc:call(Cp1, application, start, [app1]), + + stop_node_nice(Cp1), + stop_node_nice(Cp2), + ok. + +otp_5606_loop(ResL) when length(ResL)<4 -> + receive + {_Pid, Res} -> + otp_5606_loop([Res|ResL]) + after 5000 -> + ?line test_server:fail(timeout_waiting_for_res) + end; +otp_5606_loop(ResL) -> + ResL. + +loop5606(Pid) -> + receive + start -> + Res = application:start(app1), + Pid ! {self(), Res} + end. + + +%%----------------------------------------------------------------- +%% Should be started in a CC view with: +%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3] +%%----------------------------------------------------------------- +get_key(suite) -> []; +get_key(doc) -> + ["Tests read the .app keys."]; +get_key(Conf) when is_list(Conf) -> + NodeNames = [Ncp1, _Ncp2, _Ncp3] = node_names([cp1, cp2, cp3], Conf), + WithSyncTime = config_fun(config_inc(NodeNames)), + + % Test [cp1, cp2, cp3] + ?line {ok, Cp1} = start_node_config(Ncp1, WithSyncTime, Conf), + + ?line ok = rpc:call(Cp1, application, load, [appinc(), d3(NodeNames)]), + ?line ?UNTIL(is_loaded(appinc, Cp1)), + ?line ok = rpc:call(Cp1, application, start, [appinc, permanent]), + ?line ?UNTIL(is_started(appinc, Cp1)), + + ?line {ok, "Test of new app file, including appnew"} = + rpc:call(Cp1, application, get_key, [appinc, description]), + ?line {ok, "CXC 138 ai"} = rpc:call(Cp1, application, get_key, [appinc ,id]), + ?line {ok, "2.0"} = rpc:call(Cp1, application, get_key, [appinc, vsn]), + ?line {ok, [kernel]} = rpc:call(Cp1, application, get_key, [appinc, applications]), + ?line {ok, [appinc1, appinc2]} = + rpc:call(Cp1, application, get_key, [appinc, included_applications]), + ?line {ok, []} = rpc:call(Cp1, application, get_key, [appinc, registered]), + ?line {ok, [{init, [kalle]}, {takeover, []}, {go, [sune]}]} = + rpc:call(Cp1, application, get_key, [appinc, start_phases]), + ?line {ok, Env} = rpc:call(Cp1, application, get_key, [appinc ,env]), + ?line [{included_applications,[appinc1,appinc2]}, + {own2,val2},{own_env1,value1}] = lists:sort(Env), + ?line {ok, []} = rpc:call(Cp1, application, get_key, [appinc, modules]), + ?line {ok, {application_starter, [ch_sup, {appinc, 41, 43}] }} = + rpc:call(Cp1, application, get_key, [appinc, mod]), + ?line {ok, infinity} = rpc:call(Cp1, application, get_key, [appinc, maxP]), + ?line {ok, infinity} = rpc:call(Cp1, application, get_key, [appinc, maxT]), + ?line undefined = rpc:call(Cp1, application, get_key, [appinc, very_unknown]), + + ?line {ok, [{description, "Test of new app file, including appnew"}, + {id, "CXC 138 ai"}, + {vsn, "2.0"}, + {modules, []}, + {maxP, infinity}, + {maxT, infinity}, + {registered, []}, + {included_applications, [appinc1, appinc2]}, + {applications, [kernel]}, + {env, Env}, + {mod, {application_starter, [ch_sup, {appinc, 41, 43}] }}, + {start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]}]} = + rpc:call(Cp1, application, get_all_key, [appinc]), + ?line [{included_applications,[appinc1,appinc2]}, + {own2,val2},{own_env1,value1}] = lists:sort(Env), + + ?line {ok, "Test of new app file, including appnew"} = + gen_server:call({global, {ch,41}}, {get_pid_key, description}), + ?line {ok, "CXC 138 ai"} = + gen_server:call({global, {ch,41}}, {get_pid_key, id}), + ?line {ok, "2.0"} = + gen_server:call({global, {ch,41}}, {get_pid_key, vsn}), + ?line {ok, [kernel]} = + gen_server:call({global, {ch,41}}, {get_pid_key, applications}), + ?line {ok, [appinc1, appinc2]} = + gen_server:call({global, {ch,41}}, {get_pid_key, included_applications}), + ?line {ok, []} = + gen_server:call({global, {ch,41}}, {get_pid_key, registered}), + ?line {ok, [{init, [kalle]}, {takeover, []}, {go, [sune]}]} = + gen_server:call({global, {ch,41}}, {get_pid_key, start_phases}), + ?line {ok, Env} = gen_server:call({global, {ch,41}}, {get_pid_key, env}), + ?line [{included_applications,[appinc1,appinc2]}, + {own2,val2},{own_env1,value1}] = lists:sort(Env), + ?line {ok, []} = + gen_server:call({global, {ch,41}}, {get_pid_key, modules}), + ?line {ok, {application_starter, [ch_sup, {appinc, 41, 43}] }} = + gen_server:call({global, {ch,41}}, {get_pid_key, mod}), + ?line {ok, infinity} = + gen_server:call({global, {ch,41}}, {get_pid_key, maxP}), + ?line {ok, infinity} = + gen_server:call({global, {ch,41}}, {get_pid_key, maxT}), + ?line undefined = + gen_server:call({global, {ch,41}}, {get_pid_key, very_unknown}), + + + + ?line {ok, [{description, "Test of new app file, including appnew"}, + {id, "CXC 138 ai"}, + {vsn, "2.0"}, + {modules, []}, + {maxP, infinity}, + {maxT, infinity}, + {registered, []}, + {included_applications, [appinc1, appinc2]}, + {applications, [kernel]}, + {env, Env}, + {mod, {application_starter, [ch_sup, {appinc, 41, 43}] }}, + {start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]}]} = + gen_server:call({global, {ch,41}}, get_pid_all_key), + ?line [{included_applications,[appinc1,appinc2]}, + {own2,val2},{own_env1,value1}] = lists:sort(Env), + + stop_node_nice(Cp1), + ok. + +%%%----------------------------------------------------------------- +%%% Testing of change of distributed parameter. +%%%----------------------------------------------------------------- +distr_changed(suite) -> [distr_changed_tc1, distr_changed_tc2]. + +distr_changed_tc1(suite) -> []; +distr_changed_tc1(doc) -> ["Test change of distributed parameter."]; +distr_changed_tc1(Conf) when is_list(Conf) -> + + {OldKernel, OldEnv, {Cp1, Cp2, Cp3}, {_Ncp1, _Ncp2, _Ncp3}, _Config2} = + distr_changed_prep(Conf), + + ?line NewDist = {distributed, [{app1, [Cp3]}, + {app2, 5000, [Cp2]}, + {app3, [Cp3, {Cp1, Cp2}]}, + {app6, [Cp1, {Cp3, Cp2}]}, + {app7, 1000, [Cp3]}, + {app8, [Cp1, {Cp2, Cp3}]}]}, + + ?line NewKernel = [{kernel, lists:keyreplace(distributed, 1, OldKernel, NewDist)}], + ?line ok = rpc:call(Cp1, application_controller, test_change_apps, + [[kernel], [NewKernel]]), + ?line ok = rpc:call(Cp2, application_controller, test_change_apps, + [[kernel], [NewKernel]]), + ?line ok = rpc:call(Cp3, application_controller, test_change_apps, + [[kernel], [NewKernel]]), + + ?line {[ok,ok,ok],[]} = + rpc:multicall([Cp1, Cp2, Cp3], + application_controller, config_change, [OldEnv]), + + ?line test_server:sleep(7000), + + ?line DcInfo1 = rpc:call(Cp1, dist_ac, info, []), + ?line DcInfo2 = rpc:call(Cp2, dist_ac, info, []), + ?line DcInfo3 = rpc:call(Cp3, dist_ac, info, []), + + ?line DcWa1 = which_applications(Cp1), + ?line DcWa2 = which_applications(Cp2), + ?line DcWa3 = which_applications(Cp3), + + ?line Wa1 = lists:foldl(fun({A1, _N1, _V1}, AccIn) -> [A1 | AccIn] end, + [], DcWa1), + ?line Wa2 = lists:foldl(fun({A2, _N2, _V2}, AccIn) -> [A2 | AccIn] end, + [], DcWa2), + ?line Wa3 = lists:foldl(fun({A3, _N3, _V3}, AccIn) -> [A3 | AccIn] end, + [], DcWa3), + ?line case lists:sort(Wa1) of + [app1, app2, app3, kernel, stdlib] -> + ok; + EWa1 -> + X1 = io_lib:format("distribution error: Cp1 ~p ",[EWa1]), + ?line test_server:fail(lists:flatten(X1)) + end, + + ?line case lists:sort(Wa2) of + [app6, app8, kernel, stdlib] -> + ok; + EWa2 -> + X2 = io_lib:format("distribution error: Cp2 ~p ",[EWa2]), + ?line test_server:fail(lists:flatten(X2)) + end, + + ?line case lists:sort(Wa3) of + [app7, kernel, stdlib] -> + ok; + EWa3 -> + X3 = io_lib:format("distribution error: Cp3 ~p ",[EWa3]), + ?line test_server:fail(lists:flatten(X3)) + end, + + ?line DcInfo1n = rpc:call(Cp1, dist_ac, info, []), + ?line DcInfo2n = rpc:call(Cp2, dist_ac, info, []), + ?line DcInfo3n = rpc:call(Cp3, dist_ac, info, []), + + %% Added afterwards. Got rid of some warnings for unused variables. + ?line true = DcInfo1 =:= DcInfo1n, + ?line true = DcInfo2 =:= DcInfo2n, + ?line true = DcInfo3 =:= DcInfo3n, + + stop_node_nice(Cp1), + stop_node_nice(Cp2), + stop_node_nice(Cp3), + + ?line ok = file:delete("dc.boot"), + ?line ok = file:delete("dc.rel"), + ?line ok = file:delete("dc.script"), + + ok. + +distr_changed_tc2(suite) -> []; +distr_changed_tc2(doc) -> ["Test change of distributed parameter, " + "move appls by crashing a node."]; +distr_changed_tc2(Conf) when is_list(Conf) -> + + {OldKernel, OldEnv, {Cp1, Cp2, Cp3}, {Ncp1, _Ncp2, _Ncp3}, Config2} = + distr_changed_prep(Conf), + + ?line NewDist = {distributed, [{app1, [Cp3]}, + {app2, 5000, [Cp2]}, + {app3, [Cp3, {Cp1, Cp2}]}, + {app6, [Cp1, {Cp3, Cp2}]}, + {app7, 1000, [Cp3]}, + {app8, [Cp1, {Cp2, Cp3}]}]}, + + ?line NewKernel = [{kernel, lists:keyreplace(distributed, 1, OldKernel, NewDist)}], + ?line ok = rpc:call(Cp1, application_controller, test_change_apps, + [[kernel], [NewKernel]]), + ?line ok = rpc:call(Cp2, application_controller, test_change_apps, + [[kernel], [NewKernel]]), + ?line ok = rpc:call(Cp3, application_controller, test_change_apps, + [[kernel], [NewKernel]]), + + ?line {[ok,ok,ok],[]} = + rpc:multicall([Cp1, Cp2, Cp3], + application_controller, config_change, [OldEnv]), + + ?line test_server:sleep(4000), + ?line stop_node_nice(Cp1), + ?line test_server:sleep(10000), + +% ?line _DcInfo1 = rpc:call(Cp1, dist_ac, info, []), + ?line _DcInfo2 = rpc:call(Cp2, dist_ac, info, []), + ?line _DcInfo3 = rpc:call(Cp3, dist_ac, info, []), +% ?t:format(0,"#### DcInfo1 ~n~p~n",[_DcInfo1]), + +% ?line DcWa1 = which_applications(Cp1), + ?line DcWa2 = which_applications(Cp2), + ?line DcWa3 = which_applications(Cp3), + +% ?line Wa1 = lists:foldl(fun({A1, _N1, _V1}, AccIn) -> [A1 | AccIn] end, +% [], DcWa1), + ?line Wa2 = lists:foldl(fun({A2, _N2, _V2}, AccIn) -> [A2 | AccIn] end, + [], DcWa2), + ?line Wa3 = lists:foldl(fun({A3, _N3, _V3}, AccIn) -> [A3 | AccIn] end, + [], DcWa3), + + + ?line case lists:sort(Wa2) of + [app2, app6, app8, kernel, stdlib] -> + ok; + EWa2 -> + X2 = io_lib:format("distribution error: Cp2 ~p ",[EWa2]), + ?line test_server:fail(lists:flatten(X2)) + end, + + ?line case lists:sort(Wa3) of + [app1, app3, app7, kernel, stdlib] -> + ok; + EWa3 -> + X3 = io_lib:format("distribution error: Cp3 ~p ",[EWa3]), + ?line test_server:fail(lists:flatten(X3)) + end, + + + ?line {ok, Cp1} = start_node_boot(Ncp1, Config2, dc), + ?line test_server:sleep(10000), + + ?line _DcInfo1rs = rpc:call(Cp1, dist_ac, info, []), + ?line _DcInfo2rs = rpc:call(Cp2, dist_ac, info, []), + ?line _DcInfo3rs = rpc:call(Cp3, dist_ac, info, []), + + ?line DcWa1rs = which_applications(Cp1), + ?line DcWa2rs = which_applications(Cp2), + ?line DcWa3rs = which_applications(Cp3), + + ?line Wa1rs = lists:foldl(fun({A1, _N1, _V1}, AccIn) -> [A1 | AccIn] end, + [], DcWa1rs), + ?line Wa2rs = lists:foldl(fun({A2, _N2, _V2}, AccIn) -> [A2 | AccIn] end, + [], DcWa2rs), + ?line Wa3rs = lists:foldl(fun({A3, _N3, _V3}, AccIn) -> [A3 | AccIn] end, + [], DcWa3rs), + + ?line case lists:sort(Wa1rs) of + [app6, app8, kernel, stdlib] -> + ok; + EWa1rs -> + X1rs = io_lib:format("distribution error: Cp1 ~p ",[EWa1rs]), + ?line test_server:fail(lists:flatten(X1rs)) + end, + + ?line case lists:sort(Wa2rs) of + [app2, kernel, stdlib] -> + ok; + EWa2rs -> + X2rs = io_lib:format("distribution error: Cp2 ~p ",[EWa2rs]), + ?line test_server:fail(lists:flatten(X2rs)) + end, + + ?line case lists:sort(Wa3rs) of + [app1, app3, app7, kernel, stdlib] -> + ok; + EWa3rs -> + X3rs = io_lib:format("distribution error: Cp3 ~p ",[EWa3rs]), + ?line test_server:fail(lists:flatten(X3rs)) + end, + + + stop_node_nice(Cp1), + stop_node_nice(Cp2), + stop_node_nice(Cp3), + + ?line ok = file:delete("dc.boot"), + ?line ok = file:delete("dc.rel"), + ?line ok = file:delete("dc.script"), + + ok. + + + +%%%----------------------------------------------------------------- +%%% Testing of application configuration change +%%%----------------------------------------------------------------- +config_change(suite) -> + []; +config_change(doc) -> + ["Test change of application configuration"]; +config_change(Conf) when is_list(Conf) -> + + %% Change to data_dir + ?line {ok, CWD} = file:get_cwd(), + ?line DataDir = ?config(data_dir, Conf), + ?line ok = file:set_cwd(DataDir), + + %% Find out application data from boot script + ?line Boot = filename:join([code:root_dir(), "bin", "start.boot"]), + ?line {ok, Bin} = file:read_file(Boot), + ?line Appls = get_appls(binary_to_term(Bin)), + + %% Simulate contents of "sys.config" + ?line Config = [{stdlib, [{par1,sys},{par2,sys}]}, + "t1", + "t2.config", + filename:join([DataDir, "subdir", "t3"]), + {stdlib, [{par6,sys}]}], + + %% Order application_controller to update configuration + ?line ok = application_controller:change_application_data(Appls, + Config), + + %% Check that stdlib parameters are correctly set + ?line Env = application:get_all_env(stdlib), + ?line {value, {par1,sys}} = lists:keysearch(par1, 1, Env), + ?line {value, {par2,t1}} = lists:keysearch(par2, 1, Env), + ?line {value, {par3,t1}} = lists:keysearch(par3, 1, Env), + ?line {value, {par4,t2}} = lists:keysearch(par4, 1, Env), + ?line {value, {par5,t3}} = lists:keysearch(par5, 1, Env), + ?line {value, {par6,sys}} = lists:keysearch(par6, 1, Env), + + ?line ok = file:set_cwd(CWD). + +%% This function is stolen from SASL module release_handler, OTP R10B +get_appls({script, _, Script}) -> + get_appls(Script, []). + +%% kernel is taken care of separately +get_appls([{kernelProcess, application_controller, + {application_controller, start, [App]}} | T], Res) -> + get_appls(T, [App | Res]); +%% other applications but kernel +get_appls([{apply, {application, load, [App]}} | T], Res) -> + get_appls(T, [App | Res]); +get_appls([_ | T], Res) -> + get_appls(T, Res); +get_appls([], Res) -> + Res. + +%%%----------------------------------------------------------------- +%%% Tests the 'shutdown_func' kernel config parameter +%%%----------------------------------------------------------------- +shutdown_func(suite) -> + []; +shutdown_func(doc) -> + ["Tests the 'shutdown_func' kernel config parameter"]; +shutdown_func(Config) when is_list(Config) -> + ?line {ok,Cp1} = start_node(?MODULE_STRING++"_shutdown_func"), + ?line wait_for_ready_net(), + ?line Tag = make_ref(), + ?line ok = rpc:call(Cp1, application, set_env, + [kernel, shutdown_func, {?MODULE, do_shutdown}]), + ?line ok = rpc:call(Cp1, application, set_env, + [kernel, shutdown_func_test, {self(), Tag}]), + ?line _ = rpc:call(Cp1, init, stop, []), + ?line receive + {Pid, Tag, shutting_down, shutdown} -> + ?line Mref = erlang:monitor(process, Pid), + ?line Pid ! {self(), Tag, ok}, + receive + {'DOWN', Mref, _, Pid, noconnection} -> + ok + after 10000 -> + test_server:fail(timeout) + end + after 10000 -> + test_server:fail(timeout) + end. + + + +do_shutdown(Reason) -> + {ok, {Pid, Tag}} = application:get_env(kernel, shutdown_func_test), + Pid ! {self(), Tag, shutting_down, Reason}, + receive + {Pid, Tag, ok} -> ok + end. + + + +%%----------------------------------------------------------------- +%% Utility functions +%%----------------------------------------------------------------- +app0() -> + {application, app0, + [{description, "ERTS CXC 138 10"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {mod, {ch_sup, {app0, 77, 80}}}]}. + +app1() -> + {application, app1, + [{description, "ERTS CXC 138 10"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {mod, {ch_sup, {app1, 1, 3}}}]}. + +app2() -> + {application, app2, + [{description, "ERTS CXC 138 10"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {mod, {ch_sup, {app2, 4, 6}}}]}. + +app3() -> + {application, app3, + [{description, "ERTS CXC 138 10"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {mod, {ch_sup, {app3, 7, 9}}}]}. + +app4() -> + {application, app4, + [{description, "ERTS CXC 138 10"}, + {vsn, "2.0"}, + {applications, [kernel]}, + {included_applications, [app5]}, + {mod, {ch_sup, {app3, 7, 9}}}]}. + +app5() -> + {application, app5, + [{description, "ERTS CXC 138 10"}, + {vsn, "2.0"}, + {applications, [kernel]}, + {mod, {ch_sup, {app3, 7, 9}}}]}. + +app6() -> + {application, app6, + [{description, "ERTS CXC 138 10"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {mod, {ch_sup, {app6, 10, 12}}}]}. + +app7() -> + {application, app7, + [{description, "ERTS CXC 138 10"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {mod, {ch_sup, {app7, 13, 15}}}]}. + +app8() -> + {application, app8, + [{description, "ERTS CXC 138 10"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {mod, {ch_sup, {app7, 16, 18}}}]}. + +app9() -> + {application, app9, + [{description, "ERTS CXC 138 10"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {mod, {ch_sup, {app9, 19, 19}}}]}. + +app10_dep9() -> + {application, app10, + [{description, "ERTS CXC 138 10"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel, app9]}, + {mod, {ch_sup, {app10, 20, 20}}}]}. + +appinc() -> + {application, appinc, + [{description, "Test of new app file, including appnew"}, + {id, "CXC 138 ai"}, + {vsn, "2.0"}, + {applications, [kernel]}, + {modules, []}, + {registered, []}, + {env, [{own_env1, value1}, {own2, val2}]}, + {included_applications, [appinc1, appinc2]}, + {start_phases, [{init, [kalle]}, {takeover, []}, {go, [sune]}]}, + {mod, {application_starter, [ch_sup, {appinc, 41, 43}] }}]}. + + +app_sp() -> + {application, app_sp, + [{description, "ERTS CXC 138 10"}, + {vsn, "2.0"}, + {start_phases, [{init, [kurt]}, {go, [sune]}]}, + {applications, [kernel]}, + {modules, []}, + {registered, []}, + {mod, {application_starter, [ch_sup, {app_sp, 31, 33}] }}]}. + +app_trans_normal() -> + {application, trans_normal, + [{description, "A CXC 138 11"}, + {vsn, "1.0"}, + {modules, [{transient, 1}, {trans_normal_sup,1}]}, + {registered, [trans_normal_sup]}, + {applications, [kernel, stdlib]}, + {mod, {trans_normal_sup, []}}]}. + +app_trans_abnormal() -> + {application, trans_abnormal, + [{description, "A CXC 138 11"}, + {vsn, "1.0"}, + {modules, [{transient, 1}, {trans_abnormal_sup,1}]}, + {registered, [trans_abnormal_sup]}, + {applications, [kernel, stdlib]}, + {mod, {trans_abnormal_sup, []}}]}. + +app_start_error() -> + {application, app_start_error, + [{description, "ERTS CXC 138 10"}, + {vsn, "2.0"}, + {modules, []}, + {registered, []}, + {applications, [kernel]}, + {mod, {app_start_error, []}}]}. + +app_group_leader() -> + {application, group_leader, + [{description, "GROUP_LEADER CXC 138 11"}, + {vsn, "1.0"}, + {modules, [group_leader,group_leader_sup]}, + {registered, [group_leader_sup]}, + {applications, [kernel,stdlib]}, + {mod, {group_leader_sup, []}}]}. + + +d1([Ncp1, Ncp2, Ncp3]) -> + M = from($@, atom_to_list(node())), + {app1, [list_to_atom(Ncp1 ++ "@" ++ M), + list_to_atom(Ncp2 ++ "@" ++ M), + list_to_atom(Ncp3 ++ "@" ++ M)]}. + +d2([Ncp1, _Ncp2, Ncp3]) -> + M = from($@, atom_to_list(node())), + {app1, [list_to_atom(Ncp1 ++ "@" ++ M), + list_to_atom(Ncp3 ++ "@" ++ M)]}. + +d3([Ncp1, Ncp2, Ncp3]) -> + M = from($@, atom_to_list(node())), + {appinc, [list_to_atom(Ncp1 ++ "@" ++ M), + list_to_atom(Ncp2 ++ "@" ++ M), + list_to_atom(Ncp3 ++ "@" ++ M)]}. + +d_any3(Any, [Ncp1, Ncp2, Ncp3]) -> + M = from($@, atom_to_list(node())), + {Any, [list_to_atom(Ncp1 ++ "@" ++ M), + list_to_atom(Ncp2 ++ "@" ++ M), + list_to_atom(Ncp3 ++ "@" ++ M)]}. + + +config([Ncp1, Ncp2, Ncp3]) -> + fun(Fd, SyncNodesTimeout) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, " + "['~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, ~w}," + "{distributed, [{app1, ['~s@~s', '~s@~s', '~s@~s']}," + "{app2, 1000, ['~s@~s', '~s@~s', '~s@~s']}," + "{app3, 1000, [{'~s@~s', '~s@~s'}, '~s@~s']}]}]}].~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + SyncNodesTimeout, Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M]) + end. + +config2([Ncp1, Ncp2, Ncp3]) -> + fun(Fd, SyncNodesTimeout) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, " + "['~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, ~w}," + "{permissions, [{app3, false}]}," + "{distributed, [{app1, ['~s@~s', '~s@~s', '~s@~s']}," + "{app2, 10000, ['~s@~s', '~s@~s', '~s@~s']}," + "{app3, 5000, [{'~s@~s', '~s@~s'}, '~s@~s']}]}]}].~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + SyncNodesTimeout, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M]) + end. + +config3([Ncp1, Ncp2, Ncp3]) -> + fun(Fd, SyncNodesTimeout) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, " + "['~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, ~w}," + "{start_dist_ac, true}," + "{permissions, [{app3, false}]}]}].~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + SyncNodesTimeout]) + end. + +config4([Ncp1, Ncp2]) -> + fun(Fd, SyncNodesTimeout) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, " + "['~s@~s','~s@~s']}," + "{sync_nodes_timeout, ~w}," + "{start_dist_ac, true}," + "{distributed, [{app1, ['~s@~s', '~s@~s']}]}]}].~n", + [Ncp1, M, Ncp2, M, SyncNodesTimeout, + Ncp1, M, Ncp2, M]) + end. + +config3184([Ncp1, Ncp2]) -> + fun(Fd, SyncNodesTimeout) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, " + "['~s@~s','~s@~s']}," + "{sync_nodes_timeout, ~w}," + "{permissions, [{app1, false}]}," + "{distributed, [{app1, ['~s@~s', '~s@~s']}]}]}].~n", + [Ncp1, M, Ncp2, M, SyncNodesTimeout, + Ncp1, M, Ncp2, M]) + end. + +config_perm(Fd) -> + io:format(Fd, "[{kernel, [{permissions, " + "[{app1, false}, {app2, false}, {app3, false}]} ]}].~n",[]). + +config_perm2([Ncp1, Ncp2, Ncp3]) -> + fun(Fd, SyncNodesTimeout) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, " + "['~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, ~w}," + "{permissions, [{app1, false}, {app2, false}, {app3, false}]}," + "{distributed, [{app1, ['~s@~s', '~s@~s', '~s@~s']}," + "{app2, 10000, ['~s@~s', '~s@~s', '~s@~s']}," + "{app3, 5000, [{'~s@~s', '~s@~s'}, '~s@~s']}]}]}].~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + SyncNodesTimeout, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M]) + end. + +config_inc([Ncp1, Ncp2, Ncp3]) -> + fun(Fd, SyncNodesTimeout) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, " + "['~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, ~w}," + "{distributed, [{appinc, ['~s@~s', '~s@~s', '~s@~s']}," + "{app2, 10000, ['~s@~s', '~s@~s', '~s@~s']}," + "{app3, 5000, [{'~s@~s', '~s@~s'}, '~s@~s']}]}]}].~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + SyncNodesTimeout, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M]) + end. + +config_sf([Ncp1, Ncp2, Ncp3]) -> + fun(Fd, SyncNodesTimeout) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, " + "['~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, ~w}," + "{distributed, [{myApp, ['~s@~s', '~s@~s', '~s@~s']}," + "{topApp, ['~s@~s', '~s@~s', '~s@~s']}," + "{inclOne, ['~s@~s', '~s@~s', '~s@~s']}," + "{inclTwo, ['~s@~s', '~s@~s', '~s@~s']}," + "{inclTwoTop, ['~s@~s', '~s@~s', '~s@~s']}," + "{incl2A, ['~s@~s', '~s@~s', '~s@~s']}," + "{incl2B, ['~s@~s', '~s@~s', '~s@~s']}," + "{with, ['~s@~s', '~s@~s', '~s@~s']}," + "{wrapper, ['~s@~s', '~s@~s', '~s@~s']}]}]}].~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + SyncNodesTimeout, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M]) + end. + +config_fo([Ncp1, Ncp2, Ncp3]) -> + fun(Fd, SyncNodesTimeout) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, " + "['~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, ~w}," + "{distributed, [{app1, ['~s@~s', '~s@~s', '~s@~s']}," + "{app2, 2000, ['~s@~s', '~s@~s', '~s@~s']}," + "{app_sp, 1000, [{'~s@~s', '~s@~s'}, '~s@~s']}]}]}].~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + SyncNodesTimeout, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M]) + end. + +config_dc([Ncp1, Ncp2, Ncp3]) -> + fun(Fd, SyncNodesTimeout) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, " + "['~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, ~w}," + "{distributed, [{app1, ['~s@~s', '~s@~s']}," + " {app2, 10000, ['~s@~s']}," + " {app3, [{'~s@~s', '~s@~s'}]}, " + " {app6, [{'~s@~s', '~s@~s'}]}, " + " {app7, ['~s@~s']}, " + " {app8, ['~s@~s', {'~s@~s', '~s@~s'}]}" + " ]}]}].~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + SyncNodesTimeout, + Ncp1, M, Ncp2, M, + Ncp1, M, + Ncp1, M, Ncp2, M, + Ncp3, M, Ncp2, M, + Ncp3, M, + Ncp2, M, Ncp1, M, Ncp3, M]) + end. + +config_dc2([Ncp1, Ncp2, Ncp3]) -> + fun(Fd) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, " + "['~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, 10000}," + "{distributed, [{app1, ['~s@~s']}," + " {app2, 5000, ['~s@~s']}," + " {app3, ['~s@~s', {'~s@~s', '~s@~s'}]}, " + " {app6, ['~s@~s', {'~s@~s', '~s@~s'}]}, " + " {app7, 1000, ['~s@~s']}, " + " {app8, ['~s@~s', {'~s@~s', '~s@~s'}]}" + " ]}]}].~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + Ncp3, M, + Ncp2, M, + Ncp3, M, Ncp1, M, Ncp2, M, + Ncp1, M, Ncp3, M, Ncp2, M, + Ncp3, M, + Ncp1, M, Ncp2, M, Ncp3, M]) + end. + +w_app1(Fd) -> + io:format(Fd, "~p.\n", [app1()]). + +w_app2(Fd) -> + io:format(Fd, "~p.\n", [app2()]). + +w_app3(Fd) -> + io:format(Fd, "~p.\n", [app3()]). + +w_app5(Fd) -> + io:format(Fd, "~p.\n", [app5()]). + +w_app6(Fd) -> + io:format(Fd, "~p.\n", [app6()]). + +w_app7(Fd) -> + io:format(Fd, "~p.\n", [app7()]). + +w_app8(Fd) -> + io:format(Fd, "~p.\n", [app8()]). + +w_app_start_error(Fd) -> + io:format(Fd, "~p.\n", [app_start_error()]). + +w_app(Fd, AppData) -> + io:format(Fd, "~p.\n", [AppData]). + +from(H, [H | T]) -> T; +from(H, [_ | T]) -> from(H, T); +from(_H, []) -> []. + +is_loaded(Name, [Node | Nodes]) -> + Apps = rpc:call(Node, application, loaded_applications, []), + case lists:keysearch(Name, 1, Apps) of + {value, _} -> is_loaded(Name, Nodes); + false -> false + end; +is_loaded(_Name, []) -> + true; +is_loaded(Name, Node) -> + is_loaded(Name, [Node]). + +is_started(Name, Node) -> + Apps = which_applications(Node), + case lists:keysearch(Name, 1, Apps) of + {value, _} -> true; + false -> false + end. + +% Waits until application Name is started on at least one node. +wait_until_started(Name, Nodes) -> + case lists:member(true, + lists:map(fun (N) -> + is_started(Name, N) + end, + Nodes)) of + true -> + true; + false -> + test_server:sleep(500), + wait_until_started(Name, Nodes) + end. + +% Waits until application Name is stopped on all nodes. +wait_until_stopped(Name, Nodes) -> + case lists:member(true, + lists:map(fun (N) -> + is_started(Name, N) + end, + Nodes)) of + false -> + true; + true -> + test_server:sleep(500), + wait_until_stopped(Name, Nodes) + end. + +%% The test server has no support for starting nodes in parallel. To +%% avoid long delays a small sync_nodes_timeout is used. Use this +%% function when starting all nodes but the last one, and when +%% restarting nodes (then use global:sync() to synchronize). +config_fun_fast(SysConfigFun) -> + fun(Fd) -> SysConfigFun(Fd, 1) end. + +config_fun(SysConfigFun) -> + fun(Fd) -> SysConfigFun(Fd, 10000) end. + +start_node_config(Name, SysConfigFun, Conf) -> + ConfigFile = write_config_file(SysConfigFun, Conf), + start_node(Name, ConfigFile, ""). + +start_node(Name) -> + Pa = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, slave, [{args, " -pa " ++ Pa}]). + +start_node(Name, ConfigFile) -> + start_node(Name, ConfigFile, ""). + +start_node(Name, ConfigFile, ExtraArgs) -> + Pa = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, slave, [{args, + " -pa " ++ Pa ++ + " -config " ++ ConfigFile ++ + ExtraArgs}]). + +start_node_with_cache(Name, SysConfigFun, Conf) -> + ConfigFile = write_config_file(SysConfigFun, Conf), + start_node(Name, ConfigFile, " -code_path_cache"). + +start_node_args(Name, Args) -> + Pa = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, slave, [{args, " -pa " ++ Pa ++ " " ++ Args}]). + +start_node_boot_3002(Name, Boot) -> + Pa = filename:dirname(code:which(?MODULE)), + ?t:format(0, "start_node_boot ~p~n", + [" -pa " ++ Pa ++ " -env ERL_CRASH_DUMP erl_crash_dump." ++ + atom_to_list(Name) ++ " -boot " ++ Boot ++ + " -sasl dummy \"missing "]), + test_server:start_node(Name, slave, + [{args, " -pa " ++ Pa ++ + " -env ERL_CRASH_DUMP erl_crash_dump." ++ + atom_to_list(Name) ++ " -boot " ++ Boot ++ + " -sasl dummy \"missing "}]). + +start_node_boot_config(Name, SysConfigFun, Conf, Boot) -> + ConfigFile = write_config_file(SysConfigFun, Conf), + start_node(Name, ConfigFile, " -boot " ++ atom_to_list(Boot)). + +start_node_boot(Name, Config, Boot) -> + Pa = filename:dirname(code:which(?MODULE)), + ?t:format(0, "start_node_boot ~p~n",[" -pa " ++ Pa ++ " -config " ++ Config ++ + " -boot " ++ atom_to_list(Boot)]), + test_server:start_node(Name, slave, [{args, " -pa " ++ Pa ++ " -config " ++ Config ++ + " -boot " ++ atom_to_list(Boot)}]). + +start_node_config_sf(Name, SysConfigFun, Conf) -> + ConfigFile = write_config_file(SysConfigFun, Conf), + DataDir = ?config(data_dir, Conf), % is it used? + start_node(Name, ConfigFile, " -pa " ++ DataDir). + +write_config_file(SysConfigFun, Conf) -> + Dir = ?config(priv_dir, Conf), + {ok, Fd} = file:open(filename:join(Dir, "sys.config"), write), + SysConfigFun(Fd), + file:close(Fd), + filename:join(Dir,"sys"). + +node_names(Names, Config) -> + [node_name(Name, Config) || Name <- Names]. + +node_name(Name, Config) -> + U = "_", + {{Y,M,D}, {H,Min,S}} = calendar:now_to_local_time(now()), + Date = io_lib:format("~4w_~2..0w_~2..0w__~2..0w_~2..0w_~2..0w", + [Y,M,D, H,Min,S]), + L = lists:flatten(Date), + lists:concat([Name,U,?testcase,U,U,L]). + +stop_node_nice(Node) when is_atom(Node) -> + ?line test_server:stop_node(Node); +stop_node_nice(Nodes) when is_list(Nodes) -> + ?line lists:foreach(fun (N) -> stop_node_nice(N) end, Nodes). + + +get_start_type(Expected) -> + get_start_type(Expected, 30*5, #st{}). + +get_start_type(_Expected, 0, Ack) -> + test_server:format("====== ~p ======~n", [Ack]), + test_server:fail(not_valid_start_type); +get_start_type(Expected, Times, Ack0) -> + #st{normal = N0, local = L0, takeover = T0, failover = F0} = Ack0, + global:send(st_type, {st, read, self()}), + receive + {st, N, L, T, F} -> + Ack = #st{normal = N0 + N, local = L0 + L, + takeover = T0 + T, failover = F0 + F}, + if + Ack =:= Expected -> + ok; + true -> + timer:sleep(200), + get_start_type(Expected, Times-1, Ack) + end + after 30*1000 -> + get_start_type(Expected, 0, Ack0) + end. + +start_type() -> + st(0, 0, 0, 0). + +st(Normal, Local, Takeover, Failover) -> + receive + {st, normal} -> + st(Normal+1, Local, Takeover, Failover); + {st, local} -> + st(Normal, Local+1, Takeover, Failover); + {st, takeover} -> + st(Normal, Local, Takeover+1, Failover); + {st, failover} -> + st(Normal, Local, Takeover, Failover+1); + {st, read, From} -> + From ! {st, Normal, Local, Takeover, Failover}, + st(0, 0, 0, 0); + kill -> + exit(normal) + end. + + +get_start_phase(Expected) -> + global:send(start_phase, {sp, read, self()}), + receive + Expected -> + ok; + {sp, T1, I1, So1, Sp1, G1} -> + test_server:format("=============== {sp,T,I,So,Sp,G} ~p ~n",[" "]), + test_server:format("=========== got ~p ~n", + [{sp, T1, I1, So1, Sp1, G1}]), + test_server:format("====== expected ~p ~n", [Expected]), + test_server:fail(not_valid_start_phase) + after 5000 -> + test_server:fail(not_valid_start_phase) + end. + +start_phase() -> + sp(0, 0, 0, 0, 0). + +sp(Top, Init, Some, Spec, Go) -> + receive + {sp, top} -> + sp(Top+1, Init, Some, Spec, Go); + {sp, init} -> + sp(Top, Init+1, Some, Spec, Go); + {sp, some} -> + sp(Top, Init, Some+1, Spec, Go); + {sp, spec} -> + sp(Top, Init, Some, Spec+1, Go); + {sp, go} -> + sp(Top, Init, Some, Spec, Go+1); + {sp, read, From} -> + From ! {sp, Top, Init, Some, Spec, Go}, + sp(0, 0, 0, 0, 0); + kill -> + exit(normal) + end. + +get_conf_change(Expected) -> + global:send(conf_change, {cc, read, self()}), + receive + {cc, Expected} -> + ok; + {cc, List} -> + ?line test_server:format("====== ~p ======~n",[{cc, List}]), + ?line test_server:fail(not_valid_conf_change) + after 5000 -> + ?line test_server:fail(not_valid_conf_change_to) + end. + +conf_change() -> + cc([]). + +cc(List) -> + receive + {cc, New} -> + cc(List ++ New); + {cc, read, From} -> + From ! {cc, List}, + cc([]); + kill -> + exit(normal) + end. + + + +create_app() -> + ?line Dir = "./", + ?line App1 = Dir ++ "app1", + ?line {ok, Fd1} = file:open(App1++".app",write), + ?line io:format(Fd1, "~p. \n", [app1()]), + ?line file:close(Fd1), + ?line App2 = Dir ++ "app2", + ?line {ok, Fd2} = file:open(App2++".app",write), + ?line io:format(Fd2, "~p. \n", [app2()]), + ?line file:close(Fd2), + ?line App3 = Dir ++ "app_sp", + ?line {ok, Fd3} = file:open(App3++".app",write), + ?line io:format(Fd3, "~p. \n", [app_sp()]), + ?line file:close(Fd3), + ok. + + +create_script(ScriptName) -> + ?line Dir = "./", + ?line Name = Dir ++ ScriptName, + ?line Apps = which_applications(), + ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + ?line {ok,Fd} = file:open(Name++".rel",write), + ?line io:format(Fd, + "{release, {\"Test release 3\", \"LATEST\"}, \n" + " {erts, \"4.4\"}, \n" + " [{kernel, \"~s\"}, {stdlib, \"~s\"}, \n" + " {app1, \"2.0\"}, {app2, \"2.0\"}, {app_sp, \"2.0\"}]}.\n", + [KernelVer,StdlibVer]), + ?line file:close(Fd), + {{KernelVer,StdlibVer}, + {filename:dirname(Name), filename:basename(Name)}}. + + + +create_script_dc(ScriptName) -> + ?line Dir = "./", + ?line Name = Dir ++ ScriptName, + ?line Apps = which_applications(), + ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + ?line {ok,Fd} = file:open(Name++".rel",write), + ?line io:format(Fd, + "{release, {\"Test release 3\", \"LATEST\"}, \n" + " {erts, \"4.4\"}, \n" + " [{kernel, \"~s\"}, {stdlib, \"~s\"}, \n" + " {app1, \"2.0\"}, {app2, \"2.0\"}, {app3, \"2.0\"}, \n" + " {app6, \"2.0\"}, {app7, \"2.0\"}, {app8, \"2.0\"}]}.\n", + [KernelVer,StdlibVer]), + ?line file:close(Fd), + {{KernelVer,StdlibVer}, + {filename:dirname(Name), filename:basename(Name)}}. + + +create_script_3002(ScriptName) -> + ?line Dir = "./", + ?line Name = Dir ++ ScriptName, + ?line Apps = which_applications(), + ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + ?line {value,{_,_,SaslVer}} = lists:keysearch(sasl,1,Apps), + ?line {ok,Fd} = file:open(Name++".rel",write), + ?line io:format(Fd, + "{release, {\"Test release 3\", \"LATEST\"}, \n" + " {erts, \"4.4\"}, \n" + " [{kernel, \"~s\"}, {stdlib, \"~s\"}, \n" + " {sasl, \"~s\"}]}.\n", + [KernelVer, StdlibVer, SaslVer]), + ?line file:close(Fd), + {{KernelVer,StdlibVer}, + {filename:dirname(Name), filename:basename(Name)}}. + + + +distr_changed_prep(Conf) when is_list(Conf) -> + + % Write .app files + ?line {ok, Fd1} = file:open("app1.app", write), + ?line w_app1(Fd1), + ?line file:close(Fd1), + ?line {ok, Fd2} = file:open("app2.app", write), + ?line w_app2(Fd2), + ?line file:close(Fd2), + ?line {ok, Fd3} = file:open("app3.app", write), + ?line w_app3(Fd3), + ?line file:close(Fd3), + ?line {ok, Fd4} = file:open("app6.app", write), + ?line w_app6(Fd4), + ?line file:close(Fd4), + ?line {ok, Fd5} = file:open("app7.app", write), + ?line w_app7(Fd5), + ?line file:close(Fd5), + ?line {ok, Fd6} = file:open("app8.app", write), + ?line w_app8(Fd6), + ?line file:close(Fd6), + + + % Create the .app files and the boot script + ?line {{KernelVer,StdlibVer}, _} = create_script_dc("dc"), + + ?line case is_real_system(KernelVer, StdlibVer) of + true -> + Options = []; + false -> + Options = [local] + end, + + ?line ok = systools:make_script("dc", Options), + + NodeNames = [Ncp1, Ncp2, Ncp3] = node_names([cp1, cp2, cp3], Conf), + NoSyncTime = config_fun_fast(config_dc(NodeNames)), + WithSyncTime = config_fun(config_dc(NodeNames)), + + ?line Dir = ?config(priv_dir,Conf), + ?line {ok, Fd_dc2} = file:open(filename:join(Dir, "sys2.config"), write), + ?line (config_dc2(NodeNames))(Fd_dc2), + ?line file:close(Fd_dc2), + ?line Config2 = filename:join(Dir, "sys2"), + + % Test [cp1, cp2, cp3] + ?line {ok, Cp1} = start_node_boot_config(Ncp1, NoSyncTime, Conf, dc), + ?line {ok, Cp2} = start_node_boot_config(Ncp2, NoSyncTime, Conf, dc), + ?line {ok, Cp3} = start_node_boot_config(Ncp3, WithSyncTime, Conf, dc), + ?line global:sync(), + + %% Read the current configuration parameters, and change them + ?line OldEnv = rpc:call(Cp1, application_controller, prep_config_change, []), + ?line {value, {kernel, OldKernel}} = lists:keysearch(kernel, 1, OldEnv), + {OldKernel, OldEnv, {Cp1, Cp2, Cp3}, {Ncp1, Ncp2, Ncp3}, Config2}. + + +%%% Copied from init_SUITE.erl. +is_real_system(KernelVsn, StdlibVsn) -> + LibDir = code:lib_dir(), + case file:read_file_info(LibDir ++ "/kernel-" ++ KernelVsn) of + {ok, _} -> + case file:read_file_info(LibDir ++ "/stdlib-" ++ StdlibVsn) of + {ok, _} -> + true; + _ -> + false + end; + _ -> + false + end. + +init2973() -> + loop2973(). + + +loop2973() -> + receive + {start, From, App} -> + Res = application:start(App), + From ! {self(), res, Res}, + loop2973(); + + kill -> + exit(normal) + end. + +wait_for_ready_net() -> + Nodes = lists:sort([node() | nodes()]), + ?UNTIL(begin + lists:all(fun(N) -> Nodes =:= get_known(N) end, Nodes) and + lists:all(fun(N) -> + LNs = rpc:call(N, erlang, nodes, []), + Nodes =:= lists:sort([N | LNs]) + end, Nodes) + end). + +get_known(Node) -> + case catch gen_server:call({global_name_server,Node}, get_known) of + {'EXIT', _} -> + [list, without, nodenames]; + Known -> + lists:sort([Node | Known]) + end. + +which_applications() -> + application_controller:which_applications(infinity). + +which_applications(Node) -> + rpc:call(Node, application, which_applications, [infinity]). diff --git a/lib/kernel/test/application_SUITE_data/Makefile.src b/lib/kernel/test/application_SUITE_data/Makefile.src new file mode 100644 index 0000000000..a237f6badb --- /dev/null +++ b/lib/kernel/test/application_SUITE_data/Makefile.src @@ -0,0 +1,24 @@ +EFLAGS=+debug_info + +all: app_start_error.@EMULATOR@ trans_abnormal_sup.@EMULATOR@ \ + trans_normal_sup.@EMULATOR@ transient.@EMULATOR@ \ + group_leader_sup.@EMULATOR@ group_leader.@EMULATOR@ + +app_start_error.@EMULATOR@: app_start_error.erl + erlc $(EFLAGS) app_start_error.erl + +trans_abnormal_sup.@EMULATOR@: trans_abnormal_sup.erl + erlc $(EFLAGS) trans_abnormal_sup.erl + +trans_normal_sup.@EMULATOR@: trans_normal_sup.erl + erlc $(EFLAGS) trans_normal_sup.erl + +transient.@EMULATOR@: transient.erl + erlc $(EFLAGS) transient.erl + +group_leader.@EMULATOR@: group_leader.erl + erlc $(EFLAGS) group_leader.erl + +group_leader_sup.@EMULATOR@: group_leader_sup.erl + erlc $(EFLAGS) group_leader_sup.erl + diff --git a/lib/kernel/test/application_SUITE_data/app_start_error.erl b/lib/kernel/test/application_SUITE_data/app_start_error.erl new file mode 100644 index 0000000000..cfe3508eb3 --- /dev/null +++ b/lib/kernel/test/application_SUITE_data/app_start_error.erl @@ -0,0 +1,35 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(app_start_error). + +%%-compile(export_all). +%%-export([Function/Arity, ...]). + + +-export([start/2, + init/0]). + +start(_,_) -> + Pid = spawn_link(m, foo, []), + {error, 'start error'}. + +init() -> + exit(normal). + diff --git a/lib/kernel/test/application_SUITE_data/group_leader.erl b/lib/kernel/test/application_SUITE_data/group_leader.erl new file mode 100644 index 0000000000..08c5b43808 --- /dev/null +++ b/lib/kernel/test/application_SUITE_data/group_leader.erl @@ -0,0 +1,61 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2009. 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(group_leader). +-behaviour(gen_server). + +%% External exports +-export([start_link/0, code_change/3]). + +%% Internal exports +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2]). + +start_link() -> gen_server:start_link({local,aa}, ?MODULE, [], []). + +%%----------------------------------------------------------------- +%% Callback functions from gen_server +%%----------------------------------------------------------------- +init([]) -> + Self = self(), + Pid = spawn(fun() -> stupid_child(Self) end) , + receive {Pid, registration_done} -> ok end, + process_flag(trap_exit, true), + {ok,state}. + +handle_call(transient, _From, State) -> + X = application:get_all_env(transient), + {reply,X,State}. + +handle_cast(transient, State) -> + {noreply, State}. + +handle_info(_, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. + +stupid_child(Parent) -> + register(nisse, self()), + Parent ! {self(), registration_done}, + receive + _Msg -> ok + end. diff --git a/lib/kernel/test/application_SUITE_data/group_leader_sup.erl b/lib/kernel/test/application_SUITE_data/group_leader_sup.erl new file mode 100644 index 0000000000..04bb0538fe --- /dev/null +++ b/lib/kernel/test/application_SUITE_data/group_leader_sup.erl @@ -0,0 +1,37 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2009. 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(group_leader_sup). + +-behaviour(supervisor). + +%% External exports +-export([start/2]). + +%% Internal exports +-export([init/1]). + +start(_, _) -> + supervisor:start_link(group_leader_sup, []). + +init([]) -> + SupFlags = {one_for_one,4,3600}, + Config = {group_leader, + {group_leader,start_link,[]}, + temporary,4000,worker,[group_leader]}, + {ok,{SupFlags,[Config]}}. diff --git a/lib/kernel/test/application_SUITE_data/subdir/t3.config b/lib/kernel/test/application_SUITE_data/subdir/t3.config new file mode 100644 index 0000000000..b7445eacfe --- /dev/null +++ b/lib/kernel/test/application_SUITE_data/subdir/t3.config @@ -0,0 +1 @@ +[{stdlib, [{par5,t3},{par6,t3}]}]. diff --git a/lib/kernel/test/application_SUITE_data/t1.config b/lib/kernel/test/application_SUITE_data/t1.config new file mode 100644 index 0000000000..32838ee6a7 --- /dev/null +++ b/lib/kernel/test/application_SUITE_data/t1.config @@ -0,0 +1,2 @@ +[{stdlib, [{par2,t1},{par3,t1}]}, + {kernel, [{kpar1,kval1}]}]. diff --git a/lib/kernel/test/application_SUITE_data/t2.config b/lib/kernel/test/application_SUITE_data/t2.config new file mode 100644 index 0000000000..953bb6477b --- /dev/null +++ b/lib/kernel/test/application_SUITE_data/t2.config @@ -0,0 +1,2 @@ +%% Intentionally no NL after the line following to make sure it works (OTP-5543). +[{stdlib, [{par4,t2}]}].
\ No newline at end of file diff --git a/lib/kernel/test/application_SUITE_data/trans_abnormal_sup.erl b/lib/kernel/test/application_SUITE_data/trans_abnormal_sup.erl new file mode 100644 index 0000000000..d060347aff --- /dev/null +++ b/lib/kernel/test/application_SUITE_data/trans_abnormal_sup.erl @@ -0,0 +1,39 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(trans_abnormal_sup). + + +-behaviour(supervisor). + +%% External exports +-export([start/2]). + +%% Internal exports +-export([init/1]). + +start(_, _) -> + supervisor:start_link({local, trans_abnormal_sup}, trans_abnormal_sup, []), + exit(abnormal). + +init([]) -> + SupFlags = {one_for_one, 4, 3600}, + Config = {transient, + {transient, start_link, []}, + transient, 2000, worker, [transient]}, + {ok, {SupFlags, [Config]}}. diff --git a/lib/kernel/test/application_SUITE_data/trans_normal_sup.erl b/lib/kernel/test/application_SUITE_data/trans_normal_sup.erl new file mode 100644 index 0000000000..48eb52ddcf --- /dev/null +++ b/lib/kernel/test/application_SUITE_data/trans_normal_sup.erl @@ -0,0 +1,38 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(trans_normal_sup). + +-behaviour(supervisor). + +%% External exports +-export([start/2]). + +%% Internal exports +-export([init/1]). + +start(_, _) -> + supervisor:start_link({local, trans_normal_sup}, trans_normal_sup, []), + exit(normal). + +init([]) -> + SupFlags = {one_for_one, 4, 3600}, + Config = {transient, + {transient, start_link, []}, + transient, 2000, worker, [transient]}, + {ok, {SupFlags, [Config]}}. diff --git a/lib/kernel/test/application_SUITE_data/transient.erl b/lib/kernel/test/application_SUITE_data/transient.erl new file mode 100644 index 0000000000..1f38b4803a --- /dev/null +++ b/lib/kernel/test/application_SUITE_data/transient.erl @@ -0,0 +1,52 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(transient). + + +-behaviour(gen_server). + +%% External exports +-export([start_link/0, transient/0]). +%% Internal exports +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, terminate/2]). + +start_link() -> gen_server:start_link({local, aa}, transient, [], []). + +transient() -> gen_server:call(aa, transient). + +%%----------------------------------------------------------------- +%% Callback functions from gen_server +%%----------------------------------------------------------------- +init([]) -> + process_flag(trap_exit, true), + {ok, state}. + +handle_call(transient, _From, State) -> + X = application:get_all_env(transient), + {reply, X, State}. + +handle_cast(transient, State) -> + {noreply, State}. + +handle_info(_, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + diff --git a/lib/kernel/test/bif_SUITE.erl b/lib/kernel/test/bif_SUITE.erl new file mode 100644 index 0000000000..c78d82659f --- /dev/null +++ b/lib/kernel/test/bif_SUITE.erl @@ -0,0 +1,649 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(bif_SUITE). +-export([all/1]). + +-export([spawn_tests/1, + spawn1/1, spawn2/1, spawn3/1, spawn4/1, + + spawn_link_tests/1, + spawn_link1/1, spawn_link2/1, spawn_link3/1, spawn_link4/1, + + spawn_opt_tests/1, + spawn_opt2/1, spawn_opt3/1, spawn_opt4/1, spawn_opt5/1, + + spawn_failures/1, + + run_fun/1, + wilderness/1]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +-include("test_server.hrl"). + +% Default timetrap timeout (set in init_per_testcase). +-define(default_timeout, ?t:minutes(1)). + +init_per_testcase(_Case, Config) -> + ?line Dog = ?t:timetrap(?default_timeout), + [{watchdog, Dog} | Config]. +fin_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +all(suite) -> + [spawn_tests, spawn_link_tests, spawn_opt_tests, spawn_failures, wilderness]. + +spawn_tests(doc) -> ["Test spawn"]; +spawn_tests(suite) -> + [spawn1, spawn2, spawn3, spawn4]. + +spawn_link_tests(doc) -> ["Test spawn_link"]; +spawn_link_tests(suite) -> + [spawn_link1, spawn_link2, spawn_link3, spawn_link4]. + +spawn_opt_tests(doc) -> ["Test spawn_opt"]; +spawn_opt_tests(suite) -> + [spawn_opt2, spawn_opt3, spawn_opt4, spawn_opt5]. + +spawn1(doc) -> ["Test spawn/1"]; +spawn1(suite) -> + []; +spawn1(Config) when list(Config) -> + ?line Node = node(), + ?line Parent = self(), + ?line {_, _, FA, _} = fetch_proc_vals(self()), + + % spawn + ?line P = spawn(fun() -> Parent ! {self(), fetch_proc_vals(self())} end), + ?line receive + {P, PV} -> + ?line Node = node(P), + ?line check_proc_vals(false, normal, FA, 0, PV) + end, + ok. + +spawn2(doc) -> ["Test spawn/2"]; +spawn2(suite) -> + []; +spawn2(Config) when list(Config) -> + ?line {ok, Node} = start_node(spawn2), + + ?line Parent = self(), + ?line {_, _, FA, _} = fetch_proc_vals(self()), + + % spawn_link + ?line P = spawn(Node, + fun() -> Parent ! {self(), fetch_proc_vals(self())} end), + ?line receive + {P, PV} -> + ?line Node = node(P), + ?line check_proc_vals(false, normal, FA, 0, PV) + end, + + ?line true = stop_node(Node), + ok. + + +spawn3(doc) -> ["Test spawn/3"]; +spawn3(suite) -> + []; +spawn3(Config) when list(Config) -> + ?line Node = node(), + + ?line Parent = self(), + ?line {_, _, FA, _} = fetch_proc_vals(self()), + + % spawn_link + ?line P = spawn(?MODULE, + run_fun, + [fun() -> + Parent ! {self(), fetch_proc_vals(self())} + end]), + ?line receive + {P, PV} -> + ?line Node = node(P), + ?line check_proc_vals(false, normal, FA, 0, PV) + end, + ok. + +spawn4(doc) -> ["Test spawn/4"]; +spawn4(suite) -> + []; +spawn4(Config) when list(Config) -> + ?line {ok, Node} = start_node(spawn4), + + ?line Parent = self(), + ?line {_, _, FA, _} = fetch_proc_vals(self()), + + % spawn_link + ?line P = spawn(Node, + ?MODULE, + run_fun, + [fun() -> + Parent ! {self(), fetch_proc_vals(self())} + end]), + ?line receive + {P, PV} -> + ?line Node = node(P), + ?line check_proc_vals(false, normal, FA, 0, PV) + end, + + ?line true = stop_node(Node), + ok. + + + +spawn_link1(doc) -> ["Test spawn_link/1"]; +spawn_link1(suite) -> + []; +spawn_link1(Config) when list(Config) -> + ?line Node = node(), + ?line Parent = self(), + ?line {_, _, FA, _} = fetch_proc_vals(self()), + + % spawn_link + ?line P = spawn_link(fun() -> Parent ! {self(), fetch_proc_vals(self())} end), + ?line receive + {P, PV} -> + ?line Node = node(P), + ?line check_proc_vals(true, normal, FA, 0, PV) + end, + ok. + +spawn_link2(doc) -> ["Test spawn_link/2"]; +spawn_link2(suite) -> + []; +spawn_link2(Config) when list(Config) -> + ?line {ok, Node} = start_node(spawn_link2), + + ?line Parent = self(), + ?line {_, _, FA, _} = fetch_proc_vals(self()), + + % spawn_link + ?line P = spawn_link(Node, + fun() -> Parent ! {self(), fetch_proc_vals(self())} end), + ?line receive + {P, PV} -> + ?line Node = node(P), + ?line check_proc_vals(true, normal, FA, 0, PV) + end, + + ?line true = stop_node(Node), + ok. + +spawn_link3(doc) -> ["Test spawn_link/3"]; +spawn_link3(suite) -> + []; +spawn_link3(Config) when list(Config) -> + ?line Node = node(), + + ?line Parent = self(), + ?line {_, _, FA, _} = fetch_proc_vals(self()), + + % spawn_link + ?line P = spawn_link(?MODULE, + run_fun, + [fun() -> + Parent ! {self(), fetch_proc_vals(self())} + end]), + ?line receive + {P, PV} -> + ?line Node = node(P), + ?line check_proc_vals(true, normal, FA, 0, PV) + end, + ok. + +spawn_link4(doc) -> ["Test spawn_link/4"]; +spawn_link4(suite) -> + []; +spawn_link4(Config) when list(Config) -> + ?line {ok, Node} = start_node(spawn_link4), + + ?line Parent = self(), + ?line {_, _, FA, _} = fetch_proc_vals(self()), + + % spawn_link + ?line P = spawn_link(Node, + ?MODULE, + run_fun, + [fun() -> + Parent ! {self(), fetch_proc_vals(self())} + end]), + ?line receive + {P, PV} -> + ?line Node = node(P), + ?line check_proc_vals(true, normal, FA, 0, PV) + end, + + ?line true = stop_node(Node), + ok. + + +spawn_opt2(doc) -> ["Test spawn_opt/2"]; +spawn_opt2(suite) -> + []; +spawn_opt2(Config) when list(Config) -> + ?line Node = node(), + ?line Parent = self(), + ?line {_, _, FA, _} = fetch_proc_vals(self()), + + ?line P1 = spawn_opt(fun() -> + Parent ! {self(), fetch_proc_vals(self())} + end, + case heap_type() of + separate -> + [{fullsweep_after, 0},{min_heap_size, 1000}]; + shared -> + [] + end + ++ [link, {priority, max}]), + ?line receive + {P1, PV1} -> + ?line Node = node(P1), + ?line check_proc_vals(true, max, 0, 1000, PV1) + end, + ?line P2 = spawn_opt(fun() -> Parent ! {self(), fetch_proc_vals(self())} end, + case heap_type() of + separate -> [{min_heap_size, 10}]; + shared -> [] + end), + ?line receive + {P2, PV2} -> + ?line Node = node(P2), + ?line check_proc_vals(false, normal, FA, 10, PV2) + end, + ok. + +spawn_opt3(doc) -> ["Test spawn_opt/3"]; +spawn_opt3(suite) -> + []; +spawn_opt3(Config) when list(Config) -> + ?line {ok, Node} = start_node(spawn_opt3), + ?line Parent = self(), + ?line {_, _, FA, _} = fetch_proc_vals(self()), + ?line P1 = spawn_opt(Node, + fun() -> + Parent ! {self(), fetch_proc_vals(self())} + end, + case heap_type() of + separate -> + [{fullsweep_after,0}, {min_heap_size,1000}]; + shared -> + [] + end + ++ [link, {priority, max}]), + ?line receive + {P1, PV1} -> + ?line Node = node(P1), + ?line check_proc_vals(true, max, 0, 1000, PV1) + end, + ?line P2 = spawn_opt(Node, + fun() -> Parent ! {self(), fetch_proc_vals(self())} end, + case heap_type() of + separate -> [{min_heap_size, 10}]; + shared -> [] + end), + ?line receive + {P2, PV2} -> + ?line Node = node(P2), + ?line check_proc_vals(false, normal, FA, 10, PV2) + end, + ?line true = stop_node(Node), + ok. + +spawn_opt4(doc) -> ["Test spawn_opt/4"]; +spawn_opt4(suite) -> + []; +spawn_opt4(Config) when list(Config) -> + ?line Node = node(), + ?line Parent = self(), + ?line {_, _, FA, _} = fetch_proc_vals(self()), + ?line P1 = spawn_opt(?MODULE, + run_fun, + [fun() -> + Parent ! {self(), fetch_proc_vals(self())} + end], + case heap_type() of + separate -> + [{fullsweep_after,0}, {min_heap_size,1000}]; + shared -> + [] + end + ++ [link, {priority, max}]), + ?line receive + {P1, PV1} -> + ?line Node = node(P1), + ?line check_proc_vals(true, max, 0, 1000, PV1) + end, + ?line P2 = spawn_opt(?MODULE, + run_fun, + [fun() -> + Parent ! {self(), fetch_proc_vals(self())} + end], + case heap_type() of + separate -> [{min_heap_size, 10}]; + shared -> [] + end), + ?line receive + {P2, PV2} -> + ?line Node = node(P2), + ?line check_proc_vals(false, normal, FA, 10, PV2) + end, + ok. + +spawn_opt5(doc) -> ["Test spawn_opt/5"]; +spawn_opt5(suite) -> + []; +spawn_opt5(Config) when list(Config) -> + ?line {ok, Node} = start_node(spawn_opt5), + ?line Parent = self(), + ?line {_, _, FA, _} = fetch_proc_vals(self()), + ?line P1 = spawn_opt(Node, + ?MODULE, + run_fun, + [fun() -> + Parent ! {self(), fetch_proc_vals(self())} + end], + case heap_type() of + separate -> + [{fullsweep_after,0}, {min_heap_size,1000}]; + shared -> + [] + end + ++ [link, {priority, max}]), + ?line receive + {P1, PV1} -> + ?line Node = node(P1), + ?line check_proc_vals(true, max, 0, 1000, PV1) + end, + ?line P2 = spawn_opt(Node, + ?MODULE, + run_fun, + [fun() -> + Parent ! {self(), fetch_proc_vals(self())} + end], + case heap_type() of + separate -> [{min_heap_size, 10}]; + shared -> [] + end), + ?line receive + {P2, PV2} -> + ?line Node = node(P2), + ?line check_proc_vals(false, normal, FA, 10, PV2) + end, + ?line true = stop_node(Node), + ok. + +spawn_failures(doc) -> + ["Test failure behavior of spawn bifs"]; +spawn_failures(suite) -> + []; +spawn_failures(Config) when list(Config) -> + ?line ThisNode = node(), + ?line {ok, Node} = start_node(spawn_remote_failure), + + % unknown nodes + test_server:format("Testing unknown nodes~n", []), + ?line CrashPid1 = (catch spawn_opt('unknown@node', + erlang, + nodes, + [], + [])), + ?line true = is_pid(CrashPid1), + ?line ThisNode = node(CrashPid1), + ?line CrashPid2 = (catch spawn_opt('unknown@node', + fun () -> erlang:nodes() end, + [])), + ?line true = is_pid(CrashPid2), + ?line ThisNode = node(CrashPid2), + + ?line CrashPid3 = (catch spawn('unknown@node', + erlang, + nodes, + [])), + ?line true = is_pid(CrashPid3), + ?line ThisNode = node(CrashPid3), + ?line CrashPid4 = (catch spawn('unknown@node', + fun () -> erlang:nodes() end)), + ?line true = is_pid(CrashPid4), + ?line ThisNode = node(CrashPid4), + + ?line OTE = process_flag(trap_exit,true), + ?line CrashPid5 = (catch spawn_link('unknown@node', + erlang, + nodes, + [])), + receive + {'EXIT', CrashPid5, noconnection} -> + ?line true = is_pid(CrashPid5), + ?line ThisNode = node(CrashPid5) + end, + ?line CrashPid6 = (catch spawn_link('unknown@node', + fun () -> erlang:nodes() end)), + receive + {'EXIT', CrashPid6, noconnection} -> + ?line true = is_pid(CrashPid6), + ?line ThisNode = node(CrashPid6) + end, + process_flag(trap_exit,OTE), + case OTE of + false -> + receive + {'EXIT', P, R} -> + ?line test_server:fail({'EXIT', P, R}) + after 0 -> + ok + end; + _ -> + ok + end, + + % bad node + test_server:format("Testing bad nodes~n", []), + ?line {'EXIT', {badarg, _}} = (catch spawn_opt("Node",erlang,nodes,[],[])), + ?line {'EXIT', {badarg, _}} = (catch spawn_opt("Node", + fun () -> + erlang:nodes() + end, + [])), + ?line {'EXIT', {badarg, _}} = (catch spawn_link("Node", + fun () -> + erlang:nodes() + end)), + ?line {'EXIT', {badarg, _}} = (catch spawn("Node",erlang,nodes,[])), + ?line {'EXIT', {badarg, _}} = (catch spawn("Node", + fun () -> + erlang:nodes() + end)), + + % bad module + test_server:format("Testing bad modules~n", []), + ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,"erlang",nodes,[],[])), + ?line {'EXIT', {badarg, _}} = (catch spawn_opt("erlang",nodes,[],[])), + ?line {'EXIT', {badarg, _}} = (catch spawn_link(Node,"erlang",nodes,[])), + ?line {'EXIT', {badarg, _}} = (catch spawn_link("erlang",nodes,[])), + ?line {'EXIT', {badarg, _}} = (catch spawn(Node,"erlang",nodes,[])), + ?line {'EXIT', {badarg, _}} = (catch spawn("erlang",nodes,[])), + + % bad function + test_server:format("Testing bad functions~n", []), + ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,erlang,"nodes",[],[])), + ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,not_a_fun,[])), + ?line {'EXIT', {badarg, _}} = (catch spawn_opt(erlang,"nodes",[],[])), + ?line {'EXIT', {badarg, _}} = (catch spawn_opt(not_a_fun,[])), + ?line {'EXIT', {badarg, _}} = (catch spawn_link(Node,erlang,"nodes",[])), + ?line {'EXIT', {badarg, _}} = (catch spawn_link(Node,not_a_fun)), + ?line {'EXIT', {badarg, _}} = (catch spawn_link(erlang,"nodes",[])), + ?line {'EXIT', {badarg, _}} = (catch spawn_link(not_a_fun)), + ?line {'EXIT', {badarg, _}} = (catch spawn(Node,erlang,"nodes",[])), + ?line {'EXIT', {badarg, _}} = (catch spawn(Node,not_a_fun)), + ?line {'EXIT', {badarg, _}} = (catch spawn(erlang,"nodes",[])), + ?line {'EXIT', {badarg, _}} = (catch spawn(not_a_fun)), + + + % bad argument + test_server:format("Testing bad arguments~n", []), + ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,erlang,nodes,[a|b],[])), + ?line {'EXIT', {badarg, _}} = (catch spawn_opt(erlang,nodes,[a|b],[])), + ?line {'EXIT', {badarg, _}} = (catch spawn_link(Node,erlang,nodes,[a|b])), + ?line {'EXIT', {badarg, _}} = (catch spawn_link(erlang,nodes,[a|b])), + ?line {'EXIT', {badarg, _}} = (catch spawn(Node,erlang,nodes,[a|b])), + ?line {'EXIT', {badarg, _}} = (catch spawn(erlang,nodes,[a|b])), + + % bad option + test_server:format("Testing bad options~n", []), + ?line {'EXIT', {badarg, _}} = (catch spawn_opt(Node,erlang,nodes,[],[a|b])), + ?line {'EXIT', {badarg, _}} = (catch spawn_opt(erlang,nodes,[],[a|b])), + + + ?line true = stop_node(Node), + ok. + +check_proc_vals(Link, Priority, FullsweepAfter, MinHeapSize, {Ls, P, FA, HS}) -> + ?line Link = lists:member(self(), Ls), + ?line Priority = P, + ?line case heap_type() of + separate -> + ?line FullsweepAfter = FA, + ?line true = (HS >= MinHeapSize); + shared -> + ?line ok + end, + ?line ok. + +fetch_proc_vals(Pid) -> + ?line PI = process_info(Pid), + ?line {value,{links, Ls}} = lists:keysearch(links, 1, PI), + ?line {value,{priority,P}} = lists:keysearch(priority, 1, PI), + ?line {FA, HS} + = case heap_type() of + separate -> + ?line {value, + {garbage_collection, + Gs}} = lists:keysearch(garbage_collection, 1, PI), + ?line {value, + {fullsweep_after, + Fa}} = lists:keysearch(fullsweep_after, 1, Gs), + ?line {value, + {heap_size,Hs}} = lists:keysearch(heap_size, 1, PI), + ?line {Fa, Hs}; + shared -> + {undefined, undefined} + end, + ?line {Ls, P, FA, HS}. + +% This testcase should probably be moved somewhere else +wilderness(doc) -> + ["Test that memory allocation command line options affecting the" + "wilderness of the heap are interpreted correct by the emulator "]; +wilderness(suite) -> + []; +wilderness(Config) when list(Config) -> + ?line Dog = ?t:timetrap(?default_timeout), + ?line OKParams = {512, 8}, + ?line Alloc = erlang:system_info(allocator), + ?line test_server:format("Test server allocator info:~n~p", [Alloc]), + Result = case Alloc of + {Allocator, _, _, _} when Allocator == glibc; + Allocator == dlmalloc -> + ?line run_wilderness_test(OKParams, OKParams), + ?line {comment, + "Allocator used: " ++ atom_to_list(Allocator)}; + {OtherAllocator, _, _, _} -> + ?line {skipped, + "Only run when glibc is used. " + "Allocator used: " + ++ atom_to_list(OtherAllocator)} + end, + ?line test_server:timetrap_cancel(Dog), + Result. + +run_wilderness_test({Set_tt, Set_tp}, {Exp_tt, Exp_tp}) -> + Self = self(), + Ref = make_ref(), + SuiteDir = filename:dirname(code:which(?MODULE)), + ?line {ok, Node} = test_server:start_node(allocator_test, + slave, + [{args, + " -pa " + ++ SuiteDir + ++" +MYtt "++to_string(Set_tt) + ++" +MYtp "++to_string(Set_tp)}, + {linked, false}]), + spawn(Node, fun () -> + Self ! {Ref, erlang:system_info(allocator)} + end), + receive + {Ref, {A, V, F, S}} -> + Ett = Exp_tt*1024, + Etp = Exp_tp*1024, + ?line test_server:format("Test allocator info:~n~p", + [{A, V, F, S}]), + ?line {value, {sys_alloc, SA_Opts}} + = lists:keysearch(sys_alloc, 1, S), + ?line {value, {tt, Ett}} = lists:keysearch(tt, 1, SA_Opts), + ?line {value, {tp, Etp}} = lists:keysearch(tp, 1, SA_Opts) + end, + stop_node(Node). + +to_string(X) when integer(X) -> + integer_to_list(X); +to_string(X) when atom(X) -> + atom_to_list(X); +to_string(X) when list(X) -> + X. + +get_nodenames(N, T) -> + get_nodenames(N, T, []). + +get_nodenames(0, _, Acc) -> + Acc; +get_nodenames(N, T, Acc) -> + {A, B, C} = now(), + get_nodenames(N-1, T, [list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(T) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C)) | Acc]). + +start_node(TestCase) -> + ?line [Name] = get_nodenames(1, TestCase), + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]). + +stop_node(Node) -> + ?line true = test_server:stop_node(Node). + +run_fun(Fun) -> + Fun(). + +heap_type() -> + case catch erlang:system_info(heap_type) of + shared -> shared; + unified -> shared; + _ -> separate + end. + + diff --git a/lib/kernel/test/ch.erl b/lib/kernel/test/ch.erl new file mode 100644 index 0000000000..25d1b4354c --- /dev/null +++ b/lib/kernel/test/ch.erl @@ -0,0 +1,84 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. 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(ch). +-behaviour(gen_server). + +%% External exports +-export([start_link/1]). + +%% gen_server callbacks +-export([init/1, handle_call/3, handle_info/2, terminate/2, + handle_cast/2, code_change/3]). + +start_link(Name) -> gen_server:start_link(ch, Name, []). + +%%----------------------------------------------------------------- +%% Callback functions from gen_server +%%----------------------------------------------------------------- +init(Name) -> + process_flag(trap_exit, true), + global:re_register_name(Name, self()), + St = application:start_type(), + St1 = case St of + normal -> + normal; + local -> + local; + {takeover, _N} -> + takeover; + {failover, _N} -> + failover; + Else -> + Else + end, + + %% Slow start to make sure that applications are started + %% "at the same time". (otp_2973) + case Name of + {ch,77} -> timer:sleep(100); + _ -> ok + end, + + (catch global:send(Name, {st_type,{st, St1}})), + {ok, []}. + +handle_call({get_pid_key, Key}, _, State) -> + Res = application:get_key(Key), + {reply, Res, State}; + +handle_call(get_pid_all_key, _, State) -> + Res = application:get_all_key(), + {reply, Res, State}. + +handle_info({st_type, Msg}, State) -> + timer:sleep(1000), + (catch global:send(st_type, Msg)), + {noreply, State}; + +handle_info(_, State) -> + {noreply, State}. + +terminate(_Reason, _State) -> + ok. + +handle_cast(_, State) -> + {noreply, State}. + +code_change(_OldVsn, State, _Extra) -> + {ok, State}. diff --git a/lib/kernel/test/ch_sup.erl b/lib/kernel/test/ch_sup.erl new file mode 100644 index 0000000000..9d03628839 --- /dev/null +++ b/lib/kernel/test/ch_sup.erl @@ -0,0 +1,51 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. 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(ch_sup). +-behaviour(supervisor). + +%% External exports +-export([start/2, start_phase/3, stop/1, config_change/3]). + +%% Internal exports +-export([init/1]). + +start(_Type, {_AppN, Low, High}) -> + Name = list_to_atom(lists:concat([ch_sup, Low])), + {ok, P} = supervisor:start_link({local, Name}, ch_sup, + lists:seq(Low, High)), + {ok, P, []}. + +stop(_) -> ok. + +start_phase(_Phase, _Type, _Args) -> + ok. + +init(Nos) -> + SupFlags = {one_for_one, 12, 60}, + Chs = lists:map(fun(No) -> + {list_to_atom(lists:concat([ch,No])), + {ch, start_link, [{ch, No}]}, + permanent, 2000, worker, [ch]} + end, + Nos), + {ok, {SupFlags, Chs}}. + +config_change(Changed, New, Removed) -> + (catch global:send(conf_change,{cc, [{Changed, New, Removed}]})), + ok. diff --git a/lib/kernel/test/cleanup.erl b/lib/kernel/test/cleanup.erl new file mode 100644 index 0000000000..6e1a1edeac --- /dev/null +++ b/lib/kernel/test/cleanup.erl @@ -0,0 +1,38 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. 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(cleanup). + +-export([all/1, cleanup/1]). + +-include("test_server.hrl"). + +all(suite) -> {req, [kernel], [cleanup]}. + +cleanup(suite) -> []; +cleanup(_) -> + ?line Localhost = list_to_atom(net_adm:localhost()), + ?line net_adm:world_list([Localhost]), + ?line case nodes() of + [] -> + ok; + Nodes when list(Nodes) -> + Kill = fun(Node) -> spawn(Node, erlang, halt, []) end, + ?line lists:foreach(Kill, Nodes), + ?line test_server:fail({nodes_left, Nodes}) + end. diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl new file mode 100644 index 0000000000..9fda66711d --- /dev/null +++ b/lib/kernel/test/code_SUITE.erl @@ -0,0 +1,1236 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. 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(code_SUITE). + +-include("test_server.hrl"). + +-export([all/1]). +-export([set_path/1, get_path/1, add_path/1, add_paths/1, del_path/1, + replace_path/1, load_file/1, load_abs/1, ensure_loaded/1, + delete/1, purge/1, soft_purge/1, is_loaded/1, all_loaded/1, + load_binary/1, dir_req/1, object_code/1, set_path_file/1, + sticky_dir/1, pa_pz_option/1, add_del_path/1, + dir_disappeared/1, ext_mod_dep/1, + load_cached/1, start_node_with_cache/1, add_and_rehash/1, + where_is_file_cached/1, where_is_file_no_cache/1, + purge_stacktrace/1, mult_lib_roots/1, bad_erl_libs/1, + code_archive/1, code_archive2/1, on_load/1, + on_load_embedded/1]). + +-export([init_per_testcase/2, fin_per_testcase/2, + init_per_suite/1, end_per_suite/1, + sticky_compiler/1]). + +all(suite) -> + [set_path, get_path, add_path, add_paths, del_path, + replace_path, load_file, load_abs, ensure_loaded, + delete, purge, soft_purge, is_loaded, all_loaded, + load_binary, dir_req, object_code, set_path_file, + pa_pz_option, add_del_path, + dir_disappeared, ext_mod_dep, + load_cached, start_node_with_cache, add_and_rehash, + where_is_file_no_cache, where_is_file_cached, + purge_stacktrace, mult_lib_roots, bad_erl_libs, + code_archive, code_archive2, on_load, on_load_embedded]. + +init_per_suite(Config) -> + %% The compiler will no longer create a Beam file if + %% the module name does not match the filename, so + %% we must compile to a binary and write the Beam file + %% ourselves. + ?line Dir = filename:dirname(code:which(?MODULE)), + ?line File = filename:join(Dir, "code_a_test"), + ?line {ok,code_b_test,Code} = compile:file(File, [binary]), + ?line ok = file:write_file(File++".beam", Code), + Config. + +end_per_suite(Config) -> + Config. + +init_per_testcase(_Func, Config) -> + Dog=?t:timetrap(?t:minutes(5)), + P=code:get_path(), + P=code:get_path(), + [{watchdog, Dog}, {code_path, P}|Config]. +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog), + P=?config(code_path, Config), + true=code:set_path(P), + P=code:get_path(), + ok. + +set_path(suite) -> []; +set_path(doc) -> []; +set_path(Config) when is_list(Config) -> + P = code:get_path(), + NonExDir = filename:join(?config(priv_dir, Config), ?t:temp_name("hej")), + ?line {'EXIT',_} = (catch code:set_path({a})), + ?line {error, bad_directory} = (catch code:set_path([{a}])), + ?line {error, bad_directory} = code:set_path(NonExDir), + ?line P = code:get_path(), % still the same path. + ?line true = code:set_path(P), % set the same path again. + ?line P = code:get_path(), % still the same path. + LibDir = code:lib_dir(), + ?line true = code:set_path([LibDir | P]), + ?line [LibDir | P] = code:get_path(), + ?line true = code:set_path([LibDir]), + ?line [LibDir] = code:get_path(), + ok. + +get_path(suite) -> []; +get_path(doc) -> []; +get_path(Config) when is_list(Config) -> + ?line P = code:get_path(), + % test that all directories are strings (lists). + ?line [] = lists:filter(fun(Dir) when is_list(Dir) -> + false; + (_) -> + true + end, + P), + ok. + +add_path(suite) -> []; +add_path(doc) -> []; +add_path(Config) when is_list(Config) -> + P = code:get_path(), + ?line {'EXIT',_} = (catch code:add_path({})), + ?line {'EXIT',_} = (catch code:add_patha({})), + ?line {'EXIT',_} = (catch code:add_pathz({})), + ?line {error, bad_directory} = code:add_path("xyz"), + ?line {error, bad_directory} = code:add_patha("xyz"), + ?line {error, bad_directory} = code:add_pathz("xyz"), + LibDir = code:lib_dir(), + ?line true = code:add_path(LibDir), + ?line LibDir = lists:last(code:get_path()), + code:set_path(P), + ?line true = code:add_pathz(LibDir), + ?line LibDir = lists:last(code:get_path()), + code:set_path(P), + ?line true = code:add_patha(LibDir), + ?line [LibDir|_] = code:get_path(), + code:set_path(P), + ok. + +add_paths(suite) -> []; +add_paths(doc) -> []; +add_paths(Config) when is_list(Config) -> + P = code:get_path(), + ?line ok = code:add_paths([{}]), + ?line ok = code:add_pathsa([{}]), + ?line ok = code:add_pathsz([{}]), + ?line ok = code:add_paths(["xyz"]), + ?line ok = code:add_pathsa(["xyz"]), + ?line ok = code:add_pathsz(["xyz"]), + P = code:get_path(), % check that no directory is added. + + LibDir = code:lib_dir(), + ?line ok = code:add_paths([LibDir]), + ?line LibDir = lists:last(code:get_path()), + code:set_path(P), + ?line ok = code:add_pathsz([LibDir]), + ?line LibDir = lists:last(code:get_path()), + code:set_path(P), + ?line ok = code:add_pathsa([LibDir]), + ?line [LibDir|P] = code:get_path(), + code:set_path(P), + + RootDir = code:root_dir(), + Res = P ++ [LibDir, RootDir], + ?line ok = code:add_paths([LibDir, RootDir]), + ?line Res = code:get_path(), + code:set_path(P), + ?line ok = code:add_pathsz([LibDir, RootDir]), + ?line Res = code:get_path(), + code:set_path(P), + ?line ok = code:add_pathsa([LibDir, RootDir]), + ?line [RootDir, LibDir|P] = code:get_path(), + code:set_path(P), + + ?line ok = code:add_paths([LibDir, "xyz"]), + Res1 = P ++ [LibDir], + ?line Res1 = code:get_path(), + code:set_path(P), + ?line ok = code:add_pathsz([LibDir, "xyz"]), + ?line Res1 = code:get_path(), + code:set_path(P), + ?line ok = code:add_pathsa([LibDir, "xyz"]), + ?line [LibDir|P] = code:get_path(), + code:set_path(P), + ok. + +del_path(suite) -> []; +del_path(doc) -> []; +del_path(Config) when is_list(Config) -> + ?line P = code:get_path(), + test_server:format("Initial code:get_path()=~p~n",[P]), + ?line {'EXIT',_} = (catch code:del_path(3)), + ?line false = code:del_path(my_dummy_name), + ?line false = code:del_path("/kdlk/my_dummy_dir"), + Dir = filename:join([code:lib_dir(kernel),"ebin"]), + test_server:format("kernel dir: ~p~n",[Dir]), + + + ?line true = code:del_path(kernel), + NewP = code:get_path(), + test_server:format("Path after removing 'kernel':~p~n",[NewP]), + ReferenceP = lists:delete(Dir,P), + test_server:format("Reference path:~p~n",[ReferenceP]), + ?line NewP = ReferenceP, % check that dir is deleted + + code:set_path(P), + ?line true = code:del_path(Dir), + NewP1 = code:get_path(), + ?line NewP1 = lists:delete(Dir,P), % check that dir is deleted + code:set_path(P), + ok. + +replace_path(suite) -> []; +replace_path(doc) -> []; +replace_path(Config) when is_list(Config) -> + ?line PrivDir = ?config(priv_dir, Config), + ?line P = code:get_path(), + ?line {'EXIT',_} = (catch code:replace_path(3,"")), + ?line {error, bad_name} = code:replace_path(dummy_name,""), + ?line {error, bad_name} = code:replace_path(kernel, + "/kdlk/my_dummy_dir"), + ?line {error, bad_directory} = code:replace_path(kernel, + "/kdlk/kernel-1.2"), + ?line P = code:get_path(), % Check that path is not changed. + + ?line ok = file:set_cwd(PrivDir), + + %% Replace an existing application. + + file:make_dir("./kernel-2.11"), + {ok, Cwd} = file:get_cwd(), + NewDir = Cwd ++ "/kernel-2.11", + ?line true = code:replace_path(kernel, NewDir), + ?line NewDir = code:lib_dir(kernel), + ?line true = code:set_path(P), %Reset path + ?line ok = file:del_dir("./kernel-2.11"), + + %% Add a completly new application. + + NewAppName = "blurf_blarfer", + ?line NewAppDir = filename:join(Cwd, NewAppName ++ "-6.33.1"), + ?line ok = file:make_dir(NewAppDir), + ?line true = code:replace_path(NewAppName, NewAppDir), + ?line NewAppDir = code:lib_dir(NewAppName), + ?line NewAppDir = lists:last(code:get_path()), + ?line true = code:set_path(P), %Reset path + ?line ok = file:del_dir(NewAppDir), + + ok. + +dir_disappeared(suite) -> []; +dir_disappeared(doc) -> ["OTP-3977"]; +dir_disappeared(Config) when is_list(Config) -> + ?line PrivDir = ?config(priv_dir, Config), + ?line Dir = filename:join(PrivDir, "temp"), + ?line ok = file:make_dir(Dir), + ?line true = code:add_path(Dir), + ?line ok = file:del_dir(Dir), + ?line non_existing = code:which(bubbelskrammel), + ok. + +load_file(suite) -> []; +load_file(doc) -> []; +load_file(Config) when is_list(Config) -> + ?line {error, nofile} = code:load_file(duuuumy_mod), + ?line {error, badfile} = code:load_file(code_a_test), + ?line {'EXIT', _} = (catch code:load_file(123)), + ?line {module, code_b_test} = code:load_file(code_b_test), + TestDir = test_dir(), + code:stick_dir(TestDir), + ?line {error, sticky_directory} = code:load_file(code_b_test), + code:unstick_dir(TestDir), + ok. + +test_dir() -> + filename:dirname(code:which(?MODULE)). + +load_abs(suite) -> []; +load_abs(doc) -> []; +load_abs(Config) when is_list(Config) -> + TestDir = test_dir(), + ?line {error, nofile} = code:load_abs(TestDir ++ "/duuuumy_mod"), + ?line {error, badfile} = code:load_abs(TestDir ++ "/code_a_test"), + ?line {'EXIT', _} = (catch code:load_abs({})), + ?line {module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"), + code:stick_dir(TestDir), + ?line {error, sticky_directory} = code:load_abs(TestDir ++ "/code_b_test"), + code:unstick_dir(TestDir), + ok. + +ensure_loaded(suite) -> []; +ensure_loaded(doc) -> []; +ensure_loaded(Config) when is_list(Config) -> + ?line {module, lists} = code:ensure_loaded(lists), + case init:get_argument(mode) of + {ok, [["embedded"]]} -> + ?line {error, embedded} = code:ensure_loaded(code_b_test), + ?line {error, badarg} = code:ensure_loaded(34), + ok; + _ -> + ?line {error, nofile} = code:ensure_loaded(duuuumy_mod), + ?line {error, badfile} = code:ensure_loaded(code_a_test), + ?line {'EXIT', _} = (catch code:ensure_loaded(34)), + ?line {module, code_b_test} = code:ensure_loaded(code_b_test), + ?line {module, code_b_test} = code:ensure_loaded(code_b_test), + ok + end. + +delete(suite) -> []; +delete(doc) -> []; +delete(Config) when is_list(Config) -> + OldFlag = process_flag(trap_exit, true), + code:purge(code_b_test), + ?line Pid = code_b_test:do_spawn(), + ?line true = code:delete(code_b_test), + ?line {'EXIT',_} = (catch code:delete(122)), + ?line false = code_b_test:check_exit(Pid), + ?line false = code:delete(code_b_test), + ?line false = code_b_test:check_exit(Pid), + exit(Pid,kill), + ?line true = code_b_test:check_exit(Pid), + ?line false = code:delete(code_b_test), + code:purge(code_b_test), + process_flag(trap_exit, OldFlag), + ok. + +purge(suite) -> []; +purge(doc) -> []; +purge(Config) when is_list(Config) -> + OldFlag = process_flag(trap_exit, true), + code:purge(code_b_test), + ?line {'EXIT',_} = (catch code:purge({})), + ?line false = code:purge(code_b_test), + ?line Pid = code_b_test:do_spawn(), + ?line true = code:delete(code_b_test), + ?line false = code_b_test:check_exit(Pid), + ?line true = code:purge(code_b_test), + ?line true = code_b_test:check_exit(Pid), + process_flag(trap_exit, OldFlag), + ok. + +soft_purge(suite) -> []; +soft_purge(doc) -> []; +soft_purge(Config) when is_list(Config) -> + OldFlag = process_flag(trap_exit, true), + code:purge(code_b_test), + ?line {'EXIT',_} = (catch code:soft_purge(23)), + ?line true = code:soft_purge(code_b_test), + ?line Pid = code_b_test:do_spawn(), + ?line true = code:delete(code_b_test), + ?line false = code_b_test:check_exit(Pid), + ?line false = code:soft_purge(code_b_test), + ?line false = code_b_test:check_exit(Pid), + exit(Pid,kill), + ?line true = code_b_test:check_exit(Pid), + ?line true = code:soft_purge(code_b_test), + process_flag(trap_exit, OldFlag), + ok. + +is_loaded(suite) -> []; +is_loaded(doc) -> []; +is_loaded(Config) when is_list(Config) -> + code:purge(code_b_test), + code:delete(code_b_test), + ?line false = code:is_loaded(duuuuuumy_mod), + ?line {'EXIT',_} = (catch code:is_loaded(23)), + ?line {file, preloaded} = code:is_loaded(init), + TestDir = test_dir(), + ?line {module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"), + ?line {file, _Loaded} = code:is_loaded(code_b_test), + code:purge(code_b_test), + code:delete(code_b_test), + ok. + +all_loaded(suite) -> []; +all_loaded(doc) -> []; +all_loaded(Config) when is_list(Config) -> + case ?t:is_cover() of + true -> {skip,"Cover is running"}; + false -> all_loaded_1() + end. + +all_loaded_1() -> + ?line Preloaded = [{M,preloaded} || M <- lists:sort(erlang:pre_loaded())], + + ?line Loaded0 = lists:sort(code:all_loaded()), + ?line all_unique(Loaded0), + ?line Loaded1 = lists:keysort(2, Loaded0), + ?line Loaded2 = match_and_remove(Preloaded, Loaded1), + + ObjExt = code:objfile_extension(), + ?line [] = lists:filter(fun({Mod,AbsName}) when is_atom(Mod), is_list(AbsName) -> + Mod =:= filename:basename(AbsName, ObjExt); + (_) -> true + end, + Loaded2), + ok. + +match_and_remove([], List) -> List; +match_and_remove([X|T1], [X|T2]) -> match_and_remove(T1, T2). + +all_unique([]) -> ok; +all_unique([_]) -> ok; +all_unique([{X,_}|[{Y,_}|_]=T]) when X < Y -> all_unique(T). + +load_binary(suite) -> []; +load_binary(doc) -> []; +load_binary(Config) when is_list(Config) -> + TestDir = test_dir(), + File = TestDir ++ "/code_b_test" ++ code:objfile_extension(), + ?line {ok,Bin} = file:read_file(File), + ?line {'EXIT',_} = (catch code:load_binary(12, File, Bin)), + ?line {'EXIT',_} = (catch code:load_binary(code_b_test, 12, Bin)), + ?line {'EXIT',_} = (catch code:load_binary(code_b_test, File, 12)), + ?line {module, code_b_test} = code:load_binary(code_b_test, File, Bin), + code:stick_dir(TestDir), + ?line {error, sticky_directory} = code:load_binary(code_b_test, File, Bin), + code:unstick_dir(TestDir), + code:purge(code_b_test), + code:delete(code_b_test), + ok. + +dir_req(suite) -> []; +dir_req(doc) -> []; +dir_req(Config) when is_list(Config) -> + ?line {ok,[[Root0]]} = init:get_argument(root), + ?line Root = filename:join([Root0]), % Normalised form. + ?line Root = code:root_dir(), + LibDir = Root ++ "/lib", + ?line LibDir = code:lib_dir(), + ?line code:compiler_dir(), + ?line {error, bad_name} = code:lib_dir(duuumy), + ?line KernLib = code:lib_dir(kernel), + ?line Priv = KernLib ++ "/priv", + ?line Priv = code:priv_dir(kernel), + ?line {error, bad_name} = code:priv_dir(duuumy), + ok. + +object_code(suite) -> []; +object_code(doc) -> []; +object_code(Config) when is_list(Config) -> + TestDir = test_dir(), + P = code:get_path(), + P = code:get_path(), + code:add_path(TestDir), + ?line {module, code_b_test} = code:load_abs(TestDir ++ "/code_b_test"), + LoadedFile = filename:absname(TestDir ++ "/code_b_test" ++ + code:objfile_extension()), + ?line case code:get_object_code(code_b_test) of + {code_b_test,Bin,LoadedFile} when is_binary(Bin) -> + ok + end, + code:purge(code_b_test), + code:delete(code_b_test), + ?line error = code:get_object_code(dddddddduuuuuuumy), + ?line {'EXIT',_} = (catch code:get_object_code(23)), + ?line code:set_path(P), + ?line P=code:get_path(), + ok. + +set_path_file(suite) -> []; +set_path_file(doc) -> ["Test that set_path does not accept ", + "files as pathnames (known previous bug)"]; +set_path_file(Config) when is_list(Config) -> + File=filename:join(?config(priv_dir, Config), "testfil"), + ?line ok=file:write_file(File, list_to_binary("lite data")), + ?line {error, bad_directory}=code:set_path([File]). + +sticky_dir(suite) -> []; +sticky_dir(doc) -> ["Test that a module with the same name as a module in ", + "a sticky directory cannot be loaded."]; +sticky_dir(Config) when is_list(Config) -> + MyDir=filename:dirname(code:which(?MODULE)), + ?line {ok, Node}=?t:start_node(sticky_dir, slave,[{args, "-pa "++MyDir}]), + File=filename:join([?config(data_dir, Config), "calendar"]), + ?line Ret=rpc:call(Node, ?MODULE, sticky_compiler, [File]), + case Ret of + fail -> + ?t:fail("c:c allowed a sticky module to be compiled and loaded."); + ok -> + ok; + Other -> + test_server:format("Other: ~p",[Other]) + end, + ?t:stop_node(Node). + +sticky_compiler(File) -> + Compiled=File++code:objfile_extension(), + Dir=filename:dirname(File), + code:add_patha(Dir), + file:delete(Compiled), + case c:c(File, [{outdir, Dir}]) of + {ok, Module} -> + case catch Module:test(apa) of + {error, _} -> + fail; + {'EXIT', _} -> + ok + end; + Other -> + test_server:format("c:c(~p) returned: ~p",[File, Other]), + ok + end. + +pa_pz_option(suite) -> []; +pa_pz_option(doc) -> ["Test that the -pa and -pz options work as expected"]; +pa_pz_option(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {comment, "Slave nodes not supported on VxWorks"}; + _ -> + DDir = ?config(data_dir,Config), + PaDir = filename:join(DDir,"pa"), + PzDir = filename:join(DDir,"pz"), + ?line {ok, Node}=?t:start_node(pa_pz1, slave, + [{args, + "-pa " ++ PaDir + ++ " -pz " ++ PzDir}]), + ?line Ret=rpc:call(Node, code, get_path, []), + ?line [PaDir|Paths] = Ret, + ?line [PzDir|_] = lists:reverse(Paths), + ?t:stop_node(Node), + ?line {ok, Node2}=?t:start_node(pa_pz2, slave, + [{args, + "-mode embedded " ++ "-pa " + ++ PaDir ++ " -pz " ++ PzDir}]), + ?line Ret2=rpc:call(Node2, code, get_path, []), + ?line [PaDir|Paths2] = Ret2, + ?line [PzDir|_] = lists:reverse(Paths2), + ?t:stop_node(Node2) + end. + +add_del_path(suite) -> + []; +add_del_path(doc) -> ["add_path, del_path should not cause priv_dir(App) to fail"]; +add_del_path(Config) -> + DDir = ?config(data_dir,Config), + Dir1 = filename:join(DDir,"dummy_app-1.0/ebin"), + Dir2 = filename:join(DDir,"dummy_app-2.0/ebin"), + code:add_patha(Dir1), + ?line PrivDir1 = filename:join(DDir,"dummy_app-1.0/priv"), + ?line PrivDir1 = code:priv_dir(dummy_app), + ?line code:add_path(Dir2), % put last in path + ?line PrivDir1 = code:priv_dir(dummy_app), + ?line code:del_path(Dir2), + ?line PrivDir1 = code:priv_dir(dummy_app), + ok. + + +ext_mod_dep(suite) -> + []; +ext_mod_dep(doce) -> + ["Every module that the code_server uses should be preloaded, " + "this test case verifies that"]; +ext_mod_dep(Config) when is_list(Config) -> + xref:start(s), + xref:set_default(s, [{verbose,false},{warnings,false}, + {builtins,true},{recurse,true}]), + xref:set_library_path(s, code:get_path()), + xref:add_directory(s, filename:dirname(code:which(kernel))), + xref:add_directory(s, filename:dirname(code:which(lists))), + case catch ext_mod_dep2() of + {'EXIT', Reason} -> + xref:stop(s), + exit(Reason); + Else -> + xref:stop(s), + case Else of + ok -> ok; + _ -> test_server:fail(Else) + end + end. + +ext_mod_dep2() -> + Exports0 = code_server:module_info(exports) -- + [{module_info,0},{module_info,1}], + Exports = [{code_server,M,A} || {M,A} <- Exports0], + case analyse(Exports, [], [], 0) of + {_Visited,0} -> + ok; + {_Visited,ErrCnt} -> + {not_verified,ErrCnt} + end. + +analyse([], [], Visited, ErrCnt) -> + {Visited,ErrCnt}; +analyse([], [This={M,F,A}|Path], Visited, ErrCnt0) -> + %% The code_server has been granted to use the following modules, + %% These modules should be loaded by code.erl before + %% the code_server is started. + OK = [erlang, os, prim_file, erl_prim_loader, init, ets, + code_server, lists, lists_sort, filename, packages, + gb_sets, gb_trees, hipe_unified_loader, hipe_bifs, + prim_zip, zlib], + ErrCnt1 = + case lists:member(M, OK) or erlang:is_builtin(M,F,A) of + true -> + 0; + false -> + check_funs(This, Path) + end, + {Visited, ErrCnt1+ErrCnt0}; +analyse([MFA|R], Path, Visited0, ErrCnt0) -> + case lists:member(MFA,Visited0) of + false -> + {Visited,ErrCnt1} = analyse2(MFA, Path, Visited0), + analyse(R, Path, Visited, ErrCnt1+ErrCnt0); + true -> + analyse(R, Path, Visited0, ErrCnt0) + end. + +analyse2(MFA = {'$M_EXPR',_, _}, Path, Visited0) -> + analyse([], [MFA|Path], Visited0, 0); +analyse2(MFA={_,_,_}, Path, Visited0) -> + {ok, FL} = xref:analyze(s,{call,MFA}), + analyse(FL, [MFA|Path], my_usort([MFA|Visited0]), 0). + +%%%% We need to check these manually... +% fun's are ok as long as they are defined locally. +check_funs({'$M_EXPR','$F_EXPR',_}, + [{code_server,load_native_code,4}, + {code_server,load_native_code_1,2}, + {code_server,load_native_code,2}, + {code_server,try_load_module,4}, + {code_server,do_load_binary,4}, + {code_server,handle_call,3}, + {code_server,loop,1}|_]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',_}, + [{code_server,do_mod_call,4}, + {code_server,handle_call,3}|_]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',_}, + [{lists,flatmap,2}, + {lists,concat,1}, + {code_server,load_abs,4}, + {code_server,handle_call,3}, + {code_server,loop,1}|_]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',_}, + [{lists,foreach,2}, + {code_server,stick_dir,3}, + {code_server,handle_call,3}, + {code_server,loop,1}|_]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',1}, + [{lists,all,2}, + {code_server,is_numstr,1}, + {code_server,is_vsn,1}, + {code_server,vsn_to_num,1}, + {code_server,create_bundle,2}, + {code_server,choose_bundles,1}, + {code_server,make_path,2}, + {code_server,get_user_lib_dirs_1,1}, + {code_server,get_user_lib_dirs,0}, + {code_server,init,3}, + {code_server,start_link,1}]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',1}, + [{lists,filter,2}, + {code_server,try_archive_subdirs,3}, + {code_server,all_archive_subdirs,1}, + {code_server,archive_subdirs,1}, + {code_server,insert_name,3}, + {code_server,replace_name,2}, + {code_server,update,2}, + {code_server,maybe_update,2}, + {code_server,do_add,4}, + {code_server,add_path,4}, + {code_server,handle_call,3}, + {code_server,loop,1}, + {code_server,system_continue,3}]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',_}, + [{erlang,apply,2}, + {erlang,spawn_link,1}, + {code_server,start_link,1}]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',_}, + [{erlang,spawn_link,1},{code_server,start_link,1}]) -> 0; +check_funs({'$M_EXPR',module_info,1}, + [{hipe_unified_loader,patch_to_emu_step1,1} | _]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',2}, + [{lists,foldl,3}, + {hipe_unified_loader,sort_and_write,4} | _]) -> 0; +check_funs({'$M_EXPR','$F_EXPR',1}, + [{lists,foreach,2}, + {hipe_unified_loader,patch_consts,3} | _]) -> 0; +%% This is cheating! /raimo +%% +%% check_funs(This = {M,_,_}, Path) -> +%% case catch atom_to_list(M) of +%% [$h,$i,$p,$e | _] -> +%% test_server:format("hipe_module_ignored(~p, ~p)~n", [This, Path]), +%% 0; +%% _ -> +%% test_server:format("not_verified(~p, ~p)~n", [This, Path]), +%% 1 +%% end; +check_funs(This, Path) -> + test_server:format("not_verified(~p, ~p)~n", [This, Path]), + 1. + +my_usort(List) -> + lists:reverse(uniq(lists:sort(List),[])). + +uniq([],A) -> + A; +uniq([H|T],[]) -> + uniq(T,[H]); +uniq([H|T],[H|_]=A) -> + uniq(T,A); +uniq([H|T],A) -> + uniq(T,[H|A]). + + +load_cached(suite) -> + []; +load_cached(doc) -> + []; +load_cached(Config) when is_list(Config) -> + ?line Priv = ?config(priv_dir, Config), + ?line WD = filename:dirname(code:which(?MODULE)), + ?line {ok,Node} = + ?t:start_node(code_cache_node, peer, [{args, + "-pa " ++ WD}, + {erl, [this]}]), + CCTabCreated = fun(Tab) -> + case ets:info(Tab, name) of + code_cache -> true; + _ -> false + end + end, + ?line Tabs = rpc:call(Node, ets, all, []), + case rpc:call(Node, lists, any, [CCTabCreated,Tabs]) of + true -> + ?t:stop_node(Node), + ?t:fail("Code cache should not be active!"); + false -> + ok + end, + ?line rpc:call(Node, code, del_path, [Priv]), + ?line rpc:call(Node, code, add_pathz, [Priv]), + + FullModName = Priv ++ "/code_cache_test", + ?line {ok,Dev} = file:open(FullModName ++ ".erl", [write]), + ?line io:format(Dev, "-module(code_cache_test). -export([a/0]). a() -> ok.~n", []), + ?line ok = file:close(Dev), + ?line {ok,code_cache_test} = compile:file(FullModName, [{outdir,Priv}]), + + F = fun load_loop/2, + N = 1000, + ?line {T0,T1} = rpc:call(Node, erlang, apply, [F, [N,code_cache_test]]), + TNoCache = now_diff(T1, T0), + ?line rpc:call(Node, code, rehash, []), + ?line {T2,T3} = rpc:call(Node, erlang, apply, [F, [N,code_cache_test]]), + ?line TCache = now_diff(T3, T2), + AvgNoCache = TNoCache/N, + AvgCache = TCache/N, + ?line io:format("Avg. load time (no_cache/cache): ~w/~w~n", [AvgNoCache,AvgCache]), + ?t:stop_node(Node), + if AvgNoCache =< AvgCache -> + ?t:fail("Cache not working properly."); + true -> + ok + end. + +load_loop(N, M) -> + load_loop(N, M, now()). +load_loop(0, _M, T0) -> + {T0,now()}; +load_loop(N, M, T0) -> + code:load_file(M), + code:delete(M), + code:purge(M), + load_loop(N-1, M, T0). + +now_diff({A2, B2, C2}, {A1, B1, C1}) -> + ((A2-A1)*1000000 + B2-B1)*1000000 + C2-C1. + +start_node_with_cache(suite) -> + []; +start_node_with_cache(doc) -> + []; +start_node_with_cache(Config) when is_list(Config) -> + ?line {ok,Node} = + ?t:start_node(code_cache_node, peer, [{args, + "-code_path_cache"}, + {erl, [this]}]), + ?line Tabs = rpc:call(Node, ets, all, []), + io:format("Tabs: ~w~n", [Tabs]), + CCTabCreated = fun(Tab) -> + case rpc:call(Node, ets, info, [Tab,name]) of + code_cache -> true; + _ -> false + end + end, + ?line true = lists:any(CCTabCreated, Tabs), + ?t:stop_node(Node), + ok. + +add_and_rehash(suite) -> + []; +add_and_rehash(doc) -> + []; +add_and_rehash(Config) when is_list(Config) -> + ?line Priv = ?config(priv_dir, Config), + ?line WD = filename:dirname(code:which(?MODULE)), + ?line {ok,Node} = + ?t:start_node(code_cache_node, peer, [{args, + "-pa " ++ WD}, + {erl, [this]}]), + CCTabCreated = fun(Tab) -> + case ets:info(Tab, name) of + code_cache -> true; + _ -> false + end + end, + ?line Tabs0 = rpc:call(Node, ets, all, []), + case rpc:call(Node, lists, any, [CCTabCreated,Tabs0]) of + true -> + ?t:stop_node(Node), + ?t:fail("Code cache should not be active!"); + false -> + ok + end, + ?line ok = rpc:call(Node, code, rehash, []), % create cache + ?line Tabs1 = rpc:call(Node, ets, all, []), + ?line true = rpc:call(Node, lists, any, [CCTabCreated,Tabs1]), % cache table created + ?line ok = rpc:call(Node, code, rehash, []), + OkDir = filename:join(Priv, ""), + BadDir = filename:join(Priv, "guggemuffsussiputt"), + ?line CP = [OkDir | rpc:call(Node, code, get_path, [])], + ?line true = rpc:call(Node, code, set_path, [CP]), + CP1 = [BadDir | CP], + ?line {error,_} = rpc:call(Node, code, set_path, [CP1]), + ?line true = rpc:call(Node, code, del_path, [OkDir]), + ?line true = rpc:call(Node, code, add_path, [OkDir]), + ?line true = rpc:call(Node, code, add_path, [OkDir]), + ?line {error,_} = rpc:call(Node, code, add_path, [BadDir]), + ?line ok = rpc:call(Node, code, rehash, []), + ok. + +where_is_file_no_cache(suite) -> + []; +where_is_file_no_cache(doc) -> + []; +where_is_file_no_cache(Config) when is_list(Config) -> + ?line {T,KernelBeamFile} = timer:tc(code, where_is_file, ["kernel.beam"]), + io:format("Load time: ~w ms~n", [T]), + ?line KernelEbinDir = filename:dirname(KernelBeamFile), + ?line AppFile = filename:join(KernelEbinDir, "kernel.app"), + ?line AppFile = code:where_is_file("kernel.app"), + ?line non_existing = code:where_is_file("kernel"), % no such file + ok. + +where_is_file_cached(suite) -> + []; +where_is_file_cached(doc) -> + []; +where_is_file_cached(Config) when is_list(Config) -> + ?line {ok,Node} = + ?t:start_node(code_cache_node, peer, [{args, + "-code_path_cache"}, + {erl, [this]}]), + ?line Tabs = rpc:call(Node, ets, all, []), + io:format("Tabs: ~w~n", [Tabs]), + CCTabCreated = fun(Tab) -> + case rpc:call(Node, ets, info, [Tab,name]) of + code_cache -> true; + _ -> false + end + end, + ?line true = lists:any(CCTabCreated, Tabs), + ?line KernelBeamFile = rpc:call(Node, code, where_is_file, ["kernel.beam"]), + ?line {T,KernelBeamFile} = rpc:call(Node, timer, tc, [code,where_is_file,["kernel.beam"]]), + io:format("Load time: ~w ms~n", [T]), + ?line KernelEbinDir = rpc:call(Node, filename, dirname, [KernelBeamFile]), + ?line AppFile = rpc:call(Node, filename, join, [KernelEbinDir,"kernel.app"]), + ?line AppFile = rpc:call(Node, code, where_is_file, ["kernel.app"]), + ?line non_existing = rpc:call(Node, code, where_is_file, ["kernel"]), % no such file + ?t:stop_node(Node), + ok. + + +purge_stacktrace(suite) -> + []; +purge_stacktrace(doc) -> + ["Test that stacktrace is deleted when purging a referred module"]; +purge_stacktrace(Config) when is_list(Config) -> + ?line code:purge(code_b_test), + try code_b_test:call(fun(b) -> ok end, a) + catch + error:function_clause -> + ?line code:load_file(code_b_test), + ?line case erlang:get_stacktrace() of + [{?MODULE,_,[a]}, + {code_b_test,call,2}, + {?MODULE,purge_stacktrace,1}|_] -> + ?line false = code:purge(code_b_test), + ?line [] = erlang:get_stacktrace() + end + end, + try code_b_test:call(nofun, 2) + catch + error:function_clause -> + ?line code:load_file(code_b_test), + ?line case erlang:get_stacktrace() of + [{code_b_test,call,[nofun,2]}, + {?MODULE,purge_stacktrace,1}|_] -> + ?line false = code:purge(code_b_test), + ?line [] = erlang:get_stacktrace() + end + end, + Args = [erlang,error,[badarg]], + try code_b_test:call(erlang, error, [badarg,Args]) + catch + error:badarg -> + ?line code:load_file(code_b_test), + ?line case erlang:get_stacktrace() of + [{code_b_test,call,Args}, + {?MODULE,purge_stacktrace,1}|_] -> + ?line false = code:purge(code_b_test), + ?line [] = erlang:get_stacktrace() + end + end, + ok. + +mult_lib_roots(Config) when is_list(Config) -> + ?line DataDir = filename:join(?config(data_dir, Config), "mult_lib_roots"), + ?line mult_lib_compile(DataDir, "my_dummy_app-b/ebin/lists"), + ?line mult_lib_compile(DataDir, + "my_dummy_app-c/ebin/code_SUITE_mult_root_module"), + + %% Set up ERL_LIBS and start a slave node. + ErlLibs = filename:join(DataDir, first_root) ++ mult_lib_sep() ++ + filename:join(DataDir, second_root), + + ?line {ok,Node} = + ?t:start_node(mult_lib_roots, slave, + [{args,"-env ERL_LIBS "++ErlLibs}]), + + ?line {ok,Cwd} = file:get_cwd(), + ?line Path0 = rpc:call(Node, code, get_path, []), + ?line [Cwd,"."|Path1] = Path0, + ?line [Kernel|Path2] = Path1, + ?line [Stdlib|Path3] = Path2, + ?line mult_lib_verify_lib(Kernel, "kernel"), + ?line mult_lib_verify_lib(Stdlib, "stdlib"), + ?line [Lib1,Lib2,Lib3,Lib4,Lib5|Path] = Path3, + + + ["first_root/my_dummy_app-a/ebin", + "first_root/my_dummy_app-b/ebin", + "first_root/my_dummy_app-c/ebin", + "second_root/my_dummy_app-d/ebin", + "second_root/my_dummy_app-e/ebin"] = + [mult_lib_remove_prefix(E, DataDir) || + E <- lists:sort([Lib1,Lib2,Lib3,Lib4,Lib5])], + io:format("~p\n", [Path]), + + ?line true = rpc:call(Node, code_SUITE_mult_root_module, works_fine, []), + + ?line ?t:stop_node(Node), + ok. + +mult_lib_compile(Root, Last) -> + Mod = list_to_atom(filename:basename(Last)), + Name = filename:join([Root,"first_root",Last]), + Dir = filename:dirname(Name), + {ok,Mod} = compile:file(Name, [report,{outdir,Dir}]), + ok. + +mult_lib_sep() -> + case os:type() of + {win32,_} -> ";"; + _ -> ":" + end. + +mult_lib_verify_lib(Path, Expected) -> + Dir = filename:basename(filename:dirname(Path)), + true = lists:prefix(Expected, Dir). + +mult_lib_remove_prefix([H|T1], [H|T2]) -> + mult_lib_remove_prefix(T1, T2); +mult_lib_remove_prefix([$/|T], []) -> T. + +bad_erl_libs(Config) when is_list(Config) -> + ?line {ok,Node} = + ?t:start_node(mult_lib_roots, slave, + [{args,"-env ERL_LIBS "}]), + + ?line ?t:stop_node(Node), + + ?line {ok,Node2} = + ?t:start_node(mult_lib_roots, slave, + [{args,"-env ERL_LIBS /no/such/dir"}]), + + ?line ?t:stop_node(Node2), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Create an archive file containing an application and make use of it. + +code_archive(Config) when is_list(Config) -> + do_code_archive(Config, "code_archive_libs", false). + +code_archive2(Config) when is_list(Config) -> + do_code_archive(Config, "code_archive_libs2", true). + +do_code_archive(Config, Root, StripVsn) when is_list(Config) -> + %% Copy the orig files to priv_dir + DataDir = ?config(data_dir, Config), + PrivDir = ?config(priv_dir, Config), + App = code_archive_dict, + VsnBase = atom_to_list(App) ++ "-1.0", + Base = + case StripVsn of + true -> atom_to_list(App); + false -> VsnBase + end, + Ext = init:archive_extension(), + RootDir = filename:join([PrivDir, Root]), + ?line ok = file:make_dir(RootDir), + Archive = filename:join([RootDir, VsnBase ++ Ext]), + ?line {ok, _} = zip:create(Archive, [VsnBase], + [{compress, []}, {cwd, DataDir}]), + ?line {ok, _} = zip:extract(Archive, [{cwd, PrivDir}]), + + case StripVsn of + true -> + ?line ok = file:rename(filename:join([PrivDir, VsnBase]), + filename:join([PrivDir, Base])); + false -> + ok + end, + + io:format("DEBUG: ~p\n", [?LINE]), + %% Compile the code + ?line ok = compile_app(PrivDir, Base), + + %% Create the archive + ?line ok = file:delete(Archive), + ?line {ok, _} = zip:create(Archive, [Base], + [{compress, []}, {cwd, PrivDir}]), + + %% Set up ERL_LIBS and start a slave node. + ?line {ok, Node} = + ?t:start_node(code_archive, slave, + [{args,"-env ERL_LIBS " ++ RootDir}]), + ?line CodePath = rpc:call(Node, code, get_path, []), + AppEbin = filename:join([Archive, Base, "ebin"]), + io:format("AppEbin: ~p\n", [AppEbin]), + io:format("CodePath: ~p\n", [CodePath]), + io:format("Archive: ~p\n", [erl_prim_loader:read_file_info(Archive)]), + ?line true = lists:member(AppEbin, CodePath), + + %% Start the app + ?line ok = rpc:call(Node, application, start, [App]), + + %% Access the app priv dir + AppPrivDir = rpc:call(Node, code, priv_dir, [App]), + ?line AppPrivFile = filename:join([AppPrivDir, "code_archive.txt"]), + io:format("AppPrivFile: ~p\n", [AppPrivFile]), + ?line {ok, _Bin, _Path} = + rpc:call(Node, erl_prim_loader, get_file, [AppPrivFile]), + + %% Use the app + Tab = code_archive_tab, + Key = foo, + Val = bar, + {ok, _Pid} = rpc:call(Node, App, new, [Tab]), + error = rpc:call(Node, App, find, [Tab, Key]), + ok = rpc:call(Node, App, store, [Tab, Key, Val]), + {ok, Val} = rpc:call(Node, App, find, [Tab, Key]), + ok = rpc:call(Node, App, erase, [Tab, Key]), + error = rpc:call(Node, App, find, [Tab, Key]), + ok = rpc:call(Node, App, erase, [Tab]), + + ?line ?t:stop_node(Node), + ok. + +compile_app(TopDir, AppName) -> + AppDir = filename:join([TopDir, AppName]), + SrcDir = filename:join([AppDir, "src"]), + OutDir = filename:join([AppDir, "ebin"]), + ?line {ok, Files} = file:list_dir(SrcDir), + compile_files(Files, SrcDir, OutDir). + +compile_files([File | Files], SrcDir, OutDir) -> + case filename:extension(File) of + ".erl" -> + AbsFile = filename:join([SrcDir, File]), + case compile:file(AbsFile, [{outdir, OutDir}]) of + {ok, _Mod} -> + compile_files(Files, SrcDir, OutDir); + Error -> + {compilation_error, AbsFile, OutDir, Error} + end; + _ -> + compile_files(Files, SrcDir, OutDir) + end; +compile_files([], _, _) -> + ok. + +on_load(Config) when is_list(Config) -> + Master = on_load_test_case_process, + + ?line Data = filename:join([?config(data_dir, Config),"on_load"]), + ?line ok = file:set_cwd(Data), + ?line up_to_date = make:all([{d,'MASTER',Master}]), + + %% Register a name for this process. + ?line register(Master, self()), + + ?line {_,Ref} = spawn_monitor(fun() -> + exit(on_load_a:data()) + end), + receive + {on_load_a,start} -> ok + end, + receive + {on_load_b,start} -> ok + end, + receive + {on_load_c,PidC} -> ok + end, + + ?line Refs = on_load_massive_spawn(lists:seq(1, 50)), + receive after 7 -> ok end, + + PidC ! go, + + KernelLibDir = code:lib_dir(kernel), + receive + {on_load_c,done} -> ok + end, + receive + {on_load_b,done} -> ok + end, + receive + {on_load_a,KernelLibDir} -> ok + end, + + receive + {'DOWN',Ref,process,_,Res} -> + ?line [a,b,c] = Res + end, + + on_load_wait_for_all(Refs), + receive + Any -> + ?line ?t:fail({unexpected,Any}) + after 10 -> + ok + end. + +on_load_massive_spawn([_|T]) -> + {_,Ra} = spawn_monitor(fun() -> [a,b,c] = on_load_a:data() end), + {_,Rb} = spawn_monitor(fun() -> [b,c] = on_load_b:data() end), + {_,Rc} = spawn_monitor(fun() -> [c] = on_load_c:data() end), + [Ra,Rb,Rc|on_load_massive_spawn(T)]; +on_load_massive_spawn([]) -> []. + +on_load_wait_for_all([Ref|T]) -> + receive + {'DOWN',Ref,process,_,normal} -> + on_load_wait_for_all(T) + end; +on_load_wait_for_all([]) -> ok. + +on_load_embedded(Config) when is_list(Config) -> + try + on_load_embedded_1(Config) + catch + throw:{skip,_}=Skip -> + Skip + end. + +on_load_embedded_1(Config) -> + ?line DataDir = ?config(data_dir, Config), + + %% Link the on_load_app application into the lib directory. + ?line LibRoot = code:lib_dir(), + ?line LinkName = filename:join(LibRoot, "on_load_app-1.0"), + ?line OnLoadApp = filename:join(DataDir, "on_load_app-1.0"), + ?line file:delete(LinkName), + case file:make_symlink(OnLoadApp, LinkName) of + {error,enotsup} -> + throw({skip,"Support for symlinks required"}); + ok -> ok + end, + + %% Compile the code. + ?line OnLoadAppEbin = filename:join(LinkName, "ebin"), + ?line {ok,_ } = compile:file(filename:join([OnLoadApp,"src", + "on_load_embedded"]), + [{outdir,OnLoadAppEbin}]), + + %% Create and compile a boot file. + ?line true = code:add_pathz(OnLoadAppEbin), + Options = case is_source_dir() of + true -> [local]; + false -> [] + end, + ?line BootScript = create_boot(Config, Options), + ?line true = code:del_path(OnLoadAppEbin), + + %% Start the node and check that the on_load function was run. + ?line {ok,Node} = start_node(on_load_embedded, + "-mode embedded -boot " ++ BootScript), + ok = rpc:call(Node, on_load_embedded, status, []), + + %% Clean up. + ?line stop_node(Node), + ?line ok = file:delete(LinkName). + +create_boot(Config, Options) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line {LatestDir,LatestName} = create_script(Config), + ?line ok = file:set_cwd(LatestDir), + ?line ok = systools:make_script(LatestName, Options), + ?line ok = file:set_cwd(OldDir), + filename:join(LatestDir, LatestName). + +create_script(Config) -> + ?line PrivDir = ?config(priv_dir, Config), + ?line Name = PrivDir ++ "on_load_test", + ?line Apps = application_controller:which_applications(), + ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel, 1, Apps), + ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib, 1, Apps), + ?line {ok,Fd} = file:open(Name ++ ".rel", write), + ?line io:format(Fd, + "{release, {\"Test release 3\", \"P2A\"}, \n" + " {erts, \"9.42\"}, \n" + " [{kernel, \"~s\"}, {stdlib, \"~s\"}," + " {on_load_app, \"1.0\"}]}.\n", + [KernelVer,StdlibVer]), + ?line file:close(Fd), + {filename:dirname(Name),filename:basename(Name)}. + +is_source_dir() -> + filename:basename(code:lib_dir(kernel)) =:= "kernel" andalso + filename:basename(code:lib_dir(stdlib)) =:= "stdlib". + +start_node(Name, Param) -> + ?t:start_node(Name, slave, [{args, Param}]). + +stop_node(Node) -> + ?t:stop_node(Node). diff --git a/lib/kernel/test/code_SUITE_data/calendar.erl b/lib/kernel/test/code_SUITE_data/calendar.erl new file mode 100644 index 0000000000..c1a4a1c12a --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/calendar.erl @@ -0,0 +1,23 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. 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(calendar). +-export([test/1]). + +test(apa) -> + {error, this_function_should_not_be_called}. diff --git a/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/ebin/code_archive_dict.app b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/ebin/code_archive_dict.app new file mode 100644 index 0000000000..e3b5a5ce03 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/ebin/code_archive_dict.app @@ -0,0 +1,12 @@ +{application, code_archive_dict, + [{description, "code_archive_dict"}, + {vsn, "1.0"}, + {modules, [ + code_archive_dict, + code_archive_dict_sup + ]}, + {registered, [ + code_archive_dict_sup + ]}, + {applications, [kernel, stdlib]}, + {mod, {code_archive_dict_app, [[]]}}]}. diff --git a/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/priv/code_archive.txt b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/priv/code_archive.txt new file mode 100644 index 0000000000..8fa2c8c064 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/priv/code_archive.txt @@ -0,0 +1 @@ +Some private data... diff --git a/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict.erl b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict.erl new file mode 100644 index 0000000000..ccc954ee17 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict.erl @@ -0,0 +1,125 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. 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(code_archive_dict). +-behaviour(sys). + +%% Public +-export([new/1, store/3, erase/2, find/2, foldl/3, erase/1]). + +%% Internal +-export([init/3, loop/3]). + +%% supervisor callback +-export([start_link/2]). + +%% sys callback functions +-export([ + system_continue/3, + system_terminate/4, + system_code_change/4 + ]). + +-define(SUPERVISOR, code_archive_dict_sup). + +start_link(Name, Debug) -> + proc_lib:start_link(?MODULE, init, [self(), Name, Debug], infinity, []). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Client + +new(Name) -> + supervisor:start_child(?SUPERVISOR, [Name]). + +store(Pid, Key, Val) -> + call(Pid, {store, Key, Val}). + +erase(Pid, Key) -> + call(Pid, {erase, Key}). + +find(Pid, Key) -> + call(Pid, {find, Key}). + +foldl(Pid, Fun, Acc) -> + call(Pid, {foldl, Fun, Acc}). + +erase(Pid) -> + call(Pid, stop). + +call(Name, Msg) when is_atom(Name) -> + call(whereis(Name), Msg); +call(Pid, Msg) when is_pid(Pid) -> + Ref = erlang:monitor(process, Pid), + Pid ! {self(), Ref, Msg}, + receive + {Ref, Reply} -> + erlang:demonitor(Ref, [flush]), + Reply; + {'DOWN', Ref, _, _, Reason} -> + {error, Reason} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Server + +init(Parent, Name, Debug) -> + register(Name, self()), + Dict = dict:new(), + proc_lib:init_ack(Parent, {ok, self()}), + loop(Dict, Parent, Debug). + +loop(Dict, Parent, Debug) -> + receive + {system, From, Msg} -> + sys:handle_system_msg(Msg, From, Parent, ?MODULE, Debug, Dict); + {ReplyTo, Ref, {store, Key, Val}} -> + Dict2 = dict:store(Key, Val, Dict), + ReplyTo ! {Ref, ok}, + ?MODULE:loop(Dict2, Parent, Debug); + {ReplyTo, Ref, {erase, Key}} -> + Dict2 = dict:erase(Key, Dict), + ReplyTo ! {Ref, ok}, + ?MODULE:loop(Dict2, Parent, Debug); + {ReplyTo, Ref, {find, Key}} -> + Res = dict:find(Key, Dict), + ReplyTo ! {Ref, Res}, + ?MODULE:loop(Dict, Parent, Debug); + {ReplyTo, Ref, {foldl, Fun, Acc}} -> + Acc2 = dict:foldl(Fun, Acc, Dict), + ReplyTo ! {Ref, {ok, Acc2}}, + ?MODULE:loop(Dict, Parent, Debug); + {ReplyTo, Ref, stop} -> + ReplyTo ! {Ref, ok}, + exit(normal); + Msg -> + error_logger:format("~p got unexpected message: ~p\n", + [self(), Msg]), + ?MODULE:loop(Dict, Parent, Debug) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% sys callbacks + +system_continue(Parent, Debug, Dict) -> + ?MODULE:loop(Dict, Parent, Debug). + +system_terminate(Reason, _Parent, _Debug, _Dict) -> + exit(Reason). + +system_code_change(Dict,_Module,_OldVsn,_Extra) -> + {ok, Dict}. diff --git a/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_app.erl b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_app.erl new file mode 100644 index 0000000000..a23ef7001d --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_app.erl @@ -0,0 +1,29 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. 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(code_archive_dict_app). +-behaviour(application). + +%% Public +-export([start/2, stop/1]). + +start(_Type, Args) -> + code_archive_dict_sup:start_link(Args). + +stop(_State) -> + ok. diff --git a/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_sup.erl b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_sup.erl new file mode 100644 index 0000000000..3e427ed34a --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/code_archive_dict-1.0/src/code_archive_dict_sup.erl @@ -0,0 +1,39 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. 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(code_archive_dict_sup). +-behaviour(supervisor). + +%% Public +-export([start_link/1]). + +%% Internal +-export([init/1, start_simple_child/2]). + +-define(CHILD_MOD, code_archive_dict). + +start_link(Debug) -> + supervisor:start_link({local, ?MODULE}, ?MODULE, [Debug]). + +init([Debug]) -> + Flags = {simple_one_for_one, 0, 3600}, + MFA = {?MODULE, start_simple_child, [Debug]}, + {ok, {Flags, [{?MODULE, MFA, transient, timer:seconds(3), worker, [?CHILD_MOD]}]}}. + +start_simple_child(Debug, Name) -> + ?CHILD_MOD:start_link(Name, Debug). diff --git a/lib/kernel/test/code_SUITE_data/dummy_app-1.0/ebin/dummy_file b/lib/kernel/test/code_SUITE_data/dummy_app-1.0/ebin/dummy_file new file mode 100644 index 0000000000..5b1ed2e49c --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/dummy_app-1.0/ebin/dummy_file @@ -0,0 +1 @@ +dummy_file diff --git a/lib/kernel/test/code_SUITE_data/dummy_app-1.0/priv/dummy_file b/lib/kernel/test/code_SUITE_data/dummy_app-1.0/priv/dummy_file new file mode 100644 index 0000000000..5b1ed2e49c --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/dummy_app-1.0/priv/dummy_file @@ -0,0 +1 @@ +dummy_file diff --git a/lib/kernel/test/code_SUITE_data/dummy_app-2.0/ebin/dummy_file b/lib/kernel/test/code_SUITE_data/dummy_app-2.0/ebin/dummy_file new file mode 100644 index 0000000000..5b1ed2e49c --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/dummy_app-2.0/ebin/dummy_file @@ -0,0 +1 @@ +dummy_file diff --git a/lib/kernel/test/code_SUITE_data/dummy_app-2.0/priv/dummy_file b/lib/kernel/test/code_SUITE_data/dummy_app-2.0/priv/dummy_file new file mode 100644 index 0000000000..5b1ed2e49c --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/dummy_app-2.0/priv/dummy_file @@ -0,0 +1 @@ +dummy_file diff --git a/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-a/ebin/.gitignore b/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-a/ebin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-a/ebin/.gitignore diff --git a/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-b/ebin/lists.erl b/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-b/ebin/lists.erl new file mode 100644 index 0000000000..e97dde2703 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-b/ebin/lists.erl @@ -0,0 +1,24 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. 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(lists). + +-export([not_your_standard_lists_module/0]). + +not_your_standard_lists_module() -> + ok. diff --git a/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-c/ebin/code_SUITE_mult_root_module.erl b/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-c/ebin/code_SUITE_mult_root_module.erl new file mode 100644 index 0000000000..3c9cd75f34 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/mult_lib_roots/first_root/my_dummy_app-c/ebin/code_SUITE_mult_root_module.erl @@ -0,0 +1,24 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. 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(code_SUITE_mult_root_module). + +-export([works_fine/0]). + +works_fine() -> + true. diff --git a/lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-d/ebin/.gitignore b/lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-d/ebin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-d/ebin/.gitignore diff --git a/lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-e/ebin/.gitignore b/lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-e/ebin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/mult_lib_roots/second_root/my_dummy_app-e/ebin/.gitignore diff --git a/lib/kernel/test/code_SUITE_data/on_load/on_load_a.erl b/lib/kernel/test/code_SUITE_data/on_load/on_load_a.erl new file mode 100644 index 0000000000..660000df46 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/on_load/on_load_a.erl @@ -0,0 +1,28 @@ +-module(on_load_a). +-on_load(on_load/0). +-export([data/0]). + +on_load() -> + ?MASTER ! {?MODULE,start}, + on_load_b:data(), + + %% Call local function. + 120 = fact(5), + + %% Call remote function. + LibDir = code:lib_dir(kernel), + + ?MASTER ! {?MODULE,LibDir}, + true. + +data() -> + [a|on_load_b:data()]. + +fact(N) -> + fact(N, 1). + +fact(0, P) -> P; +fact(1, P) -> P; +fact(N, P) -> fact(N-1, P*N). + + diff --git a/lib/kernel/test/code_SUITE_data/on_load/on_load_b.erl b/lib/kernel/test/code_SUITE_data/on_load/on_load_b.erl new file mode 100644 index 0000000000..5c4d676e2d --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/on_load/on_load_b.erl @@ -0,0 +1,12 @@ +-module(on_load_b). +-on_load(on_load/0). +-export([on_load/0,data/0]). + +on_load() -> + ?MASTER ! {?MODULE,start}, + on_load_c:data(), + ?MASTER ! {?MODULE,done}, + true. + +data() -> + [b|on_load_c:data()]. diff --git a/lib/kernel/test/code_SUITE_data/on_load/on_load_c.erl b/lib/kernel/test/code_SUITE_data/on_load/on_load_c.erl new file mode 100644 index 0000000000..4b2edbfb5a --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/on_load/on_load_c.erl @@ -0,0 +1,14 @@ +-module(on_load_c). +-on_load(on_load/0). +-export([data/0]). + +on_load() -> + ?MASTER ! {?MODULE,self()}, + receive + go -> + ?MASTER ! {?MODULE,done}, + true + end. + +data() -> + [c]. diff --git a/lib/kernel/test/code_SUITE_data/on_load_app-1.0/ebin/on_load_app.app b/lib/kernel/test/code_SUITE_data/on_load_app-1.0/ebin/on_load_app.app new file mode 100644 index 0000000000..6b79a74c0a --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/on_load_app-1.0/ebin/on_load_app.app @@ -0,0 +1,10 @@ +{application, on_load_app, + [ + {description, "ERTS CXC 138 10"}, + {vsn, "1.0"}, + {modules, [on_load_embedded]}, + {applications, []}, + {registered, []}, + {env, []} + ] +}. diff --git a/lib/kernel/test/code_SUITE_data/on_load_app-1.0/src/on_load_embedded.erl b/lib/kernel/test/code_SUITE_data/on_load_app-1.0/src/on_load_embedded.erl new file mode 100644 index 0000000000..bfc26864d5 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/on_load_app-1.0/src/on_load_embedded.erl @@ -0,0 +1,18 @@ +-module(on_load_embedded). +-export([status/0]). +-on_load(run_me/0). + +run_me() -> + spawn(fun() -> + register(everything_is_fine, self()), + receive Any -> + ok + end + end), + true. + +status() -> + case whereis(everything_is_fine) of + Pid when is_pid(Pid) -> + ok + end. diff --git a/lib/kernel/test/code_SUITE_data/pa/dummy b/lib/kernel/test/code_SUITE_data/pa/dummy new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/pa/dummy @@ -0,0 +1 @@ + diff --git a/lib/kernel/test/code_SUITE_data/pz/dummy b/lib/kernel/test/code_SUITE_data/pz/dummy new file mode 100644 index 0000000000..8b13789179 --- /dev/null +++ b/lib/kernel/test/code_SUITE_data/pz/dummy @@ -0,0 +1 @@ + diff --git a/lib/kernel/test/code_a_test.erl b/lib/kernel/test/code_a_test.erl new file mode 100644 index 0000000000..745bbf032c --- /dev/null +++ b/lib/kernel/test/code_a_test.erl @@ -0,0 +1,28 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. 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(code_b_test). + +%% This module has wrong module name in file. + +-export([a/0]). + +a() -> ok. + + + diff --git a/lib/kernel/test/code_b_test.erl b/lib/kernel/test/code_b_test.erl new file mode 100644 index 0000000000..0f0107a2b4 --- /dev/null +++ b/lib/kernel/test/code_b_test.erl @@ -0,0 +1,47 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. 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(code_b_test). + +-export([do_spawn/0, loop/0, check_exit/1, call/2, call/3]). + +do_spawn() -> + spawn_link(code_b_test, loop, []). + +loop() -> + receive + dummy -> loop() + end. + +check_exit(Pid) -> + receive + {'EXIT',Pid,_} -> + true + after 10 -> + %% We used to wait 1 ms. That is not always enough when + %% running the SMP emulator on a slow computer. + false + end. + +call({M,F}=Fun, Arg) when is_atom(M), is_atom(F) -> + [Fun(Arg)]; +call(Fun, Arg) when is_function(Fun) -> + [Fun(Arg)]. + +call(M, F, Args) -> + [erlang:apply(M, F, Args)]. diff --git a/lib/kernel/test/disk_log_SUITE.erl b/lib/kernel/test/disk_log_SUITE.erl new file mode 100644 index 0000000000..ade9644c15 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE.erl @@ -0,0 +1,5162 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. 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(disk_log_SUITE). + +%-define(debug, true). + +-ifdef(debug). +-define(format(S, A), io:format(S, A)). +-define(line, put(line, ?LINE), ). +-define(privdir(_), "./disk_log_SUITE_priv"). +-define(datadir(_), "./disk_log_SUITE_data"). +-define(config(X,Y), foo). +-define(t,test_server). +-else. +-include("test_server.hrl"). +-define(format(S, A), ok). +-define(privdir(Conf), ?config(priv_dir, Conf)). +-define(datadir(Conf), ?config(data_dir, Conf)). +-endif. + +-export([all/1, + + halt_int/1, halt_int_inf/1, halt_int_sz/1, + halt_int_sz_1/1, halt_int_sz_2/1, + + read_mode/1, halt_int_ro/1, halt_ext_ro/1, wrap_int_ro/1, + wrap_ext_ro/1, halt_trunc/1, halt_misc/1, halt_ro_alog/1, + halt_ro_balog/1, halt_ro_crash/1, + + wrap_int/1, wrap_int_1/1, wrap_int_2/1, inc_wrap_file/1, + + halt_ext/1, halt_ext_inf/1, + + halt_ext_sz/1, halt_ext_sz_1/1, halt_ext_sz_2/1, + + wrap_ext/1, wrap_ext_1/1, wrap_ext_2/1, + + head/1, head_func/1, plain_head/1, one_header/1, + + notif/1, wrap_notif/1, full_notif/1, trunc_notif/1, blocked_notif/1, + + new_idx_vsn/1, + + reopen/1, + + block/1, block_blocked/1, block_queue/1, block_queue2/1, + + unblock/1, + + open/1, open_overwrite/1, open_size/1, open_truncate/1, open_error/1, + + close/1, close_race/1, close_block/1, close_deadlock/1, + + error/1, error_repair/1, error_log/1, error_index/1, + + chunk/1, + + truncate/1, + + many_users/1, + + info/1, info_current/1, + + change_size/1, change_size_before/1, change_size_during/1, + change_size_after/1, default_size/1, change_size2/1, + change_size_truncate/1, + + change_attribute/1, + + distribution/1, dist_open/1, dist_error_open/1, dist_notify/1, + dist_terminate/1, dist_accessible/1, dist_deadlock/1, + dist_open2/1, other_groups/1, + + evil/1, + + otp_6278/1]). + +-export([head_fun/1, hf/0, lserv/1, + measure/0, init_m/1, xx/0, head_exit/0, slow_header/1]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +-export([try_unblock/1]). + +-export([client/4]). + +-define(default_timeout, ?t:minutes(1)). + +%% error_logger +-export([init/1, + handle_event/2, handle_call/2, handle_info/2, + terminate/2]). + +-include_lib("kernel/include/file.hrl"). +-include_lib("kernel/src/disk_log.hrl"). + +%% TODO (old): +%% - global logs +%% - badarg +%% - force file:write fail (how?) +%% - kill logging proc while he is logging +%% - kill logging node while he is logging +%% - test chunk_step + +%% These are all tests, the list to be returned by all(). +-define(ALL_TESTS, + [halt_int, wrap_int, halt_ext, wrap_ext, read_mode, head, + notif, new_idx_vsn, reopen, block, unblock, open, close, + error, chunk, truncate, many_users, info, change_size, + change_attribute, distribution, evil, otp_6278]). + +%% The following two lists should be mutually exclusive. To skip a case +%% on VxWorks altogether, use the kernel.spec.vxworks file instead. +%% PLEASE don't skip out of laziness, the goal is to make every +%% testcase runnable on VxWorks. + +%% These test cases should be skipped if the VxWorks card is +%% configured without NFS cache. +-define(SKIP_NO_CACHE,[distribution]). +%% These tests should be skipped if the VxWorks card is configured *with* +%% nfs cache. +-define(SKIP_LARGE_CACHE,[inc_wrap_file, halt_ext, wrap_ext, read_mode, + head, wrap_notif, open_size, error_log, + error_index, chunk, + change_size_before, change_size_during, + change_size_after, default_size]). + + +all(suite) -> + ?ALL_TESTS. + + +init_per_testcase(Case, Config) -> + case should_skip(Case,Config) of + true -> + CS = check_nfs(Config), + {skipped, lists:flatten + (io_lib:format + ("The test does not work " + "with current NFS cache size (~w)," + " to get this test to run, " + "~s the NFS cache size~n", + [CS, case CS of + 0 -> + "enlarge"; + _ -> + "zero" + end]))}; + _ -> + Dog=?t:timetrap(?t:minutes(2)), + [{watchdog, Dog}|Config] + end. + +fin_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +halt_int(suite) -> [halt_int_inf, halt_int_sz]. + +halt_int_inf(suite) -> []; +halt_int_inf(doc) -> ["Test simple halt disk log, size infinity"]; +halt_int_inf(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + ?line ok = disk_log:start(), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,internal}, + {file, File}]), + ?line simple_log(a), + ?line ok = disk_log:close(a), + ?line ok = file:delete(File). + +halt_int_sz(suite) -> [halt_int_sz_1, halt_int_sz_2]. + +halt_int_sz_1(suite) -> []; +halt_int_sz_1(doc) -> ["Test simple halt disk log, size defined"]; +halt_int_sz_1(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,18000}, + {format,internal}, + {file, File}]), + ?line simple_log(a), + ?line ok = disk_log:truncate(a), + ?line [] = get_all_terms(a), + T1 = mk_bytes(10000), + T2 = mk_bytes(5000), + ?line ok = disk_log:log(a, T1), + ?line case get_all_terms(a) of + [T1] -> + ok; + E1 -> + test_server_fail({bad_terms, E1, [T1]}) + end, + ?line ok = disk_log:log(a, T2), + ?line {error, {full, a}} = disk_log:log(a, T1), + ?line ok = disk_log:alog(a, T1), + ?line case get_all_terms(a) of + [T1, T2] -> + ok; + E2 -> + test_server_fail({bad_terms, E2, [T1, T2]}) + end, + ?line ok = disk_log:close(a), + ?line ok = file:delete(File). + +halt_int_sz_2(suite) -> []; +halt_int_sz_2(doc) -> ["Test simple halt disk log, size ~8192"]; +halt_int_sz_2(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File1 = filename:join(Dir, "a.LOG"), + File2 = filename:join(Dir, "b.LOG"), + File3 = filename:join(Dir, "c.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,8191}, + {format,internal}, + {file, File1}]), + ?line {ok, b} = disk_log:open([{name,b}, {type,halt}, {size,8192}, + {format,internal}, + {file, File2}]), + ?line {ok, c} = disk_log:open([{name,c}, {type,halt}, {size,8193}, + {format,internal}, + {file, File3}]), + T1 = mk_bytes(8191-16), % 16 is size of header + magics for 1 item + T2 = mk_bytes(8192-16), + T3 = mk_bytes(8193-16), + ?line ok = disk_log:log(a, T1), + ?line ok = disk_log:log(b, T2), + ?line ok = disk_log:log(c, T3), + ?line case get_all_terms(a) of + [T1] -> + ok; + E1 -> + test_server_fail({bad_terms, E1, [T1]}) + end, + ?line case get_all_terms(b) of + [T2] -> + ok; + E2 -> + test_server_fail({bad_terms, E2, [T2]}) + end, + ?line case get_all_terms(c) of + [T3] -> + ok; + E3 -> + test_server_fail({bad_terms, E3, [T3]}) + end, + ?line ok = disk_log:truncate(a), + ?line ok = disk_log:truncate(b), + ?line {error, {full, a}} = disk_log:log(a, T2), + ?line {error, {full, b}} = disk_log:log(b, T3), + ?line [] = get_all_terms(a), + ?line [] = get_all_terms(b), + ?line ok = disk_log:close(a), + ?line ok = disk_log:close(b), + ?line ok = disk_log:close(c), + ?line ok = file:delete(File1), + ?line ok = file:delete(File2), + ?line ok = file:delete(File3), + ok. + +read_mode(suite) -> [halt_int_ro, halt_ext_ro, + wrap_int_ro, wrap_ext_ro, + halt_trunc, halt_misc, halt_ro_alog, halt_ro_balog, + halt_ro_crash]. + +halt_int_ro(suite) -> []; +halt_int_ro(doc) -> ["Test simple halt disk log, read only, internal"]; +halt_int_ro(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,internal}, {file, File}]), + simple_log(a), + ?line ok = disk_log:close(a), + + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,internal}, {file, File}, + {mode,read_only}]), + T1 = "not allowed to write", + ?line {error, {read_only_mode, a}} = disk_log:log(a, T1), + ?line ok = disk_log:close(a), + ?line ok = file:delete(File). + +halt_ext_ro(suite) -> []; +halt_ext_ro(doc) -> ["Test simple halt disk log, read only, external"]; +halt_ext_ro(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,external}, {file, File}]), + xsimple_log(File, a), + ?line ok = disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,external}, {file, File}, + {mode,read_only}]), + T1 = "not allowed to write", + ?line {error, {read_only_mode, a}} = disk_log:blog(a, T1), + ?line ok = disk_log:close(a), + ?line ok = file:delete(File). + +wrap_int_ro(suite) -> []; +wrap_int_ro(doc) -> ["Test simple wrap disk log, read only, internal"]; +wrap_int_ro(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}}, + {format,internal}, {file, File}]), + simple_log(a), + ?line ok = disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}}, + {format,internal}, {file, File}, {mode,read_only}]), + T1 = "not allowed to write", + ?line {error, {read_only_mode, a}} = disk_log:log(a, T1), + ?line ok = disk_log:close(a), + ?line del(File, 4). + +wrap_ext_ro(suite) -> []; +wrap_ext_ro(doc) -> ["Test simple wrap disk log, read only, external"]; +wrap_ext_ro(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}}, + {format,external}, {file, File}]), + x2simple_log(File ++ ".1", a), + ?line ok = disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}}, + {format,external}, {file, File}, + {mode,read_only}]), + T1 = "not allowed to write", + ?line {error, {read_only_mode, a}} = disk_log:blog(a, T1), + ?line {error, {read_only_mode, a}} = disk_log:inc_wrap_file(a), + ?line ok = disk_log:close(a), + del(File, 4). + +halt_trunc(suite) -> []; +halt_trunc(doc) -> ["Test truncation of halt disk log"]; +halt_trunc(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,internal}, {file, File}]), + simple_log(a), + ?line ok = disk_log:close(a), + ?line {error,{badarg,repair_read_only}} = + disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {repair, truncate}, {format,internal}, + {file, File}, {mode,read_only}]), + ?line ok = file:delete(File). + +halt_misc(suite) -> []; +halt_misc(doc) -> ["Test truncation of halt disk log"]; +halt_misc(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,internal}, {file, File}]), + simple_log(a), + ?line ok = disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,internal}, {file, File}, + {mode,read_only}]), + T1 = "not allowed to write", + ?line {error, {read_only_mode, a}} = disk_log:log(a, T1), + ?line {error, {read_only_mode, a}} = disk_log:sync(a), + ?line {error, {read_only_mode, a}} = disk_log:reopen(a, "b.LOG"), + ?line {error, {read_only_mode, a}} = + disk_log:change_header(a, {head,header}), + ?line {error, {read_only_mode, a}} = + disk_log:change_size(a, inifinity), + ?line ok = disk_log:close(a), + ?line ok = file:delete(File). + +halt_ro_alog(suite) -> []; +halt_ro_alog(doc) -> ["Test truncation of halt disk log, read only"]; +halt_ro_alog(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,internal}, {file, File}]), + simple_log(a), + ?line ok = disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {notify,true}, {format,internal}, + {file, File}, {mode,read_only}]), + T1 = "not allowed to write", + ?line ok = disk_log:alog(a, T1), + ?line ok = halt_ro_alog_wait_notify(a, T1), + ?line ok = disk_log:close(a), + ?line ok = file:delete(File). + +halt_ro_alog_wait_notify(Log, T) -> + Term = term_to_binary(T), + receive + {disk_log, _, Log,{read_only, Term}} -> + ok; + Other -> + Other + after 5000 -> + failed + end. + +halt_ro_balog(suite) -> []; +halt_ro_balog(doc) -> ["Test truncation of halt disk log, read only"]; +halt_ro_balog(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,internal}, {file, File}]), + simple_log(a), + ?line ok = disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {notify,true}, {format,external}, + {file, File}, {mode,read_only}]), + T1 = "not allowed to write", + ?line ok = disk_log:balog(a, T1), + ?line ok = halt_ro_balog_wait_notify(a, T1), + ?line ok = disk_log:close(a), + ?line ok = file:delete(File). + +halt_ro_balog_wait_notify(Log, T) -> + Term = list_to_binary(T), + receive + {disk_log, _, Log,{read_only, Term}} -> + ok; + Other -> + Other + after 5000 -> + failed + end. + +halt_ro_crash(suite) -> []; +halt_ro_crash(doc) -> ["Test truncation of halt disk log, read only, repair"]; +halt_ro_crash(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + + ?line file:delete(File), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,internal},{file, File}]), + simple_log(a), + ?line ok = disk_log:close(a), + crash(File, 10), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {notify,true}, {format,internal}, + {file, File}, {mode,read_only}]), + + ?line Error1 = {error, {read_only_mode, a}} = disk_log:truncate(a), + ?line "The disk log" ++ _ = format_error(Error1), + + %% crash/1 sets the length of the first item to something big (2.5 kb). + %% In R6B, binary_to_term accepts garbage at the end of the binary, + %% which means that the first item is recognized! + %% This is how it was before R6B: + %% ?line {C1,T1,15} = disk_log:chunk(a,start), + %% ?line {C2,T2} = disk_log:chunk(a,C1), + {C1,_OneItem,7478} = disk_log:chunk(a,start), + {C2, [], 7} = disk_log:chunk(a,C1), + ?line eof = disk_log:chunk(a,C2), + ?line ok = disk_log:close(a), + ?line ok = file:delete(File). + + + + +wrap_int(suite) -> [wrap_int_1, wrap_int_2, inc_wrap_file]. + +wrap_int_1(suite) -> []; +wrap_int_1(doc) -> ["Test wrap disk log, internal"]; +wrap_int_1(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}}, + {format,internal}, + {file, File}]), + ?line [_] = + lists:filter(fun(P) -> disk_log:pid2name(P) =/= undefined end, + erlang:processes()), + simple_log(a), + ?line ok = disk_log:close(a), + del(File, 4), + ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}}, + {format,internal}, + {file, File}]), + ?line [] = get_all_terms(a), + T1 = mk_bytes(10000), % file 2 + T2 = mk_bytes(5000), % file 3 + T3 = mk_bytes(4000), % file 4 + T4 = mk_bytes(2000), % file 4 + T5 = mk_bytes(5000), % file 1 + T6 = mk_bytes(5000), % file 2 + ?line ok = disk_log:log(a, T1), + ?line ok = disk_log:log(a, T2), + ?line ok = disk_log:log(a, T3), + ?line ok = disk_log:log_terms(a, [T4, T5, T6]), + ?line case get_all_terms(a) of + [T2,T3,T4,T5,T6] -> + ok; + E1 -> + test_server_fail({bad_terms, E1, [T2,T3,T4,T5,T6]}) + end, + ?line ok = disk_log:close(a), + del(File, 4). + +wrap_int_2(suite) -> []; +wrap_int_2(doc) -> ["Test wrap disk log, internal"]; +wrap_int_2(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File1 = filename:join(Dir, "a.LOG"), + File2 = filename:join(Dir, "b.LOG"), + File3 = filename:join(Dir, "c.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8191,3}}, + {format,internal}, + {file, File1}]), + ?line {ok, b} = disk_log:open([{name,b}, {type,wrap}, {size,{8192,3}}, + {format,internal}, + {file, File2}]), + ?line {ok, c} = disk_log:open([{name,c}, {type,wrap}, {size,{8193,3}}, + {format,internal}, + {file, File3}]), + T1 = mk_bytes(8191-16), % 16 is size of header + magics for 1 item + T2 = mk_bytes(8192-16), + T3 = mk_bytes(8193-16), + ?line ok = disk_log:log(a, T1), + ?line ok = disk_log:log(b, T2), + ?line ok = disk_log:log(c, T3), + ?line case get_all_terms(a) of + [T1] -> + ok; + E1 -> + test_server_fail({bad_terms, E1, [T1]}) + end, + ?line case get_all_terms(b) of + [T2] -> + ok; + E2 -> + test_server_fail({bad_terms, E2, [T2]}) + end, + ?line case get_all_terms(c) of + [T3] -> + ok; + E3 -> + test_server_fail({bad_terms, E3, [T3]}) + end, + ?line ok = disk_log:close(a), + ?line ok = disk_log:close(b), + ?line ok = disk_log:close(c), + del(File1, 3), + del(File2, 3), + del(File3, 3). + +inc_wrap_file(suite) -> []; +inc_wrap_file(doc) -> ["Test disk log, force a change to next file"]; +inc_wrap_file(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File1 = filename:join(Dir, "a.LOG"), + File2 = filename:join(Dir, "b.LOG"), + File3 = filename:join(Dir, "c.LOG"), + + %% Test that halt logs gets an error message + ?line {ok, a} = disk_log:open([{name, a}, {type, halt}, + {format, internal}, + {file, File1}]), + ?line ok = disk_log:log(a, "message one"), + ?line {error, {halt_log, a}} = disk_log:inc_wrap_file(a), + + %% test an internally formatted wrap log file + ?line {ok, b} = disk_log:open([{name, b}, {type, wrap}, {size, {100,3}}, + {format, internal}, {head, 'thisisahead'}, + {file, File2}]), + ?line ok = disk_log:log(b, "message one"), + ?line ok = disk_log:inc_wrap_file(b), + ?line ok = disk_log:log(b, "message two"), + ?line ok = disk_log:inc_wrap_file(b), + ?line ok = disk_log:log(b, "message three"), + ?line ok = disk_log:inc_wrap_file(b), + ?line ok = disk_log:log(b, "message four"), + ?line T1 = get_all_terms(b), + ?line ['thisisahead', "message two", + 'thisisahead', "message three", + 'thisisahead', "message four"] = T1, + + %% test an externally formatted wrap log file + ?line {ok, c} = disk_log:open([{name, c}, {type, wrap}, {size, {100,3}}, + {format,external}, {head,"this is a head "}, + {file, File3}]), + ?line ok = disk_log:blog(c, "message one"), + ?line ok = disk_log:inc_wrap_file(c), + ?line ok = disk_log:blog(c, "message two"), + ?line ok = disk_log:inc_wrap_file(c), + ?line ok = disk_log:blog(c, "message three"), + ?line ok = disk_log:inc_wrap_file(c), + ?line ok = disk_log:blog(c, "message four"), + ?line ok = disk_log:sync(c), + ?line {ok, Fd31} = file:open(File3 ++ ".1", [read]), + ?line {ok,"this is a head message four"} = file:read(Fd31, 200), + ?line {ok, Fd32} = file:open(File3 ++ ".2", [read]), + ?line {ok,"this is a head message two"} = file:read(Fd32, 200), + ?line {ok, Fd33} = file:open(File3 ++ ".3", [read]), + ?line {ok,"this is a head message three"} = file:read(Fd33, 200), + ?line ok = file:close(Fd31), + ?line ok = file:close(Fd32), + ?line ok = file:close(Fd33), + + ?line ok = disk_log:close(a), + ?line ok = disk_log:close(b), + ?line ok = disk_log:close(c), + ?line ok = file:delete(File1), + del(File2, 3), + del(File3, 3). + + + +halt_ext(suite) -> [halt_ext_inf, halt_ext_sz]. + +halt_ext_inf(suite) -> []; +halt_ext_inf(doc) -> ["Test halt disk log, external, infinity"]; +halt_ext_inf(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,external}, + {file, File}]), + ?line xsimple_log(File, a), + ?line ok = disk_log:close(a), + ?line ok = file:delete(File). + +halt_ext_sz(suite) -> [halt_ext_sz_1, halt_ext_sz_2]. + +halt_ext_sz_1(suite) -> []; +halt_ext_sz_1(doc) -> ["Test halt disk log, external, size defined"]; +halt_ext_sz_1(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,18000}, + {format,external}, + {file, File}]), + xsimple_log(File, a), + ?line ok = disk_log:truncate(a), + ?line [] = get_list(File, a), + {B1, T1} = x_mk_bytes(10000), + {B2, T2} = x_mk_bytes(5000), + {B3, T3} = x_mk_bytes(1000), + ?line ok = disk_log:blog(a, B1), + ?line case get_list(File, a) of + T1 -> + ok; + E1 -> + test_server_fail({bad_terms, E1, T1}) + end, + ?line ok = disk_log:blog(a, B2), + ?line {error, {full, a}} = disk_log:blog_terms(a, [B3,B3,B1]), + ?line ok = disk_log:balog(a, B1), + ?line Tmp = T1 ++ T2 ++ T3 ++ T3, + ?line case get_list(File, a) of + Tmp -> + ok; + E2 -> + test_server_fail({bad_terms, E2, Tmp}) + end, + ?line ok = disk_log:close(a), + ?line ok = file:delete(File). + +halt_ext_sz_2(suite) -> []; +halt_ext_sz_2(doc) -> ["Test halt disk log, external, size defined"]; +halt_ext_sz_2(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File1 = filename:join(Dir, "a.LOG"), + File2 = filename:join(Dir, "b.LOG"), + File3 = filename:join(Dir, "c.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,8191}, + {format,external}, + {file, File1}]), + ?line {ok, b} = disk_log:open([{name,b}, {type,halt}, {size,8192}, + {format,external}, + {file, File2}]), + ?line {ok, c} = disk_log:open([{name,c}, {type,halt}, {size,8193}, + {format,external}, + {file, File3}]), + {B1, T1} = x_mk_bytes(8191), + {B2, T2} = x_mk_bytes(8192), + {B3, T3} = x_mk_bytes(8193), + ?line ok = disk_log:blog(a, B1), + ?line ok = disk_log:blog(b, B2), + ?line ok = disk_log:blog(c, B3), + ?line case get_list(File1, a) of + T1 -> + ok; + E1 -> + test_server_fail({bad_terms, E1, T1}) + end, + ?line case get_list(File2, b) of + T2 -> + ok; + E2 -> + test_server_fail({bad_terms, E2, T2}) + end, + ?line case get_list(File3, c) of + T3 -> + ok; + E3 -> + test_server_fail({bad_terms, E3, T3}) + end, + ?line ok = disk_log:truncate(a), + ?line ok = disk_log:truncate(b), + ?line {error, {full, a}} = disk_log:blog(a, B2), + ?line Error1 = {error, {full, b}} = disk_log:blog(b, B3), + ?line "The halt log" ++ _ = format_error(Error1), + ?line true = info(b, full, false), + ?line [] = get_list(File1, a), + ?line [] = get_list(File2, b), + ?line ok = disk_log:close(a), + ?line ok = disk_log:close(b), + ?line ok = disk_log:close(c), + ?line ok = file:delete(File1), + ?line ok = file:delete(File2), + ?line ok = file:delete(File3), + ok. + +wrap_ext(suite) -> [wrap_ext_1, wrap_ext_2]. + +wrap_ext_1(suite) -> []; +wrap_ext_1(doc) -> ["Test wrap disk log, external, size defined"]; +wrap_ext_1(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}}, + {format,external}, + {file, File}]), + x2simple_log(File ++ ".1", a), + ?line ok = disk_log:close(a), +% del(File, 4), + ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8000, 4}}, + {format,external}, + {file, File}]), + {B1, _T1} = x_mk_bytes(10000), % file 2 + {B2, T2} = x_mk_bytes(5000), % file 3 + {B3, T3} = x_mk_bytes(4000), % file 4 + {B4, T4} = x_mk_bytes(2000), % file 4 + {B5, T5} = x_mk_bytes(5000), % file 1 + {B6, T6} = x_mk_bytes(5000), % file 2 + ?line ok = disk_log:blog(a, B1), + ?line ok = disk_log:blog(a, B2), + ?line ok = disk_log:blog(a, B3), + ?line ok = disk_log:blog_terms(a, [B4, B5, B6]), + ?line case get_list(File ++ ".3", a) of + T2 -> + ok; + E2 -> + test_server_fail({bad_terms, E2, T2}) + end, + ?line T34 = T3 ++ T4, + ?line case get_list(File ++ ".4", a) of + T34 -> + ok; + E34 -> + test_server_fail({bad_terms, E34, T34}) + end, + ?line case get_list(File ++ ".1", a) of + T5 -> + ok; + E5 -> + test_server_fail({bad_terms, E5, T5}) + end, + ?line case get_list(File ++ ".2", a) of + T6 -> + ok; + E6 -> + test_server_fail({bad_terms, E6, T6}) + end, + ?line ok = disk_log:close(a), + del(File, 4). + +wrap_ext_2(suite) -> []; +wrap_ext_2(doc) -> ["Test wrap disk log, external, size defined"]; +wrap_ext_2(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File1 = filename:join(Dir, "a.LOG"), + File2 = filename:join(Dir, "b.LOG"), + File3 = filename:join(Dir, "c.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{8191,3}}, + {format,external}, + {file, File1}]), + ?line {ok, b} = disk_log:open([{name,b}, {type,wrap}, {size,{8192,3}}, + {format,external}, + {file, File2}]), + ?line {ok, c} = disk_log:open([{name,c}, {type,wrap}, {size,{8193,3}}, + {format,external}, + {file, File3}]), + {B1, T1} = x_mk_bytes(8191), + {B2, T2} = x_mk_bytes(8192), + {B3, T3} = x_mk_bytes(8193), + ?line ok = disk_log:blog(a, B1), + ?line ok = disk_log:blog(b, B2), + ?line ok = disk_log:blog(c, B3), + ?line case get_list(File1 ++ ".1", a) of + T1 -> + ok; + E1 -> + test_server_fail({bad_terms, E1, T1}) + end, + ?line case get_list(File2 ++ ".1", b) of + T2 -> + ok; + E2 -> + test_server_fail({bad_terms, E2, T2}) + end, + ?line case get_list(File3 ++ ".1", c) of + T3 -> + ok; + E3 -> + test_server_fail({bad_terms, E3, T3}) + end, + ?line ok = disk_log:close(a), + ?line ok = disk_log:close(b), + ?line ok = disk_log:close(c), + ?line del(File1, 3), + ?line del(File2, 3), + ?line del(File3, 3), + ok. + +simple_log(Log) -> + T1 = "hej", + T2 = hopp, + T3 = {tjena, 12}, + T4 = mk_bytes(10000), + ?line ok = disk_log:log(Log, T1), + ?line ok = disk_log:log_terms(Log, [T2, T3]), + ?line case get_all_terms(Log) of + [T1, T2, T3] -> + ok; + E1 -> + test_server_fail({bad_terms, E1, [T1, T2, T3]}) + end, + ?line ok = disk_log:log(a, T4), + ?line case get_all_terms(Log) of + [T1, T2, T3, T4] -> + ok; + E2 -> + test_server_fail({bad_terms, E2, [T1, T2, T3, T4]}) + end. + +xsimple_log(File, Log) -> + T1 = "hej", + T2 = list_to_binary("hopp"), + T3 = list_to_binary(["sena", list_to_binary("sejer")]), + T4 = list_to_binary(By = mk_bytes(10000)), + ?line ok = disk_log:blog(Log, T1), + ?line ok = disk_log:blog_terms(Log, [T2, T3]), + ?line X = "hejhoppsenasejer", + ?line X2 = get_list(File, Log), + ?line case X2 of + X -> ok; + Z1 -> test_server_fail({bad_terms, Z1, X2}) + end, + ?line ok = disk_log:blog(Log, T4), + ?line Tmp = get_list(File, Log), + ?line case X ++ By of + Tmp -> ok; + Z2 -> test_server_fail({bad_terms, Z2, X ++ By}) + end. + +x2simple_log(File, Log) -> + T1 = "hej", + T2 = list_to_binary("hopp"), + T3 = list_to_binary(["sena", list_to_binary("sejer")]), + T4 = list_to_binary(By = mk_bytes(1000)), + ?line ok = disk_log:blog(Log, T1), + ?line ok = disk_log:blog_terms(Log, [T2, T3]), + ?line X = "hejhoppsenasejer", + ?line X2 = get_list(File, Log), + ?line case X2 of + X -> ok; + Z1 -> test_server_fail({bad_terms, Z1, X2}) + end, + ?line ok = disk_log:blog(Log, T4), + ?line Tmp = get_list(File, Log), + ?line case X ++ By of + Tmp -> ok; + Z2 -> test_server_fail({bad_terms, Z2, X ++ By}) + end. + +x_mk_bytes(N) -> + X = lists:duplicate(N, $a), + {list_to_binary(X), X}. + +mk_bytes(N) when N > 4 -> + X = lists:duplicate(N-4, $a), + case byte_size(term_to_binary(X)) of + N -> X; + Z -> test_server_fail({bad_terms, Z, N}) + end. + +get_list(File, Log) -> + ?t:format(0, "File ~p~n",[File]), + ok = disk_log:sync(Log), + {ok, B} = file:read_file(File), + binary_to_list(B). + + +get_all_terms(Log, File, Type) -> + {ok, _Log} = disk_log:open([{name,Log}, {type,Type}, {size,infinity}, + {format,internal}, {file, File}, + {mode, read_only}]), + Ts = get_all_terms(Log), + ok = disk_log:close(Log), + Ts. + +get_all_terms(Log) -> + get_all_terms1(Log, start, []). + +get_all_terms1(Log, Cont, Res) -> + case disk_log:chunk(Log, Cont) of + {error, _R} -> + test_server_fail({bad_chunk, Log, Cont}); + {Cont2, Terms} -> + get_all_terms1(Log, Cont2, Res ++ Terms); + eof -> + Res + end. + +get_all_terms_and_bad(Log, File, Type) -> + {ok, _Log} = disk_log:open([{name,Log}, {type,Type}, {size,infinity}, + {format,internal}, {file, File}, + {mode, read_only}]), + Ts = get_all_terms_and_bad(Log), + ok = disk_log:close(Log), + Ts. + +get_all_terms_and_bad(Log) -> + ?line read_only = info(Log, mode, foo), + get_all_terms_and_bad1(Log, start, [], 0). + +%% +get_all_terms_and_bad1(Log, Cont, Res, Bad0) -> + case disk_log:chunk(Log, Cont) of + {Cont2, Terms} -> + get_all_terms_and_bad1(Log, Cont2, Res ++ Terms, Bad0); + {Cont2, Terms, Bad} -> + get_all_terms_and_bad1(Log, Cont2, Res ++ Terms, Bad0+Bad); + eof -> + {Res, Bad0} + end. + +get_all_binary_terms_and_bad(Log, File, Type) -> + {ok, _Log} = disk_log:open([{name,Log}, {type,Type}, {size,infinity}, + {format,internal}, {file, File}, + {mode, read_only}]), + Ts = get_all_binary_terms_and_bad(Log), + ok = disk_log:close(Log), + Ts. + +get_all_binary_terms_and_bad(Log) -> + read_only = info(Log, mode, foo), + get_all_binary_terms_and_bad1(Log, start, [], 0). + +%% +get_all_binary_terms_and_bad1(Log, Cont, Res, Bad0) -> + case disk_log:bchunk(Log, Cont) of + {Cont2, BinTerms} -> + get_all_binary_terms_and_bad1(Log, Cont2, Res ++ BinTerms, Bad0); + {Cont2, BinTerms, Bad} -> + get_all_binary_terms_and_bad1(Log, Cont2, Res ++ BinTerms, + Bad0+Bad); + eof -> + {Res, Bad0} + end. + +del(File, 0) -> + file:delete(File ++ ".siz"), + file:delete(File ++ ".idx"); +del(File, N) -> + file:delete(File ++ "." ++ integer_to_list(N)), + del(File, N-1). + +test_server_fail(R) -> + exit({?MODULE, get(line), R}). + +xx() -> + File = "a.LOG", + {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,internal}, {file, File}]), + W = xwr(a, 400), + disk_log:close(a), +% file:delete(File), + W. + +%% old: 6150 +%% new: 5910 +xwr(Log, BytesItem) -> + NoW = 1000, + Item1 = mk_bytes(BytesItem), + Item2 = mk_bytes(BytesItem), + Item3 = mk_bytes(BytesItem), + Item4 = mk_bytes(BytesItem), + Item5 = mk_bytes(BytesItem), + Item6 = mk_bytes(BytesItem), + Item7 = mk_bytes(BytesItem), + Item8 = mk_bytes(BytesItem), + Item9 = mk_bytes(BytesItem), + Item0 = mk_bytes(BytesItem), + Term = [Item1,Item2,Item3,Item4,Item5,Item6,Item7,Item8,Item9,Item0], + {W, _} = timer:tc(?MODULE, wr, [Log, Term, NoW]), + W/NoW. + +measure() -> + proc_lib:start_link(?MODULE, init_m, [self()]). + +init_m(Par) -> + process_flag(trap_exit, true), + Res = m(), + proc_lib:init_ack(Par, Res). + +m() -> + {W10, R10, Rep10, C10} = m_halt_int(10), + {W11, R11, Rep11, C11} = m_halt_int(100), + {W12, R12, Rep12, C12} = m_halt_int(400), + {W13, R13, Rep13, C13} = m_halt_int(1000), + {W14, R14, Rep14, C14} = m_halt_int(10000), + {W2, R2, Rep2, C2} = m_wrap_int(400), + {W3, R3, Rep3, C3} = m_many_halt_int(10, 400), + {W4, R4, Rep4, C4} = m_many_halt_int(20, 400), + {W5, R5, Rep5, C5} = m_many_halt_int(10, 1000), + {W6, R6, Rep6, C6} = m_many_halt_int(10, 10), + {W7, R7, Rep7, C7} = m_many_halt_int(20, 10), + + io:format("Type of log mysec/write mysec/read" + " mysec/repair byte cpu/write\n"), + io:format("=========== =========== ==========" + " ================= =========\n"), + one_line("halt,int.inf. (10)", W10, R10, Rep10, C10), + one_line("halt,int.inf. (100)", W11, R11, Rep11, C11), + one_line("halt,int.inf. (400)", W12, R12, Rep12, C12), + one_line("halt,int.inf. (1000)", W13, R13, Rep13, C13), + one_line("halt,int.inf. (10000)", W14, R14, Rep14, C14), + one_line("wrap,int. 4. (400)", W2, R2, Rep2, C2), + one_line("halt,int.inf. (10,10)", W6, R6, Rep6, C6), + one_line("halt,int.inf. (20,10)", W7, R7, Rep7, C7), + one_line("halt,int.inf. (10,400)", W3, R3, Rep3, C3), + one_line("halt,int.inf. (20,400)", W4, R4, Rep4, C4), + one_line("halt,int.inf. (10,1000)", W5, R5, Rep5, C5), + io:format("\n"), + io:format("\tWrap log time depends on how often the log wraps, as this\n"), + io:format("\tinvolves opening of new files, which costs alot."), + io:format("\n"). + +one_line(Txt, W, R, Rep, C) -> + io:format("~.22s ~.10w ~.10w ~.17w ~.9w\n", [Txt, W, R, Rep, C]). + +m_halt_int(BytesItem) -> + File = "a.LOG", + {ok, a} = disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,internal}, {file, File}]), + {T,W} = wr(a, BytesItem), + R = r(a), + [{_,P}] = ets:lookup(?DISK_LOG_NAME_TABLE, a), + exit(P, kill), + receive after 100 -> ok end, + crash(File, 10), + Sz = file_size(File), + Start = start_times(), + {repaired, a, {recovered, Rec}, {badbytes, Bad}} = + disk_log:open([{name,a}, {type,halt}, {size,infinity}, + {format,internal}, {file, File}]), + {_,Rep} = end_times(Start), + io:format("m_halt_int: Rep = ~p, Rec = ~p, Bad = ~p~n", [Rep, Rec, Bad]), + disk_log:close(a), + file:delete(File), + {W,R,1000*Rep/Sz,T}. + +m_wrap_int(BytesItem) -> + File = "a.LOG", + {ok, a} = disk_log:open([{name,a}, {type,wrap}, {size,{405*1000, 4}}, + {format,internal}, {file, File}]), + {T,W} = wr(a, BytesItem), + R = r(a), + [{_,P}] = ets:lookup(?DISK_LOG_NAME_TABLE, a), + exit(P, kill), + receive after 100 -> ok end, + del(File, 4), + {W,R,'n/a',T}. + +m_many_halt_int(NoClients, BytesItem) -> + Name = 'log.LOG', + File = "log.LOG", + {ok, _} = disk_log:open([{name,Name}, {type,halt}, + {size,infinity}, + {format,internal}, {file,File}]), + NoW = round(lists:max([lists:min([5000000/BytesItem/NoClients, + 50000/NoClients]), + 1000])), + {T,W} = many_wr(NoClients, Name, NoW, BytesItem), + ok = disk_log:close(Name), + file:delete(File), + {1000*W/NoW/NoClients,'n/a','n/a',1000*T/NoW/NoClients}. + +many_wr(NoClients, Log, NoW, BytesItem) -> + Item = mk_bytes(BytesItem), + Fun = fun(Name, _Pid, _I) -> disk_log:log(Name, Item) end, + Start = start_times(), + Pids = spawn_clients(NoClients, client, [self(), Log, NoW, Fun]), + check_clients(Pids), + end_times(Start). + +wr(Log, BytesItem) -> + NoW = round(lists:max([lists:min([5000000/BytesItem,50000]),1000])), + Item = mk_bytes(BytesItem), + Start = start_times(), + wr(Log, Item, NoW), + {T,W} = end_times(Start), + {1000*T/NoW, 1000*W/NoW}. + +wr(Log, _Item, 0) -> + disk_log:sync(Log), + ok; +wr(Log, Item, N) -> + ok = disk_log:log(Log, Item), + wr(Log, Item, N-1). + +r(_) -> + nyi. + +start_times() -> + {T1, _} = statistics(runtime), + {W1, _} = statistics(wall_clock), + {T1, W1}. + +end_times({T1,W1}) -> + {T2, _} = statistics(runtime), + {W2, _} = statistics(wall_clock), + {T2-T1, W2-W1}. + +head(suite) -> [head_func, plain_head, one_header]. + +head_func(suite) -> []; +head_func(doc) -> ["Test head parameter"]; +head_func(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ets:new(xxx, [named_table, set, public]), + ets:insert(xxx, {wrapc, 0}), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, + {size, {100,4}}, + {head_func, {?MODULE, hf, []}}]), + ?line B = mk_bytes(60), + ?line disk_log:log(a, B), + ?line disk_log:alog(a, B), + ?line disk_log:alog(a, B), + ?line disk_log:log(a, B), + H = [1,2,3], + ?line [{wrapc, 4}] = ets:lookup(xxx, wrapc), + ets:delete(xxx), + ?line case get_all_terms(a) of + [H,B,H,B,H,B,H,B] -> + ok; + E1 -> + test_server_fail({bad_terms, E1, + [H,B,H,B,H,B,H,B]}) + end, + ?line 8 = no_written_items(a), + disk_log:close(a), + del(File, 4), + + % invalid header function + ?line {error, {invalid_header, {_, {term}}}} = + disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, external}, + {head_func, {?MODULE, head_fun, [{term}]}}]), + file:delete(File), + + ?line {error, {invalid_header, _}} = + disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, external}, + {head_func, {?MODULE, head_fun, [{ok,{term}}]}}]), + file:delete(File), + + ?line {ok,n} = + disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, external}, + {head_func, {?MODULE, head_fun, [{ok,<<"head">>}]}}]), + ?line ok = disk_log:close(n), + ?line {ok,<<"head">>} = file:read_file(File), + file:delete(File), + + ?line {ok,n} = + disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, external}, + {head_func, {?MODULE, head_fun, [{ok,"head"}]}}]), + ?line ok = disk_log:close(n), + ?line {ok,<<"head">>} = file:read_file(File), + file:delete(File), + + ?line Error1 = {error, {badarg, _}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {head_func, {tjo,hej,san}},{size, {100, 4}}]), + ?line "The argument " ++ _ = format_error(Error1), + + ?line Error2 = {error, {invalid_header, _}} = + disk_log:open([{name, n}, {file, File}, {type, halt}, + {head_func, {tjo,hej,[san]}}]), + ?line "The disk log header" ++ _ = format_error(Error2), + file:delete(File). + + +head_fun(H) -> + H. + +hf() -> + ets:update_counter(xxx, wrapc, 1), + {ok, [1,2,3]}. + +plain_head(suite) -> []; +plain_head(doc) -> ["Test head parameter"]; +plain_head(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + H = [1,2,3], + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, + {size, {100,4}}, {head, H}]), + %% This one is not "counted". + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, + {size, {100,4}}, {head, H}]), + ?line B = mk_bytes(60), + ?line disk_log:log(a, B), + ?line disk_log:alog(a, B), + ?line disk_log:alog(a, B), + ?line disk_log:log(a, B), + ?line case get_all_terms(a) of + [H,B,H,B,H,B,H,B] -> + ok; + E1 -> + test_server_fail({bad_terms, E1, + [H,B,H,B,H,B,H,B]}) + end, + ?line 8 = no_written_items(a), + ?line ok = disk_log:close(a), + ?line {error, no_such_log} = disk_log:close(a), + del(File, 4). + + + +one_header(suite) -> []; +one_header(doc) -> ["Test that a header is just printed once in a log file"]; +one_header(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + H = [1,2,3], + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, + {size, {100,4}}, {head, H}]), + ?line B = mk_bytes(60), + ?line ok = disk_log:log(a, B), + ?line ok = disk_log:alog(a, B), + ?line ok = disk_log:alog(a, B), + ?line ok = disk_log:log(a, B), + ?line case get_all_terms(a) of + [H,B,H,B,H,B,H,B] -> + ok; + E1 -> + test_server_fail({bad_terms, E1, + [H,B,H,B,H,B,H,B]}) + end, + ?line 8 = no_written_items(a), + ?line ok = disk_log:close(a), + del(File, 4), + + Fileb = filename:join(Dir, "b.LOG"), + ?line {ok, b} = disk_log:open([{name,b}, {file, Fileb}, {head, H}]), + ?line ok = disk_log:close(b), + ?line {ok, b} = disk_log:open([{name,b}, {file, Fileb}, {head, H}]), + ?line ok = disk_log:log(b, "first log"), + ?line ok = disk_log:alog(b, "second log"), + ?line ok = disk_log:close(b), + ?line {ok, b} = disk_log:open([{name,b}, {file, Fileb}, {head, H}]), + ?line ok = disk_log:alog(b, "3rd log"), + ?line ok = disk_log:log(b, "4th log"), + ?line case get_all_terms(b) of + [H, "first log", "second log", "3rd log", "4th log"] -> + ok; + E2 -> + test_server_fail({bad_terms, E2, + [H, "first log", "second log", + "3rd log", "4th log"]}) + end, + ?line 2 = no_written_items(b), + ?line ok = disk_log:close(b), + ?line ok = file:delete(Fileb), + + Filec = filename:join(Dir, "c.LOG"), + H2 = "this is a header ", + ?line {ok, c} = disk_log:open([{name,c}, {format, external}, + {file, Filec}, {head, H2}]), + ?line ok = disk_log:close(c), + ?line {ok, c} = disk_log:open([{name,c}, {format, external}, + {file, Filec}, {head, H2}]), + ?line ok = disk_log:blog(c, "first log"), + ?line ok = disk_log:balog(c, "second log"), + ?line ok = disk_log:close(c), + ?line {ok, c} = disk_log:open([{name,c}, {format, external}, + {file, Filec}, {head, H2}]), + ?line ok = disk_log:balog(c, "3rd log"), + ?line ok = disk_log:blog(c, "4th log"), + ?line ok = disk_log:sync(c), + ?line {ok, Fdc} = file:open(Filec, [read]), + ?line {ok,"this is a header first logsecond log3rd log4th log"} = + file:read(Fdc, 200), + ?line ok = file:close(Fdc), + ?line 2 = no_written_items(c), + ?line disk_log:close(c), + ?line ok = file:delete(Filec), + ok. + + +notif(suite) -> [wrap_notif, full_notif, trunc_notif, + blocked_notif]. + +wrap_notif(suite) -> []; +wrap_notif(doc) -> ["Test notify parameter, wrap"]; +wrap_notif(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, + {size, {100,4}}, {notify, true}]), + ?line B = mk_bytes(60), + ?line disk_log:log(a, B), + ?line disk_log:alog(a, B), + ?line disk_log:alog(a, B), + ?line disk_log:log(a, B), + ?line disk_log:log(a, B), + ?line rec(3, {disk_log, node(), a, {wrap, 0}}), + ?line rec(1, {disk_log, node(), a, {wrap, 1}}), + disk_log:close(a), + del(File, 4). + +full_notif(suite) -> []; +full_notif(doc) -> ["Test notify parameter, wrap, filled file"]; +full_notif(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + file:delete(File), + + ?line {ok, a} = disk_log:open([{name, a}, {file, File}, {type, halt}, + {size, 100}, {notify, true}]), + ?line B = mk_bytes(60), + ?line disk_log:log(a, B), + ?line disk_log:alog(a, B), + ?line rec(1, {disk_log, node(), a, full}), + disk_log:close(a), + file:delete(File). + +trunc_notif(suite) -> []; +trunc_notif(doc) -> ["Test notify parameter, wrap, truncated file"]; +trunc_notif(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + File2 = filename:join(Dir, "a.DUMP"), + ?line {ok, a} = disk_log:open([{name, a}, {file, File}, {type, halt}, + {size, 100}, {notify, true}]), + ?line B = mk_bytes(60), + ?line disk_log:log(a, B), + ?line disk_log:truncate(a), + ?line rec(1, {disk_log, node(), a, {truncated, 1}}), + ?line disk_log:log(a, B), + ?line ok = disk_log:reopen(a, File2), + ?line rec(1, {disk_log, node(), a, {truncated, 1}}), + disk_log:close(a), + file:delete(File), + file:delete(File2). + +blocked_notif(suite) -> []; +blocked_notif(doc) -> + ["Test notify parameters 'format_external' and 'blocked_log"]; +blocked_notif(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "n.LOG"), + No = 4, + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}, {notify, true}, + {format, external}]), + ?line B = mk_bytes(60), + ?line Error1 = {error,{format_external,n}} = disk_log:log(n, B), + ?line "The requested operation" ++ _ = format_error(Error1), + ?line ok = disk_log:blog(n, B), + ?line ok = disk_log:alog(n, B), + ?line rec(1, {disk_log, node(), n, {format_external, term_to_binary(B)}}), + ?line ok = disk_log:alog_terms(n, [B,B,B,B]), + ?line rec(1, {disk_log, node(), n, {format_external, + lists:map(fun term_to_binary/1, [B,B,B,B])}}), + ?line ok = disk_log:block(n, false), + ?line ok = disk_log:alog(n, B), + ?line rec(1, {disk_log, node(), n, {blocked_log, term_to_binary(B)}}), + ?line ok = disk_log:balog(n, B), + ?line rec(1, {disk_log, node(), n, {blocked_log, list_to_binary(B)}}), + ?line ok = disk_log:balog_terms(n, [B,B,B,B]), + ?line disk_log:close(n), + ?line rec(1, {disk_log, node(), n, {blocked_log, + lists:map(fun list_to_binary/1, [B,B,B,B])}}), + ?line del(File, No). + + +new_idx_vsn(suite) -> []; +new_idx_vsn(doc) -> ["Test the new version of the .idx file"]; +new_idx_vsn(Conf) when is_list(Conf) -> + DataDir = ?datadir(Conf), + PrivDir = ?privdir(Conf), + File = filename:join(PrivDir, "new_vsn.LOG"), + Kurt = filename:join(PrivDir, "kurt.LOG"), + Kurt2 = filename:join(PrivDir, "kurt2.LOG"), + + %% Test that a wrap log file can have more than 255 files + ?line {ok, new_vsn} = disk_log:open([{file, File}, {name, new_vsn}, + {type, wrap}, {size, {40, 270}}]), + ?line ok = log(new_vsn, 280), + ?line {ok, Bin} = file:read_file(add_ext(File, "idx")), + ?line <<0,0:32,2,10:32,1:64,1:64,_/binary>> = Bin, + ?line disk_log:close(new_vsn), + ?line del(File, 270), + + %% convert a very old version (0) of wrap log file to the new format (2) + copy_wrap_log("kurt.LOG", 4, DataDir, PrivDir), + + ?line {repaired, kurt, {recovered, 1}, {badbytes, 0}} = + disk_log:open([{file, Kurt}, {name, kurt}, + {type, wrap}, {size, {40, 4}}]), + ?line ok = disk_log:log(kurt, "this is a logged message number X"), + ?line ok = disk_log:log(kurt, "this is a logged message number Y"), + ?line {ok, BinK} = file:read_file(add_ext(Kurt, "idx")), + ?line <<0,0:32,2,2:32,1:64,1:64,1:64,1:64>> = BinK, + ?line {{40,4}, 2} = disk_log_1:read_size_file_version(Kurt), + disk_log:close(kurt), + ?line del(Kurt, 4), + + %% keep the old format (1) + copy_wrap_log("kurt2.LOG", 4, DataDir, PrivDir), + + ?line {repaired, kurt2, {recovered, 1}, {badbytes, 0}} = + disk_log:open([{file, Kurt2}, {name, kurt2}, + {type, wrap}, {size, {40, 4}}]), + ?line ok = disk_log:log(kurt2, "this is a logged message number X"), + ?line ok = disk_log:log(kurt2, "this is a logged message number Y"), + ?line {ok, BinK2} = file:read_file(add_ext(Kurt2, "idx")), + ?line <<0,2:32,1:32,1:32,1:32,1:32>> = BinK2, + ?line {{40,4}, 1} = disk_log_1:read_size_file_version(Kurt2), + disk_log:close(kurt2), + ?line del(Kurt2, 4), + + ok. + +reopen(suite) -> []; +reopen(doc) -> + ["Test reopen/1 on halt and wrap logs."]; +reopen(Conf) when is_list(Conf) -> + + Dir = ?privdir(Conf), + ?line File = filename:join(Dir, "n.LOG"), + ?line NewFile = filename:join(Dir, "nn.LOG"), + ?line B = mk_bytes(60), + + ?line file:delete(File), % cleanup + ?line file:delete(NewFile), % cleanup + ?line Q = qlen(), + + %% External halt log. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {notify, true}, {head, "header"}, + {size, infinity},{format, external}]), + ?line ok = disk_log:blog(n, B), + ?line ok = disk_log:breopen(n, NewFile, "head"), + ?line rec(1, {disk_log, node(), n, {truncated, 2}}), + ?line ok = disk_log:blog(n, B), + ?line ok = disk_log:blog(n, B), + ?line ok = disk_log:breopen(n, NewFile, "head"), + ?line rec(1, {disk_log, node(), n, {truncated, 3}}), + ?line ok = disk_log:close(n), + ?line {ok,BinaryFile} = file:read_file(File), + ?line "head" = binary_to_list(BinaryFile), + ?line file:delete(File), + ?line file:delete(NewFile), + + %% Internal halt log. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {notify, true}, {head, header}, + {size, infinity}]), + ?line ok = disk_log:log(n, B), + ?line Error1 = {error, {same_file_name, n}} = disk_log:reopen(n, File), + ?line "Current and new" ++ _ = format_error(Error1), + ?line ok = disk_log:reopen(n, NewFile), + ?line rec(1, {disk_log, node(), n, {truncated, 2}}), + ?line ok = disk_log:log(n, B), + ?line ok = disk_log:log(n, B), + ?line ok = disk_log:reopen(n, NewFile), + ?line rec(1, {disk_log, node(), n, {truncated, 3}}), + ?line ok = disk_log:close(n), + ?line [header, _B, _B] = get_all_terms(nn, NewFile, halt), + ?line file:delete(File), + ?line file:delete(NewFile), + + %% Internal wrap log. + ?line No = 4, + ?line del(File, No), % cleanup + ?line del(NewFile, No), % cleanup + + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {notify, true}, + {head, header}, {size, {100, No}}]), + ?line ok = disk_log:log(n, B), + ?line ok = disk_log:log_terms(n, [B,B,B]), + %% Used to be one message, but now one per wrapped file. + ?line rec(3, {disk_log, node(), n, {wrap, 0}}), + ?line ok = disk_log:log_terms(n, [B]), + ?line rec(1, {disk_log, node(), n, {wrap, 2}}), + ?line ok = disk_log:log_terms(n, [B]), + ?line rec(1, {disk_log, node(), n, {wrap, 2}}), + ?line ok = disk_log:reopen(n, NewFile, new_header), + ?line rec(1, {disk_log, node(), n, {truncated, 8}}), + ?line ok = disk_log:log_terms(n, [B,B]), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line ok = disk_log:log_terms(n, [B]), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line ok = disk_log:close(n), + ?line [header, _, header, _, header, _, header, _] = + get_all_terms(nn, NewFile, wrap), + ?line [new_header, _, header, _, header, _] = get_all_terms(n, File, wrap), + + ?line del(NewFile, No), + ?line file:delete(File ++ ".2"), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {notify, true}, + {head, header}, {size, {100, No}}]), + %% One file is missing... + ?line ok = disk_log:reopen(n, NewFile), + ?line rec(1, {disk_log, node(), n, {truncated, 6}}), + ?line ok = disk_log:close(n), + + ?line del(File, No), + ?line del(NewFile, No), + ?line Q = qlen(), + ok. + +block(suite) -> [block_blocked, block_queue, block_queue2]. + +block_blocked(suite) -> []; +block_blocked(doc) -> + ["Test block/1 on external and internal logs."]; +block_blocked(Conf) when is_list(Conf) -> + + Dir = ?privdir(Conf), + ?line B = mk_bytes(60), + Halt = join(Dir, "halt.LOG"), + + % External logs. + ?line file:delete(Halt), % cleanup + ?line {ok, halt} = disk_log:open([{name, halt}, {type, halt}, + {format, external}, {file, Halt}]), + ?line ok = disk_log:sync(halt), + ?line ok = disk_log:block(halt, false), + ?line Error1 = {error, {blocked_log, halt}} = disk_log:block(halt), + ?line "The blocked disk" ++ _ = format_error(Error1), + ?line {error, {blocked_log, halt}} = disk_log:sync(halt), + ?line {error, {blocked_log, halt}} = disk_log:truncate(halt), + ?line {error, {blocked_log, halt}} = disk_log:change_size(halt, inifinity), + ?line {error, {blocked_log, halt}} = + disk_log:change_notify(halt, self(), false), + ?line {error, {blocked_log, halt}} = + disk_log:change_header(halt, {head, header}), + ?line {error, {blocked_log, halt}} = disk_log:reopen(halt, "foo"), + ?line ok = disk_log:close(halt), + + ?line {ok, halt} = disk_log:open([{name, halt}, {type, halt}, + {format, external}]), + ?line ok = disk_log:sync(halt), + ?line ok = disk_log:block(halt, true), + ?line {error, {blocked_log, halt}} = disk_log:blog(halt, B), + ?line {error, {blocked_log, halt}} = disk_log:blog(halt, B), + ?line {error, {blocked_log, halt}} = disk_log:block(halt), + ?line {error, {blocked_log, halt}} = disk_log:sync(halt), + ?line {error, {blocked_log, halt}} = disk_log:truncate(halt), + ?line {error, {blocked_log, halt}} = disk_log:change_size(halt, infinity), + ?line {error, {blocked_log, halt}} = + disk_log:change_notify(halt, self(), false), + ?line {error, {blocked_log, halt}} = + disk_log:change_header(halt, {head, header}), + ?line {error, {blocked_log, halt}} = disk_log:reopen(halt, "foo"), + + ?line ok = disk_log:unblock(halt), + ?line ok = disk_log:close(halt), + ?line file:delete(Halt), + + % Internal logs. + ?line File = filename:join(Dir, "n.LOG"), + ?line No = 4, + ?line del(File, No), % cleanup + ?line {ok, halt} = disk_log:open([{name, halt}, {file, File}, {type, wrap}, + {size, {100, No}}]), + ?line ok = disk_log:block(halt, true), + ?line eof = disk_log:chunk(halt, start), + ?line Error2 = {error, end_of_log} = disk_log:chunk_step(halt, start, 1), + ?line "An attempt" ++ _ = format_error(Error2), + ?line {error, {blocked_log, halt}} = disk_log:log(halt, B), + ?line {error, {blocked_log, halt}} = disk_log:inc_wrap_file(halt), + ?line ok = disk_log:unblock(halt), + ?line ok = disk_log:block(halt, false), + ?line {error, {blocked_log, halt}} = disk_log:log(halt, B), + ?line {error, {blocked_log, halt}} = disk_log:inc_wrap_file(halt), + ?line Parent = self(), + ?line Pid = + spawn_link(fun() -> + {error, {blocked_log, halt}} = + disk_log:chunk(halt, start), + {error, {blocked_log, halt}} = + disk_log:chunk_step(halt, start, 1), + Parent ! {self(), stopped} + end), + ?line receive {Pid,stopped} -> ok end, + ?line ok = disk_log:close(halt), + ?line del(File, No). + +block_queue(suite) -> []; +block_queue(doc) -> + ["Run commands from the queue by unblocking."]; +block_queue(Conf) when is_list(Conf) -> + + Dir = ?privdir(Conf), + ?line Q = qlen(), + ?line File = filename:join(Dir, "n.LOG"), + ?line No = 4, + ?line del(File, No), % cleanup + ?line B = mk_bytes(60), + + ?line Pid = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = sync_do(Pid, {open, File}), + + ?line ok = disk_log:block(n, true), + ?line async_do(Pid, {blog, B}), + ?line ok = disk_log:unblock(n), + ?line ok = get_reply(), + ?line 1 = no_written_items(n), + ?line Error1 = {error,{not_blocked,n}} = disk_log:unblock(n), + ?line "The disk log" ++ _ = format_error(Error1), + + ?line ok = disk_log:block(n, true), + ?line async_do(Pid, {balog, "one string"}), + ?line ok = disk_log:unblock(n), + ?line ok = get_reply(), + ?line 2 = no_written_items(n), + + ?line ok = disk_log:block(n, true), + ?line async_do(Pid, sync), + ?line ok = disk_log:unblock(n), + ?line ok = get_reply(), + + ?line ok = disk_log:block(n, true), + ?line async_do(Pid, truncate), + ?line ok = disk_log:unblock(n), + ?line ok = get_reply(), + ?line 0 = no_items(n), + + ?line ok = disk_log:block(n, true), + ?line async_do(Pid, {block, false}), + ?line ok = disk_log:unblock(n), + ?line ok = get_reply(), + ?line {error, {blocked_log, _}} = disk_log:blog(n, B), + ?line ok = sync_do(Pid, unblock), + + ?line ok = disk_log:block(n, true), + ?line async_do(Pid, {change_notify, Pid, true}), + ?line ok = disk_log:unblock(n), + ?line ok = get_reply(), + ?line [{_, true}] = owners(n), + + ?line ok = disk_log:block(n, true), + ?line async_do(Pid, {change_notify, Pid, false}), + ?line ok = disk_log:unblock(n), + ?line ok = get_reply(), + ?line [{_, false}] = owners(n), + + ?line ok = disk_log:block(n, true), + ?line async_do(Pid, {change_header, {head, header}}), + ?line ok = disk_log:unblock(n), + ?line {error, {badarg, head}} = get_reply(), + + ?line ok = disk_log:block(n, true), + ?line async_do(Pid, {change_size, 17}), + ?line ok = disk_log:unblock(n), + ?line {error, {badarg, size}} = get_reply(), + + ?line ok = disk_log:block(n, true), + ?line async_do(Pid, inc_wrap_file), + ?line ok = disk_log:unblock(n), + ?line ok = get_reply(), + + ?line ok = sync_do(Pid, close), + ?line del(File, No), + + ?line _Pid2 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = sync_do(Pid, {int_open, File}), + + ?line ok = disk_log:block(n, true), + ?line async_do(Pid, {chunk, start}), + ?line ok = disk_log:unblock(n), + ?line eof = get_reply(), + + ?line ok = disk_log:block(n, true), + ?line async_do(Pid, {chunk_step, start, 100}), + ?line ok = disk_log:unblock(n), + ?line {ok, _Cont} = get_reply(), + + ?line ok = disk_log:block(n, true), + ?line async_do(Pid, {log,a_term}), + ?line ok = disk_log:unblock(n), + ?line ok = get_reply(), + ?line 1 = no_written_items(n), + + ?line ok = sync_do(Pid, close), + ?line sync_do(Pid, terminate), + ?line del(File, No), + + %% Test of the queue. Three processes involved here. Pid1's block + %% request is queued. Pid2's log requests are put in the queue. + %% When unblock is executed, Pid1's block request is granted. + %% Pid2's log requests are executed when Pid1 unblocks. + %% (This example should show that the pair 'queue' and 'messages' + %% in State does the trick - one does not need a "real" queue.) + ?line P0 = pps(), + Name = n, + ?line Pid1 = spawn_link(?MODULE, lserv, [Name]), + ?line {ok, Name} = sync_do(Pid1, {int_open, File, {1000,2}}), + ?line Pid2 = spawn_link(?MODULE, lserv, [Name]), + ?line {ok, Name} = sync_do(Pid2, {int_open, File, {1000,2}}), + ?line ok = disk_log:block(Name), + ?line async_do(Pid1, {alog,{1,a}}), + ?line ok = get_reply(), + ?line async_do(Pid1, {alog,{2,b}}), + ?line ok = get_reply(), + ?line async_do(Pid1, {alog,{3,c}}), + ?line ok = get_reply(), + ?line async_do(Pid1, {alog,{4,d}}), + ?line ok = get_reply(), + ?line async_do(Pid1, block), + ?line async_do(Pid2, {alog,{5,e}}), + ?line ok = get_reply(), + ?line async_do(Pid2, {alog,{6,f}}), + ?line ok = get_reply(), + ?line ok = disk_log:unblock(Name), + ?line ok = get_reply(), + ?line async_do(Pid2, {alog,{7,g}}), + ?line ok = get_reply(), + ?line async_do(Pid2, {alog,{8,h}}), + ?line ok = get_reply(), + ?line async_do(Pid1, unblock), + ?line ok = get_reply(), + ?line ok = sync_do(Pid1, close), + ?line ok = sync_do(Pid2, close), + ?line sync_do(Pid1, terminate), + ?line sync_do(Pid2, terminate), + Terms = get_all_terms(Name, File, wrap), + ?line true = [{1,a},{2,b},{3,c},{4,d},{5,e},{6,f},{7,g},{8,h}] == Terms, + del(File, 2), + ?line Q = qlen(), + ?line true = (P0 == pps()), + ok. + +block_queue2(suite) -> []; +block_queue2(doc) -> + ["OTP-4880. Blocked processes did not get disk_log_stopped message."]; +block_queue2(Conf) when is_list(Conf) -> + ?line Q = qlen(), + ?line P0 = pps(), + Dir = ?privdir(Conf), + ?line File = filename:join(Dir, "n.LOG"), + ?line No = 4, + + %% log requests are queued, and processed when the log is closed + ?line Pid = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = sync_do(Pid, {open, File}), + ?line ok = sync_do(Pid, block), + %% Asynchronous stuff is ignored. + ?line ok = disk_log:balog_terms(n, [<<"foo">>,<<"bar">>]), + ?line ok = disk_log:balog_terms(n, [<<"more">>,<<"terms">>]), + ?line Fun = + fun() -> {error,disk_log_stopped} = disk_log:sync(n) + end, + ?line spawn(Fun), + ?line ok = sync_do(Pid, close), + ?line sync_do(Pid, terminate), + ?line {ok,<<>>} = file:read_file(File ++ ".1"), + ?line del(File, No), + ?line Q = qlen(), + ?line true = (P0 == pps()), + ok. + + +unblock(suite) -> []; +unblock(doc) -> + ["Test unblock/1."]; +unblock(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "n.LOG"), + No = 1, + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}, {notify, true}, + {format, external}]), + ?line ok = disk_log:block(n), + ?line spawn_link(?MODULE, try_unblock, [n]), + ?line timer:sleep(100), + ?line disk_log:close(n), + ?line del(File, No). + +try_unblock(Log) -> + ?line Error = {error, {not_blocked_by_pid, n}} = disk_log:unblock(Log), + ?line "The disk log" ++ _ = format_error(Error). + +open(suite) -> [open_overwrite, open_size, + open_truncate, open_error]. + +open_overwrite(suite) -> []; +open_overwrite(doc) -> + ["Test open/1 when old files exist."]; +open_overwrite(Conf) when is_list(Conf) -> + + Dir = ?privdir(Conf), + ?line File = filename:join(Dir, "n.LOG"), + ?line No = 4, + ?line del(File, No), % cleanup + + % read write + ?line First = "n.LOG.1", + ?line make_file(Dir, First, 8), + + ?line Error1 = {error, {not_a_log_file, _}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {100, No}}]), + ?line "The file" ++ _ = format_error(Error1), + ?line del(File, No), + + ?line make_file(Dir, First, 4), + + ?line {error, {not_a_log_file, _}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {100, No}}]), + ?line del(File, No), + + ?line make_file(Dir, First, 0), + + ?line {error, {not_a_log_file, _}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {100, No}}]), + % read only + ?line make_file(Dir, First, 6), + + ?line {error, {not_a_log_file, _}} = + disk_log:open([{name, n}, {file, File}, {type, wrap},{mode, read_only}, + {format, internal}, {size, {100, No}}]), + ?line del(File, No), + + ?line make_file(Dir, First, 0), + + ?line {error, {not_a_log_file, _}} = + disk_log:open([{name, n}, {file, File},{type, wrap}, + {mode, read_only}, {format, internal}, + {size, {100, No}}]), + ?line del(File, No), + + ?line {error, _} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {mode, read_only}, + {format, internal},{size, {100, No}}]), + + file:delete(File), + ?line {ok,n} = disk_log:open([{name,n},{file,File}, + {mode,read_write},{type,halt}]), + ?line ok = disk_log:close(n), + ?line ok = unwritable(File), + ?line {error, {file_error, File, _}} = + disk_log:open([{name,n},{file,File},{mode,read_write},{type,halt}]), + ?line ok = writable(File), + file:delete(File), + + ?line {ok,n} = disk_log:open([{name,n},{file,File},{format,external}, + {mode,read_write},{type,halt}]), + ?line ok = disk_log:close(n), + ?line ok = unwritable(File), + ?line {error, {file_error, File, _}} = + disk_log:open([{name,n},{file,File},{format,external}, + {mode,read_write},{type,halt}]), + ?line ok = writable(File), + file:delete(File), + + ok. + + +make_file(Dir, File, N) -> + {ok, F} = file:open(filename:join(Dir, File), + [raw, binary, read, write]), + ok = file:truncate(F), + case N of + 0 -> + true; + _Else -> + ok = file:write(F, [lists:seq(1,N)]) + end, + ok = file:close(F). + +open_size(suite) -> []; +open_size(doc) -> + ["Test open/1 option size."]; +open_size(Conf) when is_list(Conf) -> + + ?line Dir = ?privdir(Conf), + ?line File = filename:join(Dir, "n.LOG"), + + ?line No = 4, + ?line file:delete(File), + ?line del(File, No), % cleanup + + %% missing size option + ?line {error, {badarg, size}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}]), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal},{size, {100, No}}]), + ?line B = mk_bytes(60), + ?line ok = disk_log:log_terms(n, [B, B, B, B]), + ?line ok = disk_log:sync(n), + ?line ok = disk_log:block(n), + + %% size option does not match existing size file, read_only + ?line Error1 = {error, {size_mismatch, _, _}} = + disk_log:open([{name, nn}, {file, File}, {type, wrap}, + {mode, read_only}, {format, internal}, + {size, {100, No + 1}}]), + ?line "The given size" ++ _ = format_error(Error1), + ?line {ok, nn} = disk_log:open([{name, nn}, {file, File}, {type, wrap}, + {mode, read_only}, + {format, internal},{size, {100, No}}]), + ?line [_, _, _, _] = get_all_terms1(nn, start, []), + ?line disk_log:close(nn), + + ?line ok = disk_log:unblock(n), + ?line ok = disk_log:close(n), + + %% size option does not match existing size file, read_write + ?line {error, {size_mismatch, _, _}} = + disk_log:open([{name, nn}, {file, File}, {type, wrap}, + {format, internal}, {size, {100, No + 1}}]), + %% size option does not match existing size file, truncating + ?line {ok, nn} = + disk_log:open([{name, nn}, {file, File}, {type, wrap}, + {repair, truncate}, {format, internal}, + {size, {100, No + 1}}]), + ?line ok = disk_log:close(nn), + + ?line del(File, No), + ok. + + +open_truncate(suite) -> []; +open_truncate(doc) -> + ["Test open/1 with {repair, truncate}."]; +open_truncate(Conf) when is_list(Conf) -> + + ?line Dir = ?privdir(Conf), + ?line File = filename:join(Dir, "n.LOG"), + ?line No = 4, + ?line del(File, No), % cleanup + + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal},{size, {100, No}}]), + ?line B = mk_bytes(60), + ?line ok = disk_log:log_terms(n, [B, B, B, B]), + ?line ok = disk_log:close(n), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {repair,truncate}, + {format, internal},{size, {100, No}}]), + ?line ok = disk_log:close(n), + ?line [] = get_all_terms(n, File, wrap), + ?line del(File, No), + ok. + + +open_error(suite) -> []; +open_error(doc) -> + ["Try some invalid open/1 options."]; +open_error(Conf) when is_list(Conf) -> + ?line Dir = ?privdir(Conf), + + ?line File = filename:join(Dir, "n.LOG"), + ?line No = 4, + ?line del(File, No), % cleanup + + ?line {error, {badarg, name}} = disk_log:open([{file, File}]), + ?line {error, {badarg, file}} = disk_log:open([{name,{foo,bar}}]), + ?line {error, {badarg, [{foo,bar}]}} = disk_log:open([{foo,bar}]), + + %% external logs, read_only. + ?line {error, {file_error, _, enoent}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}, + {format, external}, {mode, read_only}]), + ?line Error5 = {error, {file_error, _, enoent}} = + disk_log:open([{name, n}, {file, File}, {type, halt}, + {size, 100}, + {format, external}, {mode, read_only}]), + ?line true = lists:prefix("\"" ++ File, format_error(Error5)), + + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external},{size, {100, No}}]), + %% Already owner, ignored. + ?line {ok, n} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external}, {size, {100, No}}]), + ?line Error2 = {error, {name_already_open, n}} = + disk_log:open([{name, n}, {file, another_file}, {type, wrap}, + {format, external}, {size, {100, No}}]), + ?line "The disk log" ++ _ = format_error(Error2), + ?line Error1 = {error, {arg_mismatch, notify, false, true}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external}, {size, {100, No}}, {notify, true}]), + ?line "The value" ++ _ = format_error(Error1), + ?line Error3 = {error, {open_read_write, n}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {mode, read_only}, + {format, external}, {size, {100, No}}]), + ?line "The disk log" ++ _ = format_error(Error3), + ?line {error, {badarg, size}} = + disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, external}, {size, {100, No}}]), + ?line {error, {arg_mismatch, type, wrap, halt}} = + disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, external}]), + ?line {error, {arg_mismatch, format, external, internal}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {100, No}}]), + ?line {error, {arg_mismatch, repair, true, false}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external}, {repair, false}]), + ?line {error, {size_mismatch, {100,4}, {1000,4}}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external}, {size, {1000, No}}]), + ?line {error, {arg_mismatch, head, none, _}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {head, "header"}, + {format, external}, {size, {100, No}}]), + ?line {error, {badarg, size}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external}, {size, 100}]), + + ?line ok = disk_log:close(n), + + ?line {ok, n} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {mode, read_only}, + {format, external}, {size, {100, No}}]), + ?line Error4 = {error, {open_read_only, n}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {mode, read_write}, + {format, external}, {size, {100, No}}]), + ?line "The disk log" ++ _ = format_error(Error4), + ?line ok = disk_log:close(n), + + ?line del(File, No). + +close(suite) -> [close_race, close_block, close_deadlock]. + +close_race(suite) -> []; +close_race(doc) -> + ["Do something quickly after close/1"]; +close_race(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + ?line File = filename:join(Dir, "n.LOG"), + ?line No = 1, + ?line del(File, No), % cleanup + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}, {notify, true}, + {format, internal}]), + ?line ok = disk_log:close(n), + ?line Error1 = {error, no_such_log} = disk_log:close(n), + ?line "There is no disk" ++ _ = format_error(Error1), + + % Pid1 blocks, Pid2 closes without being suspended. + ?line Pid1 = spawn_link(?MODULE, lserv, [n]), + ?line Pid2 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = sync_do(Pid1, {open, File}), + ?line {ok, n} = sync_do(Pid2, {open, File}), + ?line ok = sync_do(Pid1, block), + ?line [{_, false}, {_, false}] = sync_do(Pid1, owners), + ?line ok = sync_do(Pid2, close), + ?line [{_, false}] = sync_do(Pid1, owners), + ?line ok = sync_do(Pid1, close), + ?line sync_do(Pid1, terminate), + ?line sync_do(Pid2, terminate), + ?line {error, no_such_log} = disk_log:info(n), + + % Pid3 blocks, Pid3 closes. Pid4 should still be ablo to use log. + ?line Pid3 = spawn_link(?MODULE, lserv, [n]), + ?line Pid4 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = sync_do(Pid3, {open, File}), + ?line {ok, n} = sync_do(Pid4, {open, File}), + ?line ok = sync_do(Pid3, block), + ?line ok = sync_do(Pid3, close), + ?line [{_Pid4, false}] = sync_do(Pid4, owners), + ?line sync_do(Pid3, terminate), + ?line sync_do(Pid4, terminate), + ?line {error, no_such_log} = disk_log:info(n), + + % Pid5 blocks, Pid5 terminates. Pid6 should still be ablo to use log. + ?line Pid5 = spawn_link(?MODULE, lserv, [n]), + ?line Pid6 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = sync_do(Pid5, {open, File}), + ?line {ok, n} = sync_do(Pid6, {open, File}), + ?line ok = sync_do(Pid5, block), + ?line sync_do(Pid5, terminate), + ?line [{_Pid6, false}] = sync_do(Pid6, owners), + ?line sync_do(Pid6, terminate), + ?line {error, no_such_log} = disk_log:info(n), + ?line del(File, No), % cleanup + ok. + +close_block(suite) -> []; +close_block(doc) -> + ["Block, unblock, close, terminate."]; +close_block(Conf) when is_list(Conf) -> + + Dir = ?privdir(Conf), + ?line File = filename:join(Dir, "n.LOG"), + No = 1, + del(File, No), % cleanup + + P0 = pps(), + %% One of two owners terminates. + ?line Pid1 = spawn_link(?MODULE, lserv, [n]), + ?line Pid2 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = sync_do(Pid1, {open, File}), + ?line {ok, n} = sync_do(Pid2, {open, File}), + ?line [_, _] = sync_do(Pid1, owners), + ?line [_, _] = sync_do(Pid2, owners), + ?line 0 = sync_do(Pid1, users), + ?line 0 = sync_do(Pid2, users), + ?line sync_do(Pid1, terminate), + ?line [_] = sync_do(Pid2, owners), + ?line 0 = sync_do(Pid2, users), + ?line sync_do(Pid2, terminate), + ?line {error, no_such_log} = disk_log:info(n), + ?line true = (P0 == pps()), + + %% Users terminate (no link...). + ?line Pid3 = spawn_link(?MODULE, lserv, [n]), + ?line Pid4 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = sync_do(Pid3, {open, File, none}), + ?line {ok, n} = sync_do(Pid4, {open, File, none}), + ?line [] = sync_do(Pid3, owners), + ?line [] = sync_do(Pid4, owners), + ?line 2 = sync_do(Pid3, users), + ?line 2 = sync_do(Pid4, users), + ?line sync_do(Pid3, terminate), + ?line [] = sync_do(Pid4, owners), + ?line 2 = sync_do(Pid4, users), + ?line sync_do(Pid4, terminate), + ?line disk_log:close(n), + ?line disk_log:close(n), + ?line {error, no_such_log} = disk_log:info(n), + ?line true = (P0 == pps()), + + % Blocking owner terminates. + ?line Pid5 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {linkto, none},{size, {100,No}}, + {format, external}]), + ?line {ok, n} = sync_do(Pid5, {open, File}), + ?line ok = sync_do(Pid5, block), + ?line {blocked, true} = status(n), + ?line [_] = owners(n), + ?line sync_do(Pid5, terminate), + ?line ok = status(n), + ?line [] = owners(n), + ?line 1 = users(n), + ?line ok = disk_log:close(n), + ?line {error, no_such_log} = disk_log:info(n), + ?line true = (P0 == pps()), + + % Blocking user terminates. + ?line Pid6 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}, {format, external}]), + ?line {ok, n} = sync_do(Pid6, {open, File, none}), + ?line ok = sync_do(Pid6, block), + ?line {blocked, true} = status(n), + ?line [_] = owners(n), + ?line 1 = users(n), + ?line sync_do(Pid6, terminate), % very silently... + ?line ok = status(n), + ?line [_] = owners(n), + ?line 1 = users(n), + ?line ok = disk_log:close(n), + ?line [] = owners(n), + ?line 1 = users(n), + ?line ok = disk_log:close(n), + ?line {error, no_such_log} = disk_log:info(n), + ?line true = (P0 == pps()), + + % Blocking owner terminates. + ?line Pid7 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {linkto, none}, + {size, {100,No}}, {format, external}]), + ?line {ok, n} = sync_do(Pid7, {open, File}), + ?line ok = sync_do(Pid7, block), + ?line {blocked, true} = status(n), + ?line [_] = owners(n), + ?line 1 = users(n), + ?line sync_do(Pid7, terminate), + ?line ok = status(n), + ?line [] = owners(n), + ?line 1 = users(n), + ?line ok = disk_log:close(n), + ?line {error, no_such_log} = disk_log:info(n), + ?line true = (P0 == pps()), + + %% Two owners, the blocking one terminates. + ?line Pid8 = spawn_link(?MODULE, lserv, [n]), + ?line Pid9 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = sync_do(Pid8, {open, File}), + ?line {ok, n} = sync_do(Pid9, {open, File}), + ?line ok = sync_do(Pid8, block), + ?line {blocked, true} = status(n), + ?line sync_do(Pid8, terminate), + ?line ok = status(n), + ?line [_] = sync_do(Pid9, owners), + ?line 0 = sync_do(Pid9, users), + ?line sync_do(Pid9, terminate), + ?line {error, no_such_log} = disk_log:info(n), + ?line true = (P0 == pps()), + + % Blocking user closes. + ?line Pid10 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}, {format, external}]), + ?line {ok, n} = sync_do(Pid10, {open, File, none}), + ?line ok = sync_do(Pid10, block), + ?line {blocked, true} = status(n), + ?line [_] = owners(n), + ?line 1 = users(n), + ?line ok = sync_do(Pid10, close), + ?line ok = status(n), + ?line [_] = owners(n), + ?line 0 = users(n), + ?line ok = disk_log:close(n), + ?line sync_do(Pid10, terminate), + ?line {error, no_such_log} = disk_log:info(n), + ?line true = (P0 == pps()), + + % Blocking user unblocks and closes. + ?line Pid11 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}, {format, external}]), + ?line {ok, n} = sync_do(Pid11, {open, File, none}), + ?line ok = sync_do(Pid11, block), + ?line {blocked, true} = status(n), + ?line [_] = owners(n), + ?line 1 = users(n), + ?line ok = sync_do(Pid11, unblock), + ?line ok = sync_do(Pid11, close), + ?line ok = status(n), + ?line [_] = owners(n), + ?line 0 = users(n), + ?line ok = disk_log:close(n), + ?line {error, no_such_log} = disk_log:info(n), + ?line sync_do(Pid11, terminate), + ?line true = (P0 == pps()), + + % Blocking owner closes. + ?line Pid12 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {linkto, none}, + {size, {100,No}}, {format, external}]), + ?line {ok, n} = sync_do(Pid12, {open, File}), + ?line ok = sync_do(Pid12, block), + ?line {blocked, true} = status(n), + ?line [_] = owners(n), + ?line 1 = users(n), + ?line ok = sync_do(Pid12, close), + ?line ok = status(n), + ?line [] = owners(n), + ?line 1 = users(n), + ?line ok = disk_log:close(n), + ?line {error, no_such_log} = disk_log:info(n), + ?line sync_do(Pid12, terminate), + ?line true = (P0 == pps()), + + % Blocking owner unblocks and closes. + ?line Pid13 = spawn_link(?MODULE, lserv, [n]), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {linkto, none}, + {size, {100,No}}, {format, external}]), + ?line {ok, n} = sync_do(Pid13, {open, File}), + ?line ok = sync_do(Pid13, block), + ?line {blocked, true} = status(n), + ?line [_] = owners(n), + ?line 1 = users(n), + ?line ok = sync_do(Pid13, unblock), + ?line ok = sync_do(Pid13, close), + ?line ok = status(n), + ?line [] = owners(n), + ?line 1 = users(n), + ?line ok = disk_log:close(n), + ?line {error, no_such_log} = disk_log:info(n), + ?line sync_do(Pid13, terminate), + ?line true = (P0 == pps()), + + del(File, No), % cleanup + ok. + +close_deadlock(suite) -> []; +close_deadlock(doc) -> + ["OTP-4745. Deadlock with just an ordinary log could happen."]; +close_deadlock(Conf) when is_list(Conf) -> + ?line true = is_alive(), + + ?line PrivDir = ?privdir(Conf), + + ?line F1 = filename:join(PrivDir, "a.LOG"), + ?line file:delete(F1), + Self = self(), + + %% One process opens the log at the same time as another process + %% closes the log. Used to always cause deadlock before OTP-4745. + Name = a, + Fun = fun() -> open_close(Self, Name, F1) end, + P = spawn(Fun), + ?line receive {P, Name} -> ok end, + ?line {ok, L} = disk_log:open([{name,Name},{file,F1}]), + ?line ok = disk_log:close(L), + ?line receive {P, done} -> ok end, + ?line file:delete(F1), + + %% One process opens the log at the same time as another process + %% closes the log due to file error while truncating. + %% This test is time dependent, but does not fail when it does not + %% "work". When it works, as it seems to do right now :), the + %% disk_log_server gets {error, no_such_log}, receives the EXIT + %% message caused by truncate, and tries to open the log again. + ?line No = 4, + ?line LDir = F1 ++ ".2", + ?line file:del_dir(LDir), + ?line del(F1, No), + ?line ok = file:make_dir(LDir), + Fun2 = fun() -> open_truncate(Self, Name, F1, No) end, + P2 = spawn(Fun2), + ?line receive {P2, Name} -> ok end, + ?line {ok, L} = disk_log:open([{name, Name}, {file, F1}, {type, wrap}, + {format, external}]), + %% Note: truncate causes the disk log process to terminate. One + %% cannot say if open above happened before, after, or during the + %% termination. The link to the owner is removed before termination. + ?line case disk_log:close(L) of + ok -> ok; + {error,no_such_log} -> + ok + end, + ?line receive {P2, done} -> ok end, + ?line del(F1, No), + ?line file:del_dir(LDir), + + %% To the same thing, this time using distributed logs. + %% (Does not seem to work very well, unfortunately.) + FunD = fun() -> open_close_dist(Self, Name, F1) end, + PD = spawn(FunD), + receive {PD, Name} -> ok end, + ?line {[_], []} = disk_log:open([{name,Name},{file,F1}, + {distributed,[node()]}]), + ?line ok = disk_log:close(L), + receive {PD, done} -> ok end, + ?line file:delete(F1), + + ok. + +open_close(Pid, Name, File) -> + {ok, L} = disk_log:open([{name,Name},{file,File}]), + Pid ! {self(), Name}, + ok = disk_log:close(L), + Pid ! {self(), done}. + +open_truncate(Pid, Name, File, No) -> + {ok, L} = disk_log:open([{name, Name}, {file, File}, {type, wrap}, + {format, external},{size, {100, No}}]), + Pid ! {self(), Name}, + {error, {file_error, _, _}} = disk_log:truncate(L), + %% The file has been closed, the disklog process has terminated. + Pid ! {self(), done}. + +open_close_dist(Pid, Name, File) -> + {[{_,{ok,L}}], []} = disk_log:open([{name,Name},{file,File}, + {distributed,[node()]}]), + Pid ! {self(), Name}, + ok = disk_log:close(L), + Pid ! {self(), done}. + +async_do(Pid, Req) -> + Pid ! {self(), Req}, + %% make sure the request is queued + timer:sleep(100). + +get_reply() -> + receive Reply -> + Reply + end. + +sync_do(Pid, Req) -> + Pid ! {self(), Req}, + receive + Reply -> + Reply + end. + +lserv(Log) -> + ?line receive + {From, {open, File}} -> + From ! disk_log:open([{name, Log}, {file, File}, {type, wrap}, + {size, {100,1}}, {format, external}]); + {From, {open, File, LinkTo}} -> + From ! disk_log:open([{name, Log}, {file, File}, {type, wrap}, + {linkto, LinkTo}, {size, {100,1}}, + {format, external}]); + {From, {int_open, File}} -> + From ! disk_log:open([{name, Log}, {file, File}, {type, wrap}, + {size, {100,1}}]); + {From, {int_open, File, Size}} -> + From ! disk_log:open([{name, Log}, {file, File}, {type, wrap}, + {size, Size}]); + {From, {dist_open, File, Node}} -> + From ! disk_log:open([{name, Log}, {file, File}, {type, wrap}, + {size, {100,1}}, {distributed, [Node]}]); + {From, {dist_open, File, LinkTo, Node}} -> + From ! disk_log:open([{name, Log}, {file, File}, {type, wrap}, + {linkto, LinkTo}, {size, {100,1}}, + {distributed, [Node]}]); + {From, block} -> + From ! disk_log:block(Log); + {From, {block, Bool}} -> + From ! disk_log:block(Log, Bool); + {From, unblock} -> + From ! disk_log:unblock(Log); + {From, close} -> + From ! disk_log:close(Log); + {From, owners} -> + From ! owners(Log); + {From, users} -> + From ! users(Log); + {From, sync} -> + From ! disk_log:sync(Log); + {From, truncate} -> + From ! disk_log:truncate(Log); + {From, terminate} -> + From ! terminated, + exit(normal); + {From, {log, B}} -> + From ! disk_log:log(Log, B); + {From, {blog, B}} -> + From ! disk_log:blog(Log, B); + {From, {alog, B}} -> + From ! disk_log:alog(Log, B); + {From, {balog, B}} -> + From ! disk_log:balog(Log, B); + {From, {change_notify, Pid, Bool}} -> + From ! disk_log:change_notify(Log, Pid, Bool); + {From, {change_header, Header}} -> + From ! disk_log:change_header(Log, Header); + {From, {change_size, Size}} -> + From ! disk_log:change_size(Log, Size); + {From, inc_wrap_file} -> + From ! disk_log:inc_wrap_file(Log); + {From, {chunk, Cont}} -> + From ! disk_log:chunk(Log, Cont); + {From, {chunk_step, Cont, N}} -> + From ! disk_log:chunk_step(Log, Cont, N); + Any -> + io:format("invalid request ~p~n", [Any]), + exit(abnormal) + end, + lserv(Log). + +error(suite) -> [error_repair, error_log, error_index]. + +error_repair(suite) -> []; +error_repair(doc) -> + ["Error while repairing."]; +error_repair(Conf) when is_list(Conf) -> + % not all error situations are covered by this test + + DataDir = ?datadir(Conf), + PrivDir = ?privdir(Conf), + + ?line File = filename:join(PrivDir, "n.LOG"), + ?line No = 4, + ?line file:delete(File), + ?line del(File, No), % cleanup + + % kurt.LOG is not closed and has four logged items, one is recovered + ?line copy_wrap_log("kurt.LOG", "n.LOG", No, DataDir, PrivDir), + ?line {repaired,n,{recovered,1},{badbytes,0}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, {size,{40,No}}]), + ?line 1 = cur_cnt(n), + ?line 53 = curb(n), + ?line 4 = no_items(n), + ?line ok = disk_log:close(n), + + % temporary repair file cannot be created + ?line copy_wrap_log("kurt.LOG", "n.LOG", No, DataDir, PrivDir), + ?line Dir = File ++ ".4" ++ ".TMP", + ?line ok = file:make_dir(Dir), + ?line P0 = pps(), + ?line {error, {file_error, _, _}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, {size,{40,4}}]), + ?line true = (P0 == pps()), + ?line del(File, No), + ?line ok = file:del_dir(Dir), + + %% repair a file + ?line P1 = pps(), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {40,No}}]), + ?line ok = disk_log:log_terms(n, [{this,is}]), % first file full + ?line ok = disk_log:log_terms(n, [{some,terms}]), % second file full + ?line ok = disk_log:close(n), + ?line BadFile = add_ext(File, 2), % current file + ?line set_opened(BadFile), + ?line crash(BadFile, 28), % the binary is now invalid + ?line {repaired,n,{recovered,0},{badbytes,26}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {40,No}}]), + ?line ok = disk_log:close(n), + ?line true = (P1 == pps()), + ?line del(File, No), + + %% yet another repair + ?line P2 = pps(), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {4000,No}}]), + ?line ok = disk_log:log_terms(n, [{this,is},{some,terms}]), + ?line ok = disk_log:close(n), + ?line BadFile2 = add_ext(File, 1), % current file + ?line set_opened(BadFile2), + ?line crash(BadFile2, 51), % the second binary is now invalid + ?line {repaired,n,{recovered,1},{badbytes,26}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {4000,No}}]), + ?line ok = disk_log:close(n), + ?line true = (P2 == pps()), + ?line del(File, No), + + %% Repair, large term + ?line Big = term_to_binary(lists:duplicate(66000,$a)), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {40,No}}]), + ?line ok = disk_log:log_terms(n, [Big]), + ?line ok = disk_log:close(n), + ?line set_opened(add_ext(File, 1)), + ?line {repaired,n,{recovered,1},{badbytes,0}} = + disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {40,No}}]), + ?line {_, [Got]} = disk_log:chunk(n, start), + ?line ok = disk_log:close(n), + ?line Got = Big, + ?line del(File, No), + + %% A term a little smaller than a chunk, then big terms. + ?line BigSmall = mk_bytes(1024*64-8-12), + ?line file:delete(File), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}]), + ?line ok = disk_log:log_terms(n, [BigSmall, Big, Big]), + ?line ok = disk_log:close(n), + ?line set_opened(File), + ?line FileSize = file_size(File), + ?line crash(File, FileSize-byte_size(Big)-4), + ?line Error1 = {error, {need_repair, _}} = + disk_log:open([{name, n}, {file, File}, {repair, false}, + {type, halt}, {format, internal}]), + ?line "The disk log" ++ _ = format_error(Error1), + ?line {repaired,n,{recovered,2},{badbytes,132013}} = + disk_log:open([{name, n}, {file, File}, {repair, true}, + {type, halt}, {format, internal}]), + ?line ok = disk_log:close(n), + ?line file:delete(File), + + %% The header is recovered. + ?line {ok,n} = + disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}, + {head_func, {?MODULE, head_fun, [{ok,"head"}]}}]), + ?line ok = disk_log:log_terms(n, [list,'of',terms]), + ?line ["head",list,'of',terms] = get_all_terms(n), + ?line ok = disk_log:close(n), + ?line set_opened(File), + ?line crash(File, 30), + ?line {repaired,n,{recovered,3},{badbytes,16}} = + disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal},{repair,true}, + {head_func, {?MODULE, head_fun, [{ok,"head"}]}}]), + ?line ["head",'of',terms] = get_all_terms(n), + ?line ok = disk_log:close(n), + + file:delete(File), + + ok. + +set_opened(File) -> + {ok, Fd} = file:open(File, [raw, binary, read, write]), + ok = file:write(Fd, [?LOGMAGIC, ?OPENED]), + ok = file:close(Fd). + +error_log(suite) -> []; +error_log(doc) -> + ["Error while repairing."]; +error_log(Conf) when is_list(Conf) -> + ?line Dir = ?privdir(Conf), + + ?line File = filename:join(Dir, "n.LOG"), + ?line No = 4, + ?line file:delete(File), + ?line del(File, No), % cleanup + ?line LDir = File ++ ".2", + + ?line Q = qlen(), + % dummy just to get all processes "above" disk_log going + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external},{size, {100, No}}]), + ?line ok = disk_log:close(n), + ?line del(File, No), + + % inc_wrap_file fails, the external log is not terminated + ?line P0 = pps(), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external},{size, {100, No}}]), + ?line ok = file:make_dir(LDir), + ?line {error, {file_error, _, _}} = disk_log:inc_wrap_file(n), + ?line timer:sleep(500), + ?line ok = disk_log:close(n), + ?line del(File, No), + + % inc_wrap_file fails, the internal log is not terminated, ./File.2/ exists + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal},{size, {100, No}}]), + ?line {error, {file_error, _, _}} = disk_log:inc_wrap_file(n), + ?line ok = disk_log:close(n), + ?line del(File, No), + + % truncate fails, the log is terminated, ./File.2/ exists + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external},{size, {100, No}}]), + ?line {error, {file_error, _, _}} = disk_log:truncate(n), + ?line true = (P0 == pps()), + ?line del(File, No), + + %% OTP-4880. + % reopen (rename) fails, the log is terminated, ./File.2/ exists + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, external},{size, 100000}]), + ?line {error, eisdir} = disk_log:reopen(n, LDir), + ?line true = (P0 == pps()), + ?line file:delete(File), + + ?line B = mk_bytes(60), + + %% OTP-4880. reopen a wrap log, rename fails + ?line File2 = filename:join(Dir, "n.LOG2"), + ?line {ok, n} = disk_log:open([{name, n}, {file, File2}, {type, wrap}, + {format, external},{size, {100, No}}]), + ?line ok = disk_log:blog_terms(n, [B,B,B]), + ?line {error, eisdir} = disk_log:reopen(n, File), + ?line {error, no_such_log} = disk_log:close(n), + ?line del(File2, No), + ?line del(File, No), + + % log, external wrap log, ./File.2/ exists + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external},{size, {100, No}}]), + ?line {error, {file_error, _, _}} = disk_log:blog_terms(n, [B,B,B]), + ?line ok = disk_log:close(n), + ?line del(File, No), + + % log, internal wrap log, ./File.2/ exists + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal},{size, {100, No}}]), + ?line {error, {file_error, _, _}} = disk_log:log_terms(n, [B,B,B]), + ?line ok = disk_log:close(n), + ?line del(File, No), + + ?line ok = file:del_dir(LDir), + + % can't remove file when changing size + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal},{size, {100, No}}]), + ?line ok = disk_log:log_terms(n, [B,B,B,B]), + ?line ok = disk_log:change_size(n, {100, No-2}), + ?line Three = File ++ ".3", + ?line ok = file:delete(Three), + ?line ok = file:make_dir(Three), + ?line {error, {file_error, _, _}} = disk_log:log_terms(n, [B,B,B]), + ?line timer:sleep(500), + ?line ok = disk_log:close(n), + ?line ok = file:del_dir(Three), + ?line del(File, No), + ?line Q = qlen(), + ok. + +chunk(suite) -> []; +chunk(doc) -> + ["Test chunk and chunk_step."]; +chunk(Conf) when is_list(Conf) -> + %% See also halt_ro_crash/1 above. + + Dir = ?privdir(Conf), + ?line File = filename:join(Dir, "n.LOG"), + No = 4, + ?line B = mk_bytes(60), + ?line BB = mk_bytes(64000), % 64 kB chunks + ?line del(File, No),% cleanup + + %% Make sure chunk_step skips the rest of the binary. + %% OTP-3716. This was a bug... + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {50,No}}]), + %% 1, 2 and 3 on file one, 4 on file two. + ?line ok = disk_log:log_terms(n, [1,2,3,4]), + ?line {I1, [1]} = disk_log:chunk(n, start, 1), + ?line [{node,Node}] = disk_log:chunk_info(I1), + ?line Node = node(), + ?line Error1 = {error, {no_continuation, foobar}} = + disk_log:chunk_info(foobar), + ?line "The term" ++ _ = format_error(Error1), + ?line {ok, I2} = disk_log:chunk_step(n, I1, 1), + ?line {error, {badarg, continuation}} = disk_log:chunk_step(n, foobar, 1), + ?line {I3, [4]} = disk_log:chunk(n, I2, 1), + ?line {ok, I4} = disk_log:chunk_step(n, I3, -1), + ?line {_, [1]} = disk_log:chunk(n, I4, 1), + ?line {error, {badarg, continuation}} = disk_log:bchunk(n, 'begin'), + ?line {Ib1, [Bin1,Bin2]} = disk_log:bchunk(n, start, 2), + ?line 1 = binary_to_term(Bin1), + ?line 2 = binary_to_term(Bin2), + ?line {ok, Ib2} = disk_log:chunk_step(n, Ib1, 1), + ?line {Ib3, [Bin3]} = disk_log:bchunk(n, Ib2, 1), + ?line 4 = binary_to_term(Bin3), + ?line {ok, Ib4} = disk_log:chunk_step(n, Ib3, -1), + ?line {_, [Bin4]} = disk_log:bchunk(n, Ib4, 1), + ?line 1 = binary_to_term(Bin4), + ?line {Ib5, [Bin1, Bin2, Bin17]} = disk_log:bchunk(n, start), + ?line 3 = binary_to_term(Bin17), + ?line {Ib6, [Bin3]} = disk_log:bchunk(n, Ib5, infinity), + ?line eof = disk_log:bchunk(n, Ib6, infinity), + ?line ok = disk_log:close(n), + ?line del(File, No), % cleanup + + %% external log, cannot read chunks + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external}, {size, {100,No}}]), + ?line {error, {badarg, continuation}} = disk_log:chunk(n, 'begin'), + ?line {error, {format_external, n}} = disk_log:chunk(n, start), + ?line Error2 = {error, {not_internal_wrap, n}} = + disk_log:chunk_step(n, start, 1), + ?line "The requested" ++ _ = format_error(Error2), + ?line ok = disk_log:close(n), + ?line del(File, No), + + %% wrap, read_write + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {100,No}}]), + ?line ok = disk_log:log_terms(n, [B,B,B,B]), + ?line {C1, [_]} = disk_log:chunk(n, start), + ?line {C2, [_]} = disk_log:chunk(n, C1), + ?line {C3, [_]} = disk_log:chunk(n, C2), + ?line {C4, [_]} = disk_log:chunk(n, C3, 1), + ?line eof = disk_log:chunk(n, C4), + ?line {C5, [_]} = disk_log:chunk(n, start), + ?line {ok, C6} = disk_log:chunk_step(n, C5, 1), + ?line {C7, [_]} = disk_log:chunk(n, C6), + ?line {ok, C8} = disk_log:chunk_step(n, C7, 1), + ?line {_, [_]} = disk_log:chunk(n, C8), + ?line ok = disk_log:close(n), + + %% wrap, read_only + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {mode, read_only}, + {format, internal}, {size, {100,No}}]), + ?line {CC1, [_]} = disk_log:chunk(n, start), + ?line {CC2, [_]} = disk_log:chunk(n, CC1), + ?line {CC3, [_]} = disk_log:chunk(n, CC2), + ?line {CC4, [_]} = disk_log:chunk(n, CC3, 1), + ?line eof = disk_log:chunk(n, CC4), + ?line {CC5, [_]} = disk_log:chunk(n, start), + ?line {ok, CC6} = disk_log:chunk_step(n, CC5, 1), + ?line {CC7, [_]} = disk_log:chunk(n, CC6), + ?line {ok, CC8} = disk_log:chunk_step(n, CC7, 1), + ?line {_, [_]} = disk_log:chunk(n, CC8), + ?line ok = disk_log:close(n), + + %% OTP-3716. A bug: {Error, List} and {Error, List, Bad} could be + %% returned from chunk/2. + %% Magic bytes not OK. + %% File header (8 bytes) OK, item header not OK. + ?line InvalidFile = add_ext(File, 1), + ?line crash(InvalidFile, 15), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {mode, read_only}, + {format, internal}, {size, {100,No}}]), + ?line {_, [], 61} = disk_log:chunk(n, start), + ?line ok = disk_log:close(n), + %% read_write... + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {100,No}}]), + ?line Error3 = {error, {corrupt_log_file, Culprit}} = + disk_log:chunk(n, start), + ?line "The disk log file" ++ _ = format_error(Error3), + ?line Culprit = InvalidFile, + ?line ok = disk_log:close(n), + ?line del(File, No), + + %% Two wrap log files, writing the second one, then reading the first + %% one, where a bogus term resides. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {40,No}}]), + ?line ok = disk_log:log_terms(n, [{this,is}]), % first file full + ?line ok = disk_log:log_terms(n, [{some,terms}]), % second file full + ?line 2 = curf(n), + ?line BadFile = add_ext(File, 1), + ?line crash(BadFile, 28), % the _binary_ is now invalid + ?line {error, {corrupt_log_file, BFile}} = disk_log:chunk(n, start, 1), + ?line BadFile = BFile, + ?line ok = disk_log:close(n), + %% The same, with a halt log. + ?line file:delete(File), % cleanup + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}]), + ?line ok = disk_log:log_terms(n, [{this,is}]), + ?line ok = disk_log:sync(n), + ?line crash(File, 28), % the _binary_ is now invalid + ?line {error, {corrupt_log_file, File2}} = disk_log:chunk(n, start, 1), + ?line crash(File, 10), + ?line {error,{corrupt_log_file,_}} = disk_log:bchunk(n, start, 1), + ?line true = File == File2, + ?line ok = disk_log:close(n), + ?line del(File, No), + + %% halt, read_write + ?line file:delete(File), % cleanup + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}]), + ?line ok = disk_log:log_terms(n, [BB,BB,BB,BB]), + ?line {D1, [Ch1]} = disk_log:chunk(n, start, 1), + ?line Ch1 = BB, + ?line {D2, [Ch2]} = disk_log:chunk(n, D1, 1), + ?line Ch2 = BB, + ?line {D3, [Ch3]} = disk_log:chunk(n, D2, 1), + ?line Ch3 = BB, + ?line {D4, [Ch4]} = disk_log:chunk(n, D3, 1), + ?line Ch4 = BB, + ?line eof = disk_log:chunk(n, D4), + ?line ok = disk_log:close(n), + + %% halt, read_only + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal},{mode,read_only}]), + ?line {E1, [Ch5]} = disk_log:chunk(n, start, 1), + ?line Ch5 = BB, + ?line {E2, [Ch6]} = disk_log:chunk(n, E1, 1), + ?line Ch6 = BB, + ?line {E3, [Ch7]} = disk_log:chunk(n, E2, 1), + ?line Ch7 = BB, + ?line {E4, [Ch8]} = disk_log:chunk(n, E3, 1), + ?line Ch8 = BB, + ?line eof = disk_log:chunk(n, E4), + ?line ok = disk_log:close(n), + ?line file:delete(File), % cleanup + + %% More than 64 kB term. + ?line BBB = term_to_binary(lists:duplicate(66000,$a)), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}]), + ?line ok = disk_log:log_terms(n, [BBB]), + ?line {F1, [BBB1]} = disk_log:chunk(n, start), + ?line BBB1 = BBB, + ?line eof = disk_log:chunk(n, F1), + ?line ok = disk_log:close(n), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}, {mode, read_only}]), + ?line {F1r, [BBB2]} = disk_log:chunk(n, start), + ?line BBB2 = BBB, + ?line eof = disk_log:chunk(n, F1r), + ?line ok = disk_log:close(n), + + ?line truncate(File, 8192), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}]), + ?line {error, {corrupt_log_file, _}} = disk_log:chunk(n, start), + ?line ok = disk_log:close(n), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}, {mode, read_only}]), + ?line {K1, [], 8176} = disk_log:chunk(n, start), + ?line eof = disk_log:chunk(n, K1), + ?line ok = disk_log:close(n), + ?line file:delete(File), % cleanup + + %% OTP-3716. A bug: eof in the middle of the last element is not ok. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}]), + ?line ok = disk_log:log_terms(n, [B,BB]), + ?line ok = disk_log:close(n), + ?line truncate(File, 80), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}]), + ?line {G1, [_]} = disk_log:chunk(n, start, 1), + ?line {error, {corrupt_log_file, _}} = disk_log:chunk(n, G1, 1), + ?line ok = disk_log:close(n), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}, {mode, read_only}]), + ?line {G1r, [_]} = disk_log:chunk(n, start, 1), + ?line {_, [], 4} = disk_log:chunk(n, G1r, 1), + ?line ok = disk_log:close(n), + ?line file:delete(File), % cleanup + + %% Opening a wrap log read-only. The second of four terms is destroyed. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {size, {4000,No}}]), + ?line ok = disk_log:log_terms(n, + [{this,is},{some,terms},{on,a},{wrap,file}]), + ?line ok = disk_log:close(n), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, internal}, {mode, read_only}]), + ?line CrashFile = add_ext(File, 1), + ?line crash(CrashFile, 51), % the binary term {some,terms} is now bad + ?line {H1, [{this,is}], 18} = disk_log:chunk(n, start, 10), + ?line {H2, [{on,a},{wrap,file}]} = disk_log:chunk(n, H1), + ?line eof = disk_log:chunk(n, H2), + ?line ok = disk_log:close(n), + ?line del(File, No), + + %% The same as last, but with a halt log. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}, {mode, read_write}]), + ?line ok = disk_log:alog_terms(n, [{this,is},{some,terms}]), + ?line ok = disk_log:log_terms(n, [{on,a},{halt,file}]), + ?line ok = disk_log:close(n), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}, {mode, read_only}]), + ?line crash(File, 51), % the binary term {some,terms} is now bad + ?line {J1, [{this,is}], 18} = disk_log:chunk(n, start, 10), + ?line {J2, [{on,a},{halt,file}]} = disk_log:chunk(n, J1), + ?line eof = disk_log:chunk(n, J2), + ?line ok = disk_log:close(n), + ?line file:delete(File), + + %% OTP-7641. Same as last one, but the size of the bad term is + %% less than ?HEADERSz (8) bytes. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}, {mode, read_write}]), + ?line ok = disk_log:alog_terms(n, [{this,is},{s}]), + ?line ok = disk_log:log_terms(n, [{on,a},{halt,file}]), + ?line ok = disk_log:close(n), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}, {mode, read_only}]), + ?line crash(File, 44), % the binary term {s} is now bad + ?line {J11, [{this,is}], 7} = disk_log:chunk(n, start, 10), + ?line {J21, [{on,a},{halt,file}]} = disk_log:chunk(n, J11), + ?line eof = disk_log:chunk(n, J21), + ?line ok = disk_log:close(n), + ?line file:delete(File), + + %% Minimal MD5-proctected term, and maximal unprotected term. + %% A chunk ends in the middle of the MD5-sum. + ?line MD5term = mk_bytes(64*1024-8), + ?line NotMD5term = mk_bytes((64*1024-8)-1), + ?line Term2 = mk_bytes((64*1024-8)-16), + ?line MD5L = [MD5term,NotMD5term,Term2,MD5term,MD5term,NotMD5term], + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}]), + ?line ok = disk_log:log_terms(n, MD5L), + ?line true = MD5L == get_all_terms(n), + ?line ok = disk_log:close(n), + ?line true = MD5L == get_all_terms(n, File, halt), + ?line crash(File, 21), % the MD5-sum of the first term is now bad + ?line true = {tl(MD5L),64*1024-8} == get_all_terms_and_bad(n, File, halt), + ?line {_,64*1024-8} = get_all_binary_terms_and_bad(n, File, halt), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {format, internal}]), + ?line {error, {corrupt_log_file, _}} = disk_log:chunk(n, start), + ?line ok = disk_log:close(n), + ?line file:delete(File), + + %% A file with "old" terms (magic word is MAGICINT). + DataDir = ?datadir(Conf), + OldTermsFileOrig = filename:join(DataDir, "old_terms.LOG"), + OldTermsFile = filename:join(Dir, "old_terms.LOG"), + ?line copy_file(OldTermsFileOrig, OldTermsFile), + ?line {[_,_,_,_],0} = get_all_terms_and_bad(n, OldTermsFile, halt), + ?line {ok, n} = disk_log:open([{name, n}, {file, OldTermsFile}, + {type, halt}, {format, internal}]), + ?line [_,_,_,_] = get_all_terms(n), + ?line ok = disk_log:close(n), + ?line file:delete(OldTermsFile), + + ok. + +error_index(suite) -> []; +error_index(doc) -> + ["OTP-5558. Keep the contents of index files after disk crash."]; +error_index(Conf) when is_list(Conf) -> + ?line Dir = ?privdir(Conf), + + ?line File = filename:join(Dir, "n.LOG"), + ?line IdxFile = File ++ ".idx", + ?line No = 4, + ?line file:delete(File), + ?line del(File, No), % cleanup + + Args = [{name,n},{type,wrap},{size,{100,No}},{file,File}], + ?line {ok, n} = disk_log:open(Args), + ?line ok = disk_log:close(n), + ?line Q = qlen(), + P0 = pps(), + ?line ok = file:write_file(IdxFile, <<"abc">>), + ?line {error, {invalid_index_file, _}} = disk_log:open(Args), + ?line {error, {invalid_index_file, _}} = disk_log:open(Args), + ?line {error, {invalid_index_file, _}} = disk_log:open(Args), + + ?line del(File, No), + ?line true = (P0 == pps()), + ?line true = (Q == qlen()), + ok. + +truncate(suite) -> []; +truncate(doc) -> + ["Test truncate/1 on halt and wrap logs."]; +truncate(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + + ?line Q = qlen(), + Halt = join(Dir, "halt.LOG"), + % Halt logs. + + ?line file:delete(Halt), % cleanup + ?line {ok, halt} = disk_log:open([{name, halt}, {type, halt}, {file, Halt}, + {head, header}, {notify, true}]), + ?line infinity = sz(halt), + ?line ok = disk_log:truncate(halt, tjohej), + ?line rec(1, {disk_log, node(), halt, {truncated, 1}}), + ?line ok = disk_log:change_size(halt, 10000), + ?line 10000 = sz(halt), + ?line disk_log:close(halt), + ?line [tjohej] = get_all_terms(halt, Halt, halt), + ?line file:delete(Halt), + + ?line {ok, halt} = disk_log:open([{name, halt}, {type, halt}, {file, Halt}, + {head, header}, {notify, true}]), + ?line ok = disk_log:truncate(halt), + ?line rec(1, {disk_log, node(), halt, {truncated, 1}}), + ?line disk_log:close(halt), + ?line [header] = get_all_terms(halt, Halt, halt), + ?line file:delete(Halt), + + ?line {ok, halt} = disk_log:open([{name, halt}, {type, halt}, + {file, Halt}, {format, external}, + {head, "header"}, {notify, false}]), + ?line ok = disk_log:btruncate(halt, "apa"), + ?line disk_log:close(halt), + ?line 3 = file_size(Halt), + ?line file:delete(Halt), + + %% Wrap logs. + ?line File = filename:join(Dir, "n.LOG"), + ?line No = 4, + ?line B = mk_bytes(60), + ?line del(File, No), % cleanup + + %% Internal with header. + ?line Size = {100, No}, + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {head, header}, {notify, true}, + {size, Size}]), + ?line ok = disk_log:log_terms(n, [B,B,B]), + %% Used to be one message, but now one per wrapped file. + ?line rec(2, {disk_log, node(), n, {wrap, 0}}), + ?line ok = disk_log:truncate(n, apa), + ?line rec(1, {disk_log, node(), n, {truncated, 6}}), + ?line {0, 0} = no_overflows(n), + ?line 23 = curb(n), + ?line 1 = curf(n), + ?line 1 = cur_cnt(n), + ?line true = (Size == sz(n)), + + ?line ok = disk_log:log_terms(n, [B, B]), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line ok = disk_log:close(n), + ?line [apa, _, header, _] = get_all_terms(n, File, wrap), + ?line del(File, No), + + %% Internal without general header. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {notify, true}, + {size, {100, No}}]), + ?line ok = disk_log:log_terms(n, [B,B,B]), + ?line rec(2, {disk_log, node(), n, {wrap, 0}}), + ?line ok = disk_log:truncate(n, apa), + ?line rec(1, {disk_log, node(), n, {truncated, 3}}), + ?line {0, 0} = no_overflows(n), + ?line 23 = curb(n), + ?line 1 = curf(n), + ?line 1 = cur_cnt(n), + ?line true = (Size == sz(n)), + + ?line ok = disk_log:log_terms(n, [B, B]), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line ok = disk_log:close(n), + ?line [apa, _, _] = get_all_terms(n, File, wrap), + ?line del(File, No), + + %% Internal without any header. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {notify, true}, + {size, {100, No}}]), + ?line ok = disk_log:log_terms(n, [B,B,B]), + ?line rec(2, {disk_log, node(), n, {wrap, 0}}), + ?line ok = disk_log:truncate(n), + ?line rec(1, {disk_log, node(), n, {truncated, 3}}), + ?line {0, 0} = no_overflows(n), + ?line 8 = curb(n), + ?line 1 = curf(n), + ?line 0 = cur_cnt(n), + ?line true = (Size == sz(n)), + + ?line ok = disk_log:log_terms(n, [B, B]), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line ok = disk_log:close(n), + ?line [_, _] = get_all_terms(n, File, wrap), + ?line del(File, No), + ?line Q = qlen(), + ok. + + +many_users(suite) -> []; +many_users(doc) -> + ["Test many users logging and sync:ing at the same time."]; +many_users(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + N = 100, + NoClients = 10, + Fun1 = fun(Name, Pid, I) -> disk_log:log(Name, {Pid, I}) end, + Fun2 = fun(Name, Pid, I) -> ok = disk_log:log(Name, {Pid, I}), + disk_log:sync(Name) end, + ?line {C1, T1} = many(Fun2, NoClients, N, halt, internal, infinity, Dir), + ?line true = lists:duplicate(NoClients, ok) == C1, + ?line true = length(T1) == N*NoClients, + ?line {C2, T2} = many(Fun1, NoClients, N, halt, internal, 1000, Dir), + ?line true = lists:duplicate(NoClients, {error, {full,'log.LOG'}}) == C2, + ?line true = length(T2) > 0, + ?line {C3, T3} = many(Fun2, NoClients, N, wrap, internal, + {300*NoClients,20}, Dir), + ?line true = lists:duplicate(NoClients, ok) == C3, + ?line true = length(T3) == N*NoClients, + ok. + +many(Fun, NoClients, N, Type, Format, Size, Dir) -> + Name = 'log.LOG', + File = filename:join(Dir, Name), + del_files(Size, File), + ?line Q = qlen(), + ?line {ok, _} = disk_log:open([{name,Name}, {type,Type}, {size,Size}, + {format,Format}, {file,File}]), + ?line Pids = spawn_clients(NoClients, client, [self(), Name, N, Fun]), + ?line Checked = check_clients(Pids), + ?line ok = disk_log:close(Name), + ?line Terms = get_all_terms(Name, File, Type), + ?line del_files(Size, File), + ?line Q = qlen(), + ?line {Checked, Terms}. + +spawn_clients(0, _F, _A) -> + []; +spawn_clients(I, F, A) -> + [spawn_link(?MODULE, F, A) | spawn_clients(I-1, F, A)]. + +check_clients(Pids) -> + lists:map(fun(Pid) -> receive {Pid, Reply} -> Reply end end, Pids). + +client(From, _Name, 0, _Fun) -> + From ! {self(), ok}; +client(From, Name, N, Fun) -> + %% Fun is called N times. + case Fun(Name, self(), N) of + ok -> client(From, Name, N-1, Fun); + Else -> From ! {self(), Else} + end. + +del_files({_NoBytes,NoFiles}, File) -> + del(File, NoFiles); +del_files(_Size, File) -> + file:delete(File). + + + +info(suite) -> [info_current]. + +info_current(suite) -> []; +info_current(doc) -> + ["Test no_current_{bytes, items} as returned by info/0."]; +info_current(Conf) when is_list(Conf) -> + + Dir = ?privdir(Conf), + ?line File = filename:join(Dir, "n.LOG"), + No = 4, + B = mk_bytes(60), + BB = mk_bytes(160), % bigger than a single wrap log file + SB = mk_bytes(10), % much smaller than a single wrap log file + ?line del(File, No),% cleanup + + ?line Q = qlen(), + %% Internal with header. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {head, header}, {size, {100,No}}]), + ?line {26, 1} = {curb(n), cur_cnt(n)}, + ?line {1, 1} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:log(n, B), + ?line {94, 2} = {curb(n), cur_cnt(n)}, + ?line {2, 2} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:close(n), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {notify, true}, + {head, header}, {size, {100,No}}]), + ?line {94, 2} = {curb(n), cur_cnt(n)}, + ?line {0, 2} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:log(n, B), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line {94, 2} = {curb(n), cur_cnt(n)}, + ?line {2, 4} = {no_written_items(n), no_items(n)}, + ?line disk_log:inc_wrap_file(n), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line {26, 1} = {curb(n), cur_cnt(n)}, + ?line {3, 4} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:log_terms(n, [B,B,B]), + %% Used to be one message, but now one per wrapped file. + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line rec(1, {disk_log, node(), n, {wrap, 2}}), + ?line {94, 2} = {curb(n), cur_cnt(n)}, + ?line {8, 7} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:log_terms(n, [B]), + ?line rec(1, {disk_log, node(), n, {wrap, 2}}), + ?line ok = disk_log:log_terms(n, [B]), + ?line rec(1, {disk_log, node(), n, {wrap, 2}}), + ?line {94, 2} = {curb(n), cur_cnt(n)}, + ?line {12, 7} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:log_terms(n, [BB,BB]), + %% Used to be one message, but now one per wrapped file. + ?line rec(2, {disk_log, node(), n, {wrap, 2}}), + ?line {194, 2} = {curb(n), cur_cnt(n)}, + ?line {16, 7} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:log_terms(n, [SB,SB,SB]), + ?line rec(1, {disk_log, node(), n, {wrap, 2}}), + ?line {80, 4} = {curb(n), cur_cnt(n)}, + ?line {20, 9} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:close(n), + ?line del(File, No), + + %% Internal without header. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}]), + ?line {8, 0} = {curb(n), cur_cnt(n)}, + ?line {0, 0} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:log(n, B), + ?line {76, 1} = {curb(n), cur_cnt(n)}, + ?line {1, 1} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:close(n), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {notify, true}, {size, {100,No}}]), + ?line {76, 1} = {curb(n), cur_cnt(n)}, + ?line {0, 1} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:log(n, B), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line {76, 1} = {curb(n), cur_cnt(n)}, + ?line {1, 2} = {no_written_items(n), no_items(n)}, + ?line disk_log:inc_wrap_file(n), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line {8, 0} = {curb(n), cur_cnt(n)}, + ?line {1, 2} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:log_terms(n, [B,B,B]), + %% Used to be one message, but now one per wrapped file. + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line rec(1, {disk_log, node(), n, {wrap, 1}}), + ?line {76, 1} = {curb(n), cur_cnt(n)}, + ?line {4, 4} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:log_terms(n, [B]), + ?line rec(1, {disk_log, node(), n, {wrap, 1}}), + ?line ok = disk_log:log_terms(n, [B]), + ?line rec(1, {disk_log, node(), n, {wrap, 1}}), + ?line {76, 1} = {curb(n), cur_cnt(n)}, + ?line {6, 4} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:log_terms(n, [BB,BB]), + %% Used to be one message, but now one per wrapped file. + ?line rec(2, {disk_log, node(), n, {wrap, 1}}), + ?line {176, 1} = {curb(n), cur_cnt(n)}, + ?line {8, 4} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:log_terms(n, [SB,SB,SB]), + ?line rec(1, {disk_log, node(), n, {wrap, 1}}), + ?line {62, 3} = {curb(n), cur_cnt(n)}, + ?line {11, 6} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:close(n), + ?line del(File, No), + + %% External with header. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external}, {head, "header"}, + {size, {100,No}}]), + ?line {6, 1} = {curb(n), cur_cnt(n)}, + ?line {1, 1} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:blog(n, B), + ?line {62, 2} = {curb(n), cur_cnt(n)}, + ?line {2, 2} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:close(n), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external}, {head, "header"}, + {notify, true}, {size, {100,No}}]), + ?line {62, 2} = {curb(n), cur_cnt(n)}, + ?line {0, 2} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:blog(n, B), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line {62, 2} = {curb(n), cur_cnt(n)}, + ?line {2, 4} = {no_written_items(n), no_items(n)}, + ?line disk_log:inc_wrap_file(n), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line {6, 1} = {curb(n), cur_cnt(n)}, + ?line {3, 4} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:blog_terms(n, [B,B,B]), + %% Used to be one message, but now one per wrapped file. + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line rec(1, {disk_log, node(), n, {wrap, 2}}), + ?line {62, 2} = {curb(n), cur_cnt(n)}, + ?line {8, 7} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:blog_terms(n, [B]), + ?line rec(1, {disk_log, node(), n, {wrap, 2}}), + ?line ok = disk_log:blog_terms(n, [B]), + ?line rec(1, {disk_log, node(), n, {wrap, 2}}), + ?line {62, 2} = {curb(n), cur_cnt(n)}, + ?line {12, 7} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:blog_terms(n, [BB,BB]), + %% Used to be one message, but now one per wrapped file. + ?line rec(2, {disk_log, node(), n, {wrap, 2}}), + ?line {162, 2} = {curb(n), cur_cnt(n)}, + ?line {16, 7} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:blog_terms(n, [SB,SB,SB]), + + ?line rec(1, {disk_log, node(), n, {wrap, 2}}), + ?line {24, 4} = {curb(n), cur_cnt(n)}, + ?line {20, 9} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:close(n), + ?line del(File, No), + + %% External without header. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {format, external}, {size, {100,No}}]), + ?line {0, 0} = {curb(n), cur_cnt(n)}, + ?line {0, 0} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:blog(n, B), + ?line {56, 1} = {curb(n), cur_cnt(n)}, + ?line {1, 1} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:close(n), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {notify, true}, + {format, external}, {size, {100,No}}]), + ?line {56, 1} = {curb(n), cur_cnt(n)}, + ?line {0, 1} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:blog(n, B), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line {56, 1} = {curb(n), cur_cnt(n)}, + ?line {1, 2} = {no_written_items(n), no_items(n)}, + ?line disk_log:inc_wrap_file(n), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line {0, 0} = {curb(n), cur_cnt(n)}, + ?line {1, 2} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:blog_terms(n, [B,B,B]), + %% Used to be one message, but now one per wrapped file. + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line rec(1, {disk_log, node(), n, {wrap, 1}}), + ?line {56, 1} = {curb(n), cur_cnt(n)}, + ?line {4, 4} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:blog_terms(n, [B]), + ?line rec(1, {disk_log, node(), n, {wrap, 1}}), + ?line ok = disk_log:blog_terms(n, [B]), + ?line rec(1, {disk_log, node(), n, {wrap, 1}}), + ?line {56, 1} = {curb(n), cur_cnt(n)}, + ?line {6, 4} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:blog_terms(n, [BB,BB]), + %% Used to be one message, but now one per wrapped file. + ?line rec(2, {disk_log, node(), n, {wrap, 1}}), + ?line {156, 1} = {curb(n), cur_cnt(n)}, + ?line {8, 4} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:blog_terms(n, [SB,SB,SB]), + ?line rec(1, {disk_log, node(), n, {wrap, 1}}), + ?line {18, 3} = {curb(n), cur_cnt(n)}, + ?line {11, 6} = {no_written_items(n), no_items(n)}, + ?line ok = disk_log:close(n), + ?line del(File, No), + + ?line Q = qlen(), + ok. + + +change_size(suite) -> [change_size_before, + change_size_during, + change_size_after, + default_size, change_size2, + change_size_truncate]. + +change_size_before(suite) -> []; +change_size_before(doc) -> + ["Change size of a wrap log file before we have reached " + "to the file index corresponding to the new size"]; +change_size_before(Conf) when is_list(Conf) -> + + Log_1_1 = "first log first message", + Log_1_2 = "first log second message", + Log_2_1 = "second log first message", + Log_2_2 = "second log second message", + Log_3_1 = "third log first message", + Log_3_2 = "third log second message", + Log_4_1 = "fourth log first message", + Log_4_2 = "fourth log second message", + Log_5_1 = "fifth log first message", + Log_5_2 = "fifth log second message", + Log_1_2_1 = "first log second round 1", + Log_1_2_2 = "first log second round 2", + + + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + del(File, 5), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, + {type, wrap}, {size, {100,5}}]), + ?line disk_log:log(a, Log_1_1), + ?line disk_log:log(a, Log_1_2), + ?line disk_log:log(a, Log_2_1), + ?line disk_log:log(a, Log_2_2), + ?line disk_log:change_size(a, {100, 3}), + ?line [Log_1_1, Log_1_2, + Log_2_1, Log_2_2] = get_all_terms(a), + ?line disk_log:log(a, Log_3_1), + ?line disk_log:log(a, Log_3_2), + ?line disk_log:log(a, Log_1_2_1), + ?line disk_log:log(a, Log_1_2_2), + ?line [Log_2_1, Log_2_2, + Log_3_1, Log_3_2, + Log_1_2_1, Log_1_2_2] = get_all_terms(a), + + ?line disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, + {size, {100,3}}]), + ?line [Log_2_1, Log_2_2, + Log_3_1, Log_3_2, + Log_1_2_1, Log_1_2_2] = get_all_terms(a), + disk_log:close(a), + del(File, 5), + + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, + {size, {60,5}}, {format, external}]), + ?line disk_log:blog(a, Log_1_1), + ?line disk_log:blog(a, Log_1_2), + ?line disk_log:blog(a, Log_2_1), + ?line disk_log:blog(a, Log_2_2), + ?line disk_log:change_size(a, {60, 3}), + ?line ok = disk_log:sync(a), + ?line {ok, Fd1} = file:open(File ++ ".1", [read]), + ?line Log11_12 = Log_1_1 ++ Log_1_2, + ?line {ok,Log11_12} = file:read(Fd1, 200), + ?line ok = file:close(Fd1), + ?line {ok, Fd2} = file:open(File ++ ".2", [read]), +% ?t:format(0, "~p~n",[file:read(Fd2, 200)]), + ?line Log21_22 = Log_2_1 ++ Log_2_2, + ?line {ok,Log21_22} = file:read(Fd2, 200), + ?line ok = file:close(Fd2), + ?line disk_log:blog(a, Log_3_1), + ?line disk_log:blog(a, Log_3_2), + ?line disk_log:blog(a, Log_1_2_1), + ?line disk_log:blog(a, Log_1_2_2), + ?line ok = disk_log:sync(a), + ?line {ok, Fd2a} = file:open(File ++ ".2", [read]), + ?line {ok,Log21_22} = file:read(Fd2a, 200), + ?line ok = file:close(Fd2a), + ?line {ok, Fd3a} = file:open(File ++ ".3", [read]), + ?line Log31_32 = Log_3_1 ++ Log_3_2, + ?line {ok,Log31_32} = file:read(Fd3a, 200), + ?line ok = file:close(Fd3a), + ?line {ok, Fd1a} = file:open(File ++ ".1", [read]), + ?line Log121_122 = Log_1_2_1 ++ Log_1_2_2, + ?line {ok,Log121_122} = file:read(Fd1a, 200), + ?line ok = file:close(Fd1a), + + ?line disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, + {size, {60,3}}, {format, external}]), + ?line {ok, Fd2b} = file:open(File ++ ".2", [read]), + ?line {ok,Log21_22} = file:read(Fd2b, 200), + ?line ok = file:close(Fd2b), + ?line {ok, Fd3b} = file:open(File ++ ".3", [read]), + ?line {ok,Log31_32} = file:read(Fd3b, 200), + ?line ok = file:close(Fd3b), + ?line {ok, Fd1b} = file:open(File ++ ".1", [read]), + ?line {ok,Log121_122} = file:read(Fd1b, 200), + ?line ok = file:close(Fd1b), + disk_log:close(a), + del(File, 5), + + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100,5}}]), + ?line disk_log:log(a, Log_1_1), + ?line disk_log:log(a, Log_1_2), + ?line disk_log:log(a, Log_2_1), + ?line disk_log:log(a, Log_2_2), + ?line disk_log:change_size(a, {60, 3}), + ?line [Log_1_1, Log_1_2, + Log_2_1, Log_2_2] = get_all_terms(a), + ?line disk_log:log(a, Log_3_1), + ?line disk_log:log(a, Log_1_2_1), + ?line [Log_2_1, Log_2_2, + Log_3_1, + Log_1_2_1] = get_all_terms(a), + + ?line disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {60,3}}]), + ?line [Log_2_1, Log_2_2, + Log_3_1, + Log_1_2_1] = get_all_terms(a), + disk_log:close(a), + del(File, 5), + + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {60, 3}}]), + ?line disk_log:log(a, Log_1_1), + ?line disk_log:log(a, Log_2_1), + ?line disk_log:change_size(a, {100, 5}), + ?line [Log_1_1, + Log_2_1] = get_all_terms(a), + ?line disk_log:log(a, Log_2_2), + ?line disk_log:log(a, Log_3_1), + ?line disk_log:log(a, Log_3_2), + ?line disk_log:log(a, Log_4_1), + ?line disk_log:log(a, Log_4_2), + ?line disk_log:log(a, Log_5_1), + ?line disk_log:log(a, Log_5_2), + ?line disk_log:log(a, Log_1_2_1), + ?line [Log_2_1, Log_2_2, + Log_3_1, Log_3_2, + Log_4_1, Log_4_2, + Log_5_1, Log_5_2, + Log_1_2_1] = get_all_terms(a), + + ?line disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100, 5}}]), + ?line [Log_2_1, Log_2_2, + Log_3_1, Log_3_2, + Log_4_1, Log_4_2, + Log_5_1, Log_5_2, + Log_1_2_1] = get_all_terms(a), + disk_log:close(a), + del(File, 5). + + + +change_size_during(suite) -> []; +change_size_during(doc) -> ["Change size of a wrap log file while logging " + "to a file index between the old and the new size"]; +change_size_during(Conf) when is_list(Conf) -> + + Log_1_1 = "first log first message", + Log_1_2 = "first log second message", + Log_2_1 = "second log first message", + Log_2_2 = "second log second message", + Log_3_1 = "third log first message", + Log_3_2 = "third log second message", + Log_4_1 = "fourth log first message", + Log_4_2 = "fourth log second message", + Log_5_1 = "fifth log first message", + Log_5_2 = "fifth log second message", + Log_1_2_1 = "first log second round 1", + Log_1_2_2 = "first log second round 2", + Log_2_2_1 = "second log second round 1", + Log_2_2_2 = "second log second round 2", + Log_3_2_1 = "third log second round 1", + Log_3_2_2 = "third log second round 2", + Log_1_3_1 = "first log third round 1", + Log_1_3_2 = "first log third round 2", + + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100,5}}]), + ?line disk_log:log(a, Log_1_1), + ?line disk_log:log(a, Log_1_2), + ?line disk_log:log(a, Log_2_1), + ?line disk_log:log(a, Log_2_2), + ?line disk_log:log(a, Log_3_1), + ?line disk_log:log(a, Log_3_2), + ?line disk_log:log(a, Log_4_1), + ?line disk_log:log(a, Log_4_2), + ?line disk_log:log(a, Log_5_1), + ?line disk_log:log(a, Log_5_2), + ?line disk_log:log(a, Log_1_1), + ?line disk_log:log(a, Log_1_2), + ?line disk_log:log(a, Log_2_1), + ?line disk_log:log(a, Log_2_2), + ?line disk_log:log(a, Log_3_1), + ?line disk_log:log(a, Log_3_2), + ?line disk_log:log(a, Log_4_1), + ?line disk_log:log(a, Log_4_2), + ?line disk_log:change_size(a, {100, 3}), + ?line [Log_5_1, Log_5_2, + Log_1_1, Log_1_2, + Log_2_1, Log_2_2, + Log_3_1, Log_3_2, + Log_4_1, Log_4_2] = get_all_terms(a), + ?line disk_log:log(a, Log_1_2_1), + ?line disk_log:log(a, Log_1_2_2), + ?line [Log_2_1, Log_2_2, + Log_3_1, Log_3_2, + Log_4_1, Log_4_2, + Log_1_2_1, Log_1_2_2] = get_all_terms(a), + + ?line disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100,3}}]), + ?line [Log_2_1, Log_2_2, + Log_3_1, Log_3_2, + Log_4_1, Log_4_2, + Log_1_2_1, Log_1_2_2] = get_all_terms(a), + ?line disk_log:log(a, Log_2_2_1), + ?line disk_log:log(a, Log_2_2_2), + ?line disk_log:log(a, Log_3_2_1), + ?line disk_log:log(a, Log_3_2_2), + ?line disk_log:log(a, Log_1_3_1), + ?line disk_log:log(a, Log_1_3_2), + ?line [Log_2_2_1, Log_2_2_2, + Log_3_2_1, Log_3_2_2, + Log_1_3_1, Log_1_3_2] = get_all_terms(a), + disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100,3}}]), + ?line [Log_2_2_1, Log_2_2_2, + Log_3_2_1, Log_3_2_2, + Log_1_3_1, Log_1_3_2] = get_all_terms(a), + disk_log:close(a), + del(File, 5), + + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100,5}}]), + ?line disk_log:log(a, Log_1_1), + ?line disk_log:log(a, Log_1_2), + ?line disk_log:log(a, Log_2_1), + ?line disk_log:log(a, Log_2_2), + ?line disk_log:log(a, Log_3_1), + ?line disk_log:log(a, Log_3_2), + ?line disk_log:log(a, Log_4_1), + ?line disk_log:log(a, Log_4_2), + ?line disk_log:log(a, Log_5_1), + ?line disk_log:log(a, Log_5_2), + ?line disk_log:log(a, Log_1_1), + ?line disk_log:log(a, Log_1_2), + ?line disk_log:log(a, Log_2_1), + ?line disk_log:log(a, Log_2_2), + ?line disk_log:log(a, Log_3_1), + ?line disk_log:log(a, Log_3_2), + ?line disk_log:log(a, Log_4_1), + ?line disk_log:log(a, Log_4_2), + ?line disk_log:log(a, Log_5_1), + ?line disk_log:log(a, Log_5_2), + ?line disk_log:change_size(a, {100, 3}), + ?line [Log_1_1, Log_1_2, + Log_2_1, Log_2_2, + Log_3_1, Log_3_2, + Log_4_1, Log_4_2, + Log_5_1, Log_5_2] = get_all_terms(a), + ?line disk_log:log(a, Log_1_2_1), + ?line disk_log:log(a, Log_1_2_2), + ?line disk_log:log(a, Log_2_2_1), + ?line disk_log:log(a, Log_2_2_2), + ?line disk_log:log(a, Log_3_2_1), + ?line disk_log:log(a, Log_3_2_2), + ?line disk_log:log(a, Log_1_3_1), + ?line disk_log:log(a, Log_1_3_2), + ?line [Log_2_2_1, Log_2_2_2, + Log_3_2_1, Log_3_2_2, + Log_1_3_1, Log_1_3_2] = get_all_terms(a), + + ?line disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, {size, {100,3}}]), + ?line [Log_2_2_1, Log_2_2_2, + Log_3_2_1, Log_3_2_2, + Log_1_3_1, Log_1_3_2] = get_all_terms(a), + disk_log:close(a), + del(File, 5). + + +change_size_after(suite) -> []; +change_size_after(doc) -> + ["Change size of a wrap log file before we have reached " + "(on the second round) " + "to the file index corresponding to the new size"]; +change_size_after(Conf) when is_list(Conf) -> + + Log_1_1 = "first log first message", + Log_1_2 = "first log second message", + Log_2_1 = "second log first message", + Log_2_2 = "second log second message", + Log_3_1 = "third log first message", + Log_3_2 = "third log second message", + Log_4_1 = "fourth log first message", + Log_4_2 = "fourth log second message", + Log_5_1 = "fifth log first message", + Log_5_2 = "fifth log second message", + Log_1_2_1 = "first log second round 1", + Log_1_2_2 = "first log second round 2", + + Dir = ?privdir(Conf), + File = filename:join(Dir, "a.LOG"), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, + {size, {100,5}}]), + ?line disk_log:log(a, Log_1_1), + ?line disk_log:log(a, Log_1_2), + ?line disk_log:log(a, Log_2_1), + ?line disk_log:log(a, Log_2_2), + ?line disk_log:log(a, Log_3_1), + ?line disk_log:log(a, Log_3_2), + ?line disk_log:log(a, Log_4_1), + ?line disk_log:log(a, Log_4_2), + ?line disk_log:log(a, Log_5_1), + ?line disk_log:log(a, Log_5_2), + ?line disk_log:log(a, Log_1_1), + ?line disk_log:log(a, Log_1_2), + ?line disk_log:log(a, Log_2_1), + ?line disk_log:log(a, Log_2_2), + ?line disk_log:change_size(a, {100, 3}), + ?line [Log_3_1,Log_3_2, + Log_4_1, Log_4_2, + Log_5_1, Log_5_2, + Log_1_1, Log_1_2, + Log_2_1, Log_2_2] = get_all_terms(a), + ?line disk_log:log(a, Log_3_1), + ?line disk_log:log(a, Log_3_2), + ?line disk_log:log(a, Log_1_2_1), + ?line disk_log:log(a, Log_1_2_2), + ?line [Log_2_1, Log_2_2, + Log_3_1, Log_3_2, + Log_1_2_1, Log_1_2_2] = get_all_terms(a), + + ?line disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, + {size, {100,3}}]), + ?line [Log_2_1, Log_2_2, + Log_3_1, Log_3_2, + Log_1_2_1, Log_1_2_2] = get_all_terms(a), + disk_log:close(a), + del(File, 5), + + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, + {size, {100,5}}]), + ?line disk_log:log(a, Log_1_1), + ?line disk_log:log(a, Log_1_2), + ?line disk_log:log(a, Log_2_1), + ?line disk_log:log(a, Log_2_2), + ?line disk_log:log(a, Log_3_1), + ?line disk_log:log(a, Log_3_2), + ?line disk_log:log(a, Log_4_1), + ?line disk_log:log(a, Log_4_2), + ?line disk_log:log(a, Log_5_1), + ?line disk_log:log(a, Log_5_2), + ?line disk_log:log(a, Log_1_1), + ?line disk_log:log(a, Log_1_2), + ?line disk_log:log(a, Log_2_1), + ?line disk_log:log(a, Log_2_2), + ?line disk_log:change_size(a, {60, 3}), + ?line [Log_3_1,Log_3_2, + Log_4_1, Log_4_2, + Log_5_1, Log_5_2, + Log_1_1, Log_1_2, + Log_2_1, Log_2_2] = get_all_terms(a), + ?line disk_log:log(a, Log_3_1), + ?line disk_log:log(a, Log_1_2_1), + ?line [Log_2_1, Log_2_2, + Log_3_1, + Log_1_2_1] = get_all_terms(a), + + ?line disk_log:close(a), + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, + {size, {60,3}}]), + ?line [Log_2_1, Log_2_2, + Log_3_1, + Log_1_2_1] = get_all_terms(a), + disk_log:close(a), + del(File, 5). + + + +default_size(suite) -> []; +default_size(doc) -> ["Open an existing wrap log without size option "]; +default_size(Conf) when is_list(Conf) -> + ?line Dir = ?privdir(Conf), + ?line File = filename:join(Dir, "a.LOG"), + ?line {error, {badarg, size}} = disk_log:open([{name,a}, {file, File}, + {type, wrap}]), + + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}, + {size, {100,5}}]), + ?line disk_log:close(a), + + ?line {ok, a} = disk_log:open([{name,a}, {file, File}, {type, wrap}]), + ?line {100, 5} = disk_log_1:read_size_file(File), + ?line ok = disk_log:close(a), + ?line del(File, 5). + +change_size2(suite) -> []; +change_size2(doc) -> ["Testing change_size/2 a bit more..."]; +change_size2(Conf) when is_list(Conf) -> + + Dir = ?privdir(Conf), + ?line File = filename:join(Dir, "n.LOG"), + ?line No = 4, + ?line del(File, No), % cleanup + + %% External halt. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {size, 100000}, + {format, external}, {type, halt}]), + ?line B = mk_bytes(60), % 56 actually... + ?line ok = disk_log:blog_terms(n, [B,list_to_binary(B),B]), + ?line Error1 = {error, {new_size_too_small,n,168}} = + disk_log:change_size(n, 167), + ?line "The current size" ++ _ = format_error(Error1), + ?line ok = disk_log:change_size(n, infinity), + ?line ok = disk_log:change_size(n, 168), + ?line ok = disk_log:close(n), + ?line file:delete(File), % cleanup + + %% External wrap. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}, {notify, true}, + {format, external}]), + ?line BB = mk_bytes(160), + ?line ok = disk_log:blog_terms(n, [BB, BB, BB, BB]), % create all files + %% Used to be one message, but now one per wrapped file. + ?line rec(3, {disk_log, node(), n, {wrap, 0}}), + ?line ok = disk_log:blog_terms(n, [BB, BB]), + %% Used to be one message, but now one per wrapped file. + ?line rec(2, {disk_log, node(), n, {wrap, 1}}), + ?line ok = disk_log:change_size(n, {100, 2}), + ?line ok = disk_log:change_size(n, {100, 2}), + ?line {100, 2} = sz(n), + ?line ok = disk_log:balog_terms(n, [BB, BB]), + ?line ok = disk_log:balog_terms(n, [BB]), + ?line ok = disk_log:blog_terms(n, [BB]), + %% Used to be one message, but now one per wrapped file. + ?line rec(4, {disk_log, node(), n, {wrap, 1}}), + ?line ok = disk_log:change_size(n, {100, 4}), + ?line ok = disk_log:close(n), + ?line del(File, No), + + %% Internal wrap. + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}, {notify, true}, + {format, internal}]), + ?line ok = disk_log:blog_terms(n, [BB, BB, BB, BB]), % create all files + %% Used to be one message, but now one per wrapped file. + ?line rec(3, {disk_log, node(), n, {wrap, 0}}), + ?line ok = disk_log:blog_terms(n, [BB, BB]), + %% Used to be one message, but now one per wrapped file. + ?line rec(2, {disk_log, node(), n, {wrap, 1}}), + ?line ok = disk_log:change_size(n, {100, 2}), + ?line {100, 2} = sz(n), + ?line ok = disk_log:blog_terms(n, [BB, BB, BB, BB]), + %% Used to be one message, but now one per wrapped file. + ?line rec(4, {disk_log, node(), n, {wrap, 1}}), + ?line ok = disk_log:close(n), + ?line del(File, No). + +change_size_truncate(suite) -> []; +change_size_truncate(doc) -> ["OTP-3484: truncating index file"]; +change_size_truncate(Conf) when is_list(Conf) -> + + Dir = ?privdir(Conf), + ?line File = filename:join(Dir, "bert.LOG"), + ?line No = 3, + ?line B = mk_bytes(60), + + %% The problem here is truncation of the index file. One cannot easily + %% check that the index file is correctly updated, but print_index_file() + %% can be used to follow the progress more closely. + + %% Part 1. + %% Change the size immediately after creating the log, while there + %% are no log files. This used to write stuff a negative offset + %% from the beginning of the file. + ?line del(File, No+1), + ?line {ok, bert} = disk_log:open([{name,bert}, {type,wrap}, {file, File}, + {notify, true}, {size,{1000,255}}]), + ?line ok = disk_log:change_size(bert,{100,No}), + ?line ok = disk_log:blog(bert, B), + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 0}}), + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 0}}), + ?line 3 = curf(bert), + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 1}}), + ?line 1 = curf(bert), + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 1}}), + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 1}}), + + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 1}}), + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 1}}), + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 1}}), + + % Three items expected. + % disk_log_1:print_index_file("bert.LOG.idx"), + ?line 3 = curf(bert), + ?line ok = disk_log:change_size(bert,{100,1}), + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 1}}), + % Three items expected. + % disk_log_1:print_index_file("bert.LOG.idx"), + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 1}}), + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 1}}), + % One item expected. + % disk_log_1:print_index_file("bert.LOG.idx"), + + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 1}}), + ?line ok = disk_log:close(bert), + ?line del(File, No), + + %% Part 2. + %% Change the size twice, the second time while the the effects of + %% the first changed have not yet been handled. Finally close before + %% the index file has been truncated. + + ?line del(File, No), + ?line {ok, bert} = disk_log:open([{name,bert}, {type,wrap}, {file, File}, + {notify, true}, {size,{100,No}}]), + ?line ok = disk_log:blog(bert, B), + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 0}}), + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 0}}), + + ?line 3 = curf(bert), + ?line ok = disk_log:change_size(bert,{100,No-1}), + + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 1}}), + + ?line 1 = curf(bert), + ?line ok = disk_log:change_size(bert,{100,No+1}), + + % Three items expected. + % disk_log_1:print_index_file("bert.LOG.idx"), + + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 1}}), + + % Three items expected. + % disk_log_1:print_index_file("bert.LOG.idx"), + + ?line 2 = curf(bert), + ?line ok = disk_log:change_size(bert,{100,1}), + + % Three items expected. + % disk_log_1:print_index_file("bert.LOG.idx"), + + ?line ok = disk_log:close(bert), + + % State: .siz is 1, current file is 2, index file size is 3... + + ?line {ok, bert} = disk_log:open([{name,bert}, {file, File}, + {type,wrap}, {notify, true}]), + + % Three items expected. + % disk_log_1:print_index_file("bert.LOG.idx"), + + ?line 2 = curf(bert), + ?line ok = disk_log:blog(bert, B), + ?line rec(1, {disk_log, node(), bert, {wrap, 1}}), + ?line ok = disk_log:close(bert), + + ?line {ok, bert} = disk_log:open([{name,bert}, {file, File}, + {type,wrap}, {notify, true}]), + + % Two items expected. + % disk_log_1:print_index_file("bert.LOG.idx"), + + ?line 1 = curf(bert), + ?line ok = disk_log:blog(bert, B), + %% Expect {wrap 0}. Nothing lost now, last wrap notification + %% reported one lost item. + ?line rec(1, {disk_log, node(), bert, {wrap, 0}}), + + % One item expected. + % disk_log_1:print_index_file("bert.LOG.idx"), + ?line ok = disk_log:close(bert), + + ?line del(File, No), + ok. + +change_attribute(suite) -> []; +change_attribute(doc) -> + ["Change notify and head"]; +change_attribute(Conf) when is_list(Conf) -> + + Dir = ?privdir(Conf), + ?line File = filename:join(Dir, "n.LOG"), + ?line No = 4, + ?line del(File, No), % cleanup + ?line B = mk_bytes(60), + + ?line Q = qlen(), + + % test change_notify + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}]), + ?line {ok, n} = disk_log:open([{name, n}]), % ignored... + ?line ok = disk_log:log_terms(n, [B,B]), + ?line {error, {badarg, notify}} = disk_log:change_notify(n, self(), wrong), + ?line ok = disk_log:change_notify(n, self(), false), + ?line ok = disk_log:change_notify(n, self(), true), + ?line Error1 = {error, {not_owner, _}} = + disk_log:change_notify(n, none, true), + ?line "The pid" ++ _ = format_error(Error1), + ?line 2 = no_written_items(n), + ?line 0 = users(n), + ?line Parent = self(), + ?line Pid = spawn(fun() -> disk_log:close(n), Parent ! {self(),done} end), + ?line receive {Pid, done} -> ok end, + ?line 0 = users(n), + ?line 1 = length(owners(n)), + + % test change_header + ?line {error, {badarg, head}} = disk_log:change_header(n, none), + ?line {error, {badarg, head}} = + disk_log:change_header(n, {head_func, {1,2,3}}), + ?line ok = disk_log:change_header(n, {head, header}), + ?line ok = disk_log:log(n, B), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line 4 = no_written_items(n), + ?line ok = disk_log:change_header(n, {head, none}), + ?line ok = disk_log:log(n, B), + ?line rec(1, {disk_log, node(), n, {wrap, 0}}), + ?line 5 = no_written_items(n), + ?line ok = disk_log:change_header(n, + {head_func, {?MODULE, head_fun, [{ok,header}]}}), + ?line ok = disk_log:log(n, B), + ?line rec(1, {disk_log, node(), n, {wrap, 1}}), + ?line 7 = no_written_items(n), + ?line ok = disk_log:close(n), + ?line {error, no_such_log} = disk_log:close(n), + ?line del(File, No), + ?line file:delete(File), % cleanup + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {format, external}, + {type, halt}]), + ?line {error, {badarg, head}} = disk_log:change_header(n, {head, header}), + ?line ok = disk_log:change_header(n, {head, "header"}), + ?line ok = disk_log:close(n), + ?line file:delete(File), + + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}]), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}]), + ?line ok = disk_log:change_notify(n, self(), true), + ?line ok = disk_log:change_header(n, {head, tjolahopp}), + ?line {ok, n} = disk_log:open([{name, n}, {file, File}, {type, wrap}, + {size, {100,No}}, {notify, true}]), + ?line ok = disk_log:close(n), + ?line {error, no_such_log} = disk_log:info(n), + ?line Q = qlen(), + ?line del(File, No). + +distribution(suite) -> [dist_open, dist_error_open, + dist_notify, + dist_terminate, + dist_accessible, + dist_deadlock, + dist_open2, + other_groups]. + +dist_open(suite) -> []; +dist_open(doc) -> + ["Open a distributed log"]; +dist_open(Conf) when is_list(Conf) -> + ?line PrivDir = ?privdir(Conf), + ?line true = is_alive(), + + ?line Q = qlen(), + ?line File = filename:join(PrivDir, "n.LOG"), + ?line File1 = filename:join(PrivDir, "n1.LOG"), + ?line No = 3, + ?line file:delete(File), + ?line del(File, No), % cleanup + ?line del(File1, No), % cleanup + ?line B = mk_bytes(60), + + ?line PA = filename:dirname(code:which(?MODULE)), + ?line {ok, Node} = start_node(disk_log, "-pa " ++ PA), + ?line wait_for_ready_net(), + + %% open non-distributed on this node: + ?line {ok,n} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {distributed, []}]), + + ?line Error1 = {error, {halt_log, n}} = disk_log:inc_wrap_file(n), + ?line "The halt log" ++ _ = format_error(Error1), + ?line ok = disk_log:lclose(n), + ?line file:delete(File), + + %% open distributed on this node: + ?line {[_],[]} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {distributed, [node()]}]), + %% the error message is ignored: + ?line ok = disk_log:inc_wrap_file(n), + ?line ok = disk_log:close(n), + ?line file:delete(File), + + %% open a wrap log on this node, write something on this node + ?line {[_],[]} = disk_log:open([{name, n}, {file, File}, + {type, wrap}, {size, {50, No}}, + {distributed, [node()]}]), + ?line ok = disk_log:log(n, B), + ?line ok = disk_log:close(n), + + %% open a wrap log on this node and aother node, write something + ?line {[_],[]} = disk_log:open([{name, n}, {file, File}, + {type, wrap}, {size, {50, No}}, + {distributed, [node()]}]), + ?line {[_],[]} = disk_log:open([{name, n}, {file, File1}, + {type, wrap}, {size, {50, No}}, + {distributed, [Node]}]), + ?line ok = disk_log:log(n, B), + ?line ok = rpc:call(Node, disk_log, log, [n, B]), + ?line ok = disk_log:close(n), + ?line del(File, No), + ?line del(File1, No), + ?line file:delete(File), + + %% open a wrap log on this node and another node, use lclose + ?line {[_],[]} = disk_log:open([{name, n}, {file, File}, + {type, wrap}, {size, {50, No}}, + {distributed, [node()]}]), + ?line {[_],[]} = disk_log:open([{name, n}, {file, File}, + {type, wrap}, {size, {50, No}}, + {distributed, [node()]}, + {linkto,none}]), + ?line {[_],[]} = disk_log:open([{name, n}, {file, File1}, + {type, wrap}, {size, {50, No}}, + {distributed, [Node]}]), + ?line [_, _] = distributed(n), + ?line ok = disk_log:lclose(n, Node), + ?line [_] = distributed(n), + ?line ok = disk_log:lclose(n), + ?line ok = disk_log:lclose(n), + ?line {error, no_such_log} = disk_log:info(n), + ?line del(File, No), + ?line del(File1, No), + ?line file:delete(File), + + % open an invalid log file, and see how error are handled + ?line First = "n.LOG.1", + ?line make_file(PrivDir, First, 8), + + ?line {[], [_,_]} = disk_log:open([{name, n}, {file, File}, + {type, wrap}, {size, {50, No}}, + {distributed, [Node,node()]}]), + ?line del(File, No), + ?line file:delete(File), + + % open a wrap on one other node (not on this node) + ?line {[_],[]} = disk_log:open([{name, n}, {file, File}, + {type, wrap}, {size, {50, No}}, + {distributed, [Node]}]), + ?line ok = rpc:call(Node, disk_log, log, [n, B]), + ?line {error, no_such_log} = disk_log:lclose(n), + ?line ok = disk_log:close(n), + + ?line Q = qlen(), + + ?line {error, no_such_log} = disk_log:info(n), + ?line del(File, No), + ?line file:delete(File), + ?line stop_node(Node), + ok. + +dist_error_open(suite) -> []; +dist_error_open(doc) -> + ["Open a log distributed and not distributed"]; +dist_error_open(Conf) when is_list(Conf) -> + ?line PrivDir = ?privdir(Conf), + ?line true = is_alive(), + + ?line Q = qlen(), + ?line File = filename:join(PrivDir, "bert.LOG"), + ?line File1 = filename:join(PrivDir, "bert1.LOG"), + ?line No = 3, + ?line file:delete(File), + ?line del(File, No), % cleanup + ?line del(File1, No), % cleanup + + ?line PA = filename:dirname(code:which(?MODULE)), + ?line {ok, Node} = start_node(disk_log, "-pa " ++ PA), + ?line wait_for_ready_net(), + + % open non-distributed on this node: + ?line {ok,n} = disk_log:open([{name, n}, {file, File}, + {type, wrap}, {size, {50, No}}]), + + % trying to open distributed on this node (error): + ?line {[],[Error1={ENode,{error,{node_already_open,n}}}]} = + disk_log:open([{name, n}, {file, File}, + {type, wrap}, {size, {50, No}}, + {distributed, [node()]}]), + ?line true = + lists:prefix(lists:flatten(io_lib:format("~p: The distribution", + [ENode])), + format_error(Error1)), + ?line ok = disk_log:lclose(n), + + % open distributed on this node: + ?line {[_],[]} = disk_log:open([{name, n}, {file, File}, + {type, wrap}, {size, {50, No}}, + {distributed, [node()]}]), + + % trying to open non-distributed on this node (error): + ?line {_,{node_already_open,n}} = + disk_log:open([{name, n}, {file, File}, + {type, wrap}, {size, {50, No}}]), + + ?line ok = disk_log:close(n), + ?line Q = qlen(), + + ?line del(File, No), + ?line del(File1, No), + ?line file:delete(File), + ?line stop_node(Node), + ok. + +dist_notify(suite) -> []; +dist_notify(doc) -> + ["Notification from other node"]; +dist_notify(Conf) when is_list(Conf) -> + ?line PrivDir = ?privdir(Conf), + ?line true = is_alive(), + + ?line File = filename:join(PrivDir, "bert.LOG"), + ?line File1 = filename:join(PrivDir, "bert1.LOG"), + ?line No = 3, + ?line B = mk_bytes(60), + ?line file:delete(File), + ?line file:delete(File1), + ?line del(File, No), % cleanup + ?line del(File1, No), + + ?line PA = filename:dirname(code:which(?MODULE)), + ?line {ok, Node} = start_node(disk_log, "-pa " ++ PA), + ?line wait_for_ready_net(), + + % opening distributed on this node: + ?line {[_],[]} = disk_log:open([{name, n}, {file, File}, {notify, false}, + {type, wrap}, {size, {50, No}}, + {distributed, [node()]}]), + + % opening distributed on other node: + ?line {[_],[]} = disk_log:open([{name, n}, {file, File1}, + {notify, true}, {linkto, self()}, + {type, wrap}, {size, {50, No}}, + {distributed, [Node]}]), + ?line disk_log:alog(n, B), + ?line disk_log:alog(n, B), + ?line ok = disk_log:sync(n), + ?line rec(1, {disk_log, Node, n, {wrap, 0}}), + ?line ok = disk_log:close(n), + + ?line del(File, No), + ?line del(File1, No), + ?line file:delete(File), + ?line stop_node(Node), + ok. + +dist_terminate(suite) -> []; +dist_terminate(doc) -> + ["Terminating nodes with distributed logs"]; +dist_terminate(Conf) when is_list(Conf) -> + ?line Dir = ?privdir(Conf), + ?line true = is_alive(), + + ?line File = filename:join(Dir, "n.LOG"), + ?line File1 = filename:join(Dir, "n1.LOG"), + No = 1, + del(File, No), % cleanup + del(File1, No), % cleanup + + ?line PA = filename:dirname(code:which(?MODULE)), + ?line {ok, Node} = start_node(disk_log, "-pa " ++ PA), + ?line wait_for_ready_net(), + + %% Distributed versions of two of the situations in close_block(/1. + + %% One of two owners terminates. + ?line Pid1 = spawn_link(?MODULE, lserv, [n]), + ?line Pid2 = spawn_link(?MODULE, lserv, [n]), + ?line {[{_, {ok, n}}], []} = sync_do(Pid1, {dist_open, File, node()}), + ?line {[{_, {ok, n}}], []} = sync_do(Pid2, {dist_open, File1, Node}), + ?line [_] = sync_do(Pid1, owners), + ?line [_] = sync_do(Pid2, owners), + ?line 0 = sync_do(Pid1, users), + ?line 0 = sync_do(Pid2, users), + ?line sync_do(Pid1, terminate), + ?line timer:sleep(500), + ?line [_] = sync_do(Pid2, owners), + ?line 0 = sync_do(Pid2, users), + ?line sync_do(Pid2, terminate), + ?line timer:sleep(500), + ?line {error, no_such_log} = disk_log:info(n), + + %% Users terminate (no link...). + ?line Pid3 = spawn_link(?MODULE, lserv, [n]), + ?line Pid4 = spawn_link(?MODULE, lserv, [n]), + ?line {[{_, {ok, n}}], []} = + sync_do(Pid3, {dist_open, File, none, node()}), + ?line {[{_, {ok, n}}], []} = + sync_do(Pid4, {dist_open, File1, none, Node}), + ?line [] = sync_do(Pid3, owners), + ?line [] = sync_do(Pid4, owners), + ?line 1 = sync_do(Pid3, users), + ?line 1 = sync_do(Pid4, users), + ?line sync_do(Pid3, terminate), + ?line [] = sync_do(Pid4, owners), + ?line 1 = sync_do(Pid4, users), + ?line sync_do(Pid4, terminate), + ?line ok = disk_log:close(n), % closing all nodes + ?line {error, no_such_log} = disk_log:info(n), + + ?line del(File, No), + ?line del(File1, No), + ?line stop_node(Node), + ok. + +dist_accessible(suite) -> []; +dist_accessible(doc) -> + ["Accessible logs on nodes"]; +dist_accessible(Conf) when is_list(Conf) -> + ?line PrivDir = ?privdir(Conf), + + ?line true = is_alive(), + + ?line F1 = filename:join(PrivDir, "a.LOG"), + ?line file:delete(F1), + ?line F2 = filename:join(PrivDir, "b.LOG"), + ?line file:delete(F2), + ?line F3 = filename:join(PrivDir, "c.LOG"), + ?line file:delete(F3), + ?line F4 = filename:join(PrivDir, "d.LOG"), + ?line file:delete(F1), + ?line F5 = filename:join(PrivDir, "e.LOG"), + ?line file:delete(F2), + ?line F6 = filename:join(PrivDir, "f.LOG"), + ?line file:delete(F3), + + ?line {[],[]} = disk_log:accessible_logs(), + ?line {ok, a} = disk_log:open([{name, a}, {type, halt}, {file, F1}]), + ?line {[a],[]} = disk_log:accessible_logs(), + ?line {ok, b} = disk_log:open([{name, b}, {type, halt}, {file, F2}]), + ?line {[a,b],[]} = disk_log:accessible_logs(), + ?line {ok, c} = disk_log:open([{name, c}, {type, halt}, {file, F3}]), + ?line {[a,b,c],[]} = disk_log:accessible_logs(), + + ?line PA = filename:dirname(code:which(?MODULE)), + ?line {ok, Node} = start_node(disk_log, "-pa " ++ PA), + ?line wait_for_ready_net(), + + ?line {[_],[]} = disk_log:open([{name, a}, {file, F4}, {type, halt}, + {distributed, [Node]}]), + ?line {[a,b,c],[]} = disk_log:accessible_logs(), + ?line {[],[a]} = rpc:call(Node, disk_log, accessible_logs, []), + ?line {[_],[]} = disk_log:open([{name, b}, {file, F5}, {type, halt}, + {distributed, [Node]}]), + ?line {[],[a,b]} = rpc:call(Node, disk_log, accessible_logs, []), + ?line {[_],[]} = disk_log:open([{name, c}, {file, F6}, {type, halt}, + {distributed, [Node]}]), + ?line {[],[a,b,c]} = rpc:call(Node, disk_log, accessible_logs, []), + ?line {[a,b,c],[]} = disk_log:accessible_logs(), + ?line ok = disk_log:close(a), + ?line {[b,c],[a]} = disk_log:accessible_logs(), + ?line ok = disk_log:close(b), + ?line {[c],[a,b]} = disk_log:accessible_logs(), + ?line ok = disk_log:close(b), + ?line {[c],[a]} = disk_log:accessible_logs(), + ?line {[],[a,c]} = rpc:call(Node, disk_log, accessible_logs, []), + ?line ok = disk_log:close(c), + ?line {[],[a,c]} = disk_log:accessible_logs(), + ?line ok = disk_log:close(c), + ?line {[],[a]} = disk_log:accessible_logs(), + ?line {[],[a]} = rpc:call(Node, disk_log, accessible_logs, []), + ?line ok = disk_log:close(a), + ?line {[],[]} = disk_log:accessible_logs(), + ?line {[],[]} = rpc:call(Node, disk_log, accessible_logs, []), + + ?line file:delete(F1), + ?line file:delete(F2), + ?line file:delete(F3), + ?line file:delete(F4), + ?line file:delete(F5), + ?line file:delete(F6), + + ?line stop_node(Node), + ok. + +dist_deadlock(suite) -> []; +dist_deadlock(doc) -> + ["OTP-4405. Deadlock between two nodes could happen."]; +dist_deadlock(Conf) when is_list(Conf) -> + ?line PrivDir = ?privdir(Conf), + + ?line true = is_alive(), + + ?line F1 = filename:join(PrivDir, "a.LOG"), + ?line file:delete(F1), + ?line F2 = filename:join(PrivDir, "b.LOG"), + ?line file:delete(F2), + + ?line PA = filename:dirname(code:which(?MODULE)), + ?line {ok, Node1} = start_node(disk_log_node1, "-pa " ++ PA), + ?line {ok, Node2} = start_node(disk_log_node2, "-pa " ++ PA), + ?line wait_for_ready_net(), + + Self = self(), + Fun1 = fun() -> dist_dl(Node2, a, F1, Self) end, + Fun2 = fun() -> dist_dl(Node1, b, F2, Self) end, + P1 = spawn(Node1, Fun1), + P2 = spawn(Node2, Fun2), + receive {P1, a} -> ok end, + receive {P2, b} -> ok end, + + ?line stop_node(Node1), + ?line stop_node(Node2), + + ?line file:delete(F1), + ?line file:delete(F2), + ok. + +dist_dl(Node, Name, File, Pid) -> + {[{Node,{ok,Log}}], []} = + disk_log:open([{name,Name},{file,File},{distributed,[Node]}]), + timer:sleep(50), % give the nodes chance to exchange pg2 information + ok = disk_log:close(Log), + Pid ! {self(), Name}, + ok. + +dist_open2(suite) -> []; +dist_open2(doc) -> + ["OTP-4480. Opening several logs simultaneously."]; +dist_open2(Conf) when is_list(Conf) -> + ?line true = is_alive(), + ?line {ok, _Pg2} = pg2:start(), + + dist_open2_1(Conf, 0), + dist_open2_1(Conf, 100), + + dist_open2_2(Conf, 0), + dist_open2_2(Conf, 100), + + PrivDir = ?privdir(Conf), + Log = n, + + %% Open a log three times (very fast). Two of the opening + %% processes will be put on hold (pending). The first one failes + %% to open the log. The second one succeeds, and the third one is + %% attached. + P0 = pps(), + ?line File0 = "n.LOG", + ?line File = filename:join(PrivDir, File0), + ?line make_file(PrivDir, File0, 8), + + Parent = self(), + F1 = fun() -> R = disk_log:open([{name, Log}, {file, File}, + {type, halt}, {format,internal}, + {distributed, [node()]}]), + Parent ! {self(), R} + end, + F2 = fun() -> R = disk_log:open([{name, Log}, {file, File}, + {type, halt}, {format,external}, + {distributed, [node()]}]), + Parent ! {self(), R}, + timer:sleep(300) + end, + ?line Pid1 = spawn(F1), + timer:sleep(10), + ?line Pid2 = spawn(F2), + ?line Pid3 = spawn(F2), + + ?line receive {Pid1,R1} -> {[],[_]} = R1 end, + ?line receive {Pid2,R2} -> {[_],[]} = R2 end, + ?line receive {Pid3,R3} -> {[_],[]} = R3 end, + + timer:sleep(500), + ?line file:delete(File), + ?line true = (P0 == pps()), + + %% This time the first process has a naughty head_func. This test + %% does not add very much. Perhaps it should be removed. However, + %% a head_func like this is why it's necessary to have an separate + %% process calling disk_log:internal_open: the server cannot wait + %% for the reply, but the call must be monitored, and this is what + %% is accomplished by having a proxy process. + F3 = fun() -> + R = disk_log:open([{name,Log},{file,File}, + {format,internal}, + {head_func,{?MODULE,head_exit,[]}}, + {type,halt}, {linkto,none}]), + Parent ! {self(), R} + end, + F4 = fun() -> + R = disk_log:open([{name,Log},{file,File}, + {format,internal}, + {type,halt}]), + Parent ! {self(), R} + end, + ?line Pid4 = spawn(F3), + timer:sleep(10), + ?line Pid5 = spawn(F4), + ?line Pid6 = spawn(F4), + %% The timing is crucial here. + ?line R = case receive {Pid4,R4} -> R4 end of + {error, no_such_log} -> + ?line R5 = receive {Pid5, R5a} -> R5a end, + ?line R6 = receive {Pid6, R6a} -> R6a end, + case {R5, R6} of + {{repaired, _, _, _}, {ok, Log}} -> ok; + {{ok, Log}, {repaired, _, _, _}} -> ok; + _ -> test_server_fail({bad_replies, R5, R6}) + end, + ok; + {ok, Log} -> % uninteresting case + ?line receive {Pid5,_R5} -> ok end, + ?line receive {Pid6,_R6} -> ok end, + {comment, + "Timing dependent test did not check anything."} + end, + + timer:sleep(100), + ?line {error, no_such_log} = disk_log:close(Log), + file:delete(File), + ?line true = (P0 == pps()), + + No = 2, + Log2 = n2, + File2 = filename:join(PrivDir, "b.LOG"), + file:delete(File2), + del(File, No), + + %% If a client takes a long time when writing the header, other + %% processes should be able to attach to other log without having to + %% wait. + + ?line {ok,Log} = + disk_log:open([{name,Log},{file,File},{type,wrap},{size,{100,No}}]), + Pid = spawn(fun() -> + receive {HeadPid, start} -> ok end, + {ok,Log2} = disk_log:open([{name,Log2},{file,File2}, + {type,halt}]), + HeadPid ! {self(), done} + end), + HeadFunc = {?MODULE, slow_header, [Pid]}, + ?line ok = disk_log:change_header(Log, {head_func, HeadFunc}), + ?line ok = disk_log:inc_wrap_file(Log), % header is written + + timer:sleep(100), + ?line ok = disk_log:close(Log), + + file:delete(File2), + del(File, No), + ?line true = (P0 == pps()), + + R. + +dist_open2_1(Conf, Delay) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "n.LOG"), + Log = n, + + A0 = [{name,Log},{file,File},{type,halt}], + ?line create_opened_log(File, A0), + P0 = pps(), + + Log2 = log2, + File2 = "log2.LOG", + ?line file:delete(File2), + ?line {ok,Log2} = disk_log:open([{name,Log2},{file,File2},{type,halt}]), + + Parent = self(), + F = fun() -> + R = disk_log:open(A0), + timer:sleep(Delay), + Parent ! {self(), R} + end, + ?line Pid1 = spawn(F), + timer:sleep(10), + ?line Pid2 = spawn(F), + ?line Pid3 = spawn(F), + ?line {error, no_such_log} = disk_log:log(Log, term), % is repairing now + ?line 0 = qlen(), + + %% The file is already open, so this will not take long. + ?line {ok,Log2} = disk_log:open([{name,Log2},{file,File2},{type,halt}]), + ?line 0 = qlen(), % still repairing + ?line ok = disk_log:close(Log2), + ?line {error, no_such_log} = disk_log:close(Log2), + ?line file:delete(File2), + + ?line receive {Pid1,R1} -> {repaired,_,_,_} = R1 end, + ?line receive {Pid2,R2} -> {ok,_} = R2 end, + ?line receive {Pid3,R3} -> {ok,_} = R3 end, + timer:sleep(500), + ?line {error, no_such_log} = disk_log:info(Log), + + file:delete(File), + ?line true = (P0 == pps()), + + ok. + +dist_open2_2(Conf, Delay) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "n.LOG"), + Log = n, + + ?line PA = filename:dirname(code:which(?MODULE)), + ?line {ok, Node1} = start_node(disk_log_node2, "-pa " ++ PA), + ?line wait_for_ready_net(), + P0 = pps(), + + A0 = [{name,Log},{file,File},{type,halt}], + ?line create_opened_log(File, A0), + + Log2 = log2, + File2 = "log2.LOG", + ?line file:delete(File2), + ?line {[{Node1,{ok,Log2}}],[]} = + disk_log:open([{name,Log2},{file,File2},{type,halt}, + {distributed,[Node1]}]), + + Parent = self(), + F = fun() -> + %% It would be nice to slow down the repair. head_func + %% cannot be used since it is not called when repairing. + R = disk_log:open([{distributed,[Node1]} | A0]), + timer:sleep(Delay), + Parent ! {self(), R} + end, + %% And {priority, ...} probably has no effect either. + ?line Pid1 = spawn_opt(F, [{priority, low}]), + % timer:sleep(1), % no guarantee that Pid1 will return {repaired, ...} + ?line Pid2 = spawn_opt(F, [{priority, low}]), + ?line {error, no_such_log} = + disk_log:log(Log, term), % maybe repairing now + ?line 0 = qlen(), + + %% The file is already open, so this will not take long. + ?line {[{Node1,{ok,Log2}}],[]} = + disk_log:open([{name,Log2},{file,File2},{type,halt}, + {distributed,[Node1]}]), + ?line 0 = qlen(), % probably still repairing + ?line ok = disk_log:close(Log2), + ?line file:delete(File2), + + ?line receive {Pid1,R1} -> R1 end, + ?line receive {Pid2,R2} -> R2 end, + ?line case {R1, R2} of + {{[{Node1,{repaired,_,_,_}}],[]}, + {[{Node1,{ok,Log}}],[]}} -> ok; + {{[{Node1,{ok,Log}}],[]}, + {[{Node1,{repaired,_,_,_}}],[]}} -> ok + end, + + ?line true = (P0 == pps()), + ?line stop_node(Node1), + file:delete(File), + ok. + +head_exit() -> + process_flag(trap_exit, false), % Don't do like this! + spawn_link(fun() -> exit(helfel) end), + {ok,"123"}. + +slow_header(Pid) -> + Pid ! {self(), start}, + receive {Pid, done} -> ok end, + {ok, <<>>}. + +create_opened_log(File, Args) -> + Log = n, + file:delete(File), + {ok, Log} = disk_log:open(Args), + log_terms(Log, 400000), + ok = disk_log:close(Log), + mark(File, ?OPENED), + ok. + +log_terms(_Log, 0) -> + ok; +log_terms(Log, N) when N > 100 -> + Terms = [{term,I} || I <- lists:seq(N-99, N)], + ok = disk_log:log_terms(Log, Terms), + log_terms(Log, N-100); +log_terms(Log, N) -> + ok = disk_log:log(Log, {term, N}), + log_terms(Log, N-1). + +other_groups(suite) -> []; +other_groups(doc) -> + ["OTP-5810. Cope with pg2 groups that are not disk logs."]; +other_groups(Conf) when is_list(Conf) -> + ?line true = is_alive(), + ?line PrivDir = ?privdir(Conf), + + ?line File = filename:join(PrivDir, "n.LOG"), + ?line file:delete(File), + + ?line {[],[]} = disk_log:accessible_logs(), + ?line {[_],[]} = disk_log:open([{name, n}, {file, File}, {type, halt}, + {distributed, [node()]}]), + ?line {[],[n]} = disk_log:accessible_logs(), + Group = grupp, + ?line pg2:create(Group), + ?line ok = pg2:join(Group, self()), + ?line {[],[n]} = disk_log:accessible_logs(), + ?line [_] = + lists:filter(fun(P) -> disk_log:pid2name(P) =/= undefined end, + erlang:processes()), + ?line pg2:delete(Group), + ?line {[],[n]} = disk_log:accessible_logs(), + ?line ok = disk_log:close(n), + ?line {[],[]} = disk_log:accessible_logs(), + ?line file:delete(File), + + ok. + +-define(MAX, 16384). % MAX in disk_log_1.erl +evil(suite) -> []; +evil(doc) -> ["Evil cases such as closed file descriptor port."]; +evil(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "n.LOG"), + Log = n, + + %% Not a very thorough test. + + ?line ok = setup_evil_filled_cache_wrap(Log, Dir), + ?line {error, {file_error,_,einval}} = disk_log:log(Log, apa), + ?line ok = disk_log:close(Log), + + ?line ok = setup_evil_filled_cache_halt(Log, Dir), + ?line {error, {file_error,_,einval}} = disk_log:truncate(Log, apa), + ?line ok = stop_evil(Log), + + %% White box test. + file:delete(File), + ?line Ports0 = erlang:ports(), + ?line {ok, Log} = disk_log:open([{name,Log},{file,File},{type,halt}, + {size,?MAX+50},{format,external}]), + ?line [Fd] = erlang:ports() -- Ports0, + ?line {B,_} = x_mk_bytes(30), + ?line ok = disk_log:blog(Log, <<0:(?MAX+1)/unit:8>>), + ?line exit(Fd, kill), + ?line {error, {file_error,_,einval}} = disk_log:blog_terms(Log, [B,B]), + ?line ok= disk_log:close(Log), + file:delete(File), + + ?line ok = setup_evil_wrap(Log, Dir), + ?line {error, {file_error,_,einval}} = disk_log:close(Log), + + ?line ok = setup_evil_wrap(Log, Dir), + ?line {error, {file_error,_,einval}} = disk_log:log(Log, apa), + ?line ok = stop_evil(Log), + + ?line ok = setup_evil_halt(Log, Dir), + ?line {error, {file_error,_,einval}} = disk_log:log(Log, apa), + ?line ok = stop_evil(Log), + + ?line ok = setup_evil_wrap(Log, Dir), + ?line {error, {file_error,_,einval}} = disk_log:reopen(Log, apa), + ?line {error, {file_error,_,einval}} = disk_log:reopen(Log, apa), + ?line ok = stop_evil(Log), + + ?line ok = setup_evil_wrap(Log, Dir), + ?line {error, {file_error,_,einval}} = disk_log:reopen(Log, apa), + ?line ok = stop_evil(Log), + + ?line ok = setup_evil_wrap(Log, Dir), + ?line {error, {file_error,_,einval}} = disk_log:inc_wrap_file(Log), + ?line ok = stop_evil(Log), + + ?line ok = setup_evil_wrap(Log, Dir), + ?line {error, {file_error,_,einval}} = disk_log:chunk(Log, start), + ?line ok = stop_evil(Log), + + ?line ok = setup_evil_wrap(Log, Dir), + ?line {error, {file_error,_,einval}} = disk_log:truncate(Log), + ?line ok = stop_evil(Log), + + ?line ok = setup_evil_wrap(Log, Dir), + ?line {error, {file_error,_,einval}} = disk_log:chunk_step(Log, start, 1), + ?line ok = stop_evil(Log), + + io:format("messages: ~p~n", [erlang:process_info(self(), messages)]), + del(File, 2), + file:delete(File), + ok. + +setup_evil_wrap(Log, Dir) -> + setup_evil(Log, [{type,wrap},{size,{100,2}}], Dir). + +setup_evil_halt(Log, Dir) -> + setup_evil(Log, [{type,halt},{size,10000}], Dir). + +setup_evil(Log, Args, Dir) -> + File = filename:join(Dir, lists:concat([Log, ".LOG"])), + file:delete(File), + del(File, 2), + ok = disk_log:start(), + Ports0 = erlang:ports(), + {ok, Log} = disk_log:open([{name,Log},{file,File} | Args]), + [Fd] = erlang:ports() -- Ports0, + exit(Fd, kill), + ok = disk_log:log_terms(n, [<<0:10/unit:8>>]), + timer:sleep(2500), % TIMEOUT in disk_log_1.erl is 2000 + ok. + +stop_evil(Log) -> + {error, _} = disk_log:close(Log), + ok. + +setup_evil_filled_cache_wrap(Log, Dir) -> + setup_evil_filled_cache(Log, [{type,wrap},{size,{?MAX,2}}], Dir). + +setup_evil_filled_cache_halt(Log, Dir) -> + setup_evil_filled_cache(Log, [{type,halt},{size,infinity}], Dir). + +%% The cache is filled, and the file descriptor port gone. +setup_evil_filled_cache(Log, Args, Dir) -> + File = filename:join(Dir, lists:concat([Log, ".LOG"])), + file:delete(File), + del(File, 2), + ok = disk_log:start(), + Ports0 = erlang:ports(), + {ok, Log} = disk_log:open([{name,Log},{file,File} | Args]), + [Fd] = erlang:ports() -- Ports0, + ok = disk_log:log_terms(n, [<<0:?MAX/unit:8>>]), + exit(Fd, kill), + ok. + +otp_6278(suite) -> []; +otp_6278(doc) -> ["OTP-6278. open/1 creates no status or crash report."]; +otp_6278(Conf) when is_list(Conf) -> + Dir = ?privdir(Conf), + File = filename:join(Dir, "no_such_dir/no_such_file"), + ?line error_logger:add_report_handler(?MODULE, self()), + ?line {error, {file_error, _, _}} = + disk_log:open([{name,n},{file,File}]), + receive + {crash_report,_Pid,Report} -> + ?line io:format("Unexpected: ~p\n", [Report]), + ?line ?t:fail() + after 1000 -> + ok + end, + ?line error_logger:delete_report_handler(?MODULE). + +mark(FileName, What) -> + {ok,Fd} = file:open(FileName, [raw, binary, read, write]), + {ok,_} = file:position(Fd, 4), + ok = file:write(Fd, What), + ok = file:close(Fd). + +crash(File, Where) -> + {ok, Fd} = file:open(File, read_write), + file:position(Fd, Where), + ok = file:write(Fd, [10]), + ok = file:close(Fd). + +unwritable(Fname) -> + {ok, Info} = file:read_file_info(Fname), + Mode = Info#file_info.mode - 8#00200, + file:write_file_info(Fname, Info#file_info{mode = Mode}). + +writable(Fname) -> + {ok, Info} = file:read_file_info(Fname), + Mode = Info#file_info.mode bor 8#00200, + file:write_file_info(Fname, Info#file_info{mode = Mode}). + +truncate(File, Where) -> + {ok, Fd} = file:open(File, read_write), + file:position(Fd, Where), + ok = file:truncate(Fd), + ok = file:close(Fd). + +file_size(File) -> + {ok, F} = file:read_file_info(File), + F#file_info.size. + +copy_wrap_log(FromName, N, FromDir, ToDir) -> + copy_wrap_log(FromName, FromName, N, FromDir, ToDir). + +copy_wrap_log(FromName, ToName, N, FromDir, ToDir) -> + Fun = fun(E) -> + From = join(FromDir, io_lib:format("~s.~p", [FromName, E])), + To = join(ToDir, io_lib:format("~s.~p", [ToName, E])), + case file:read_file_info(From) of + {ok, _FileInfo} -> + copy_file(From, To); + _Else -> + ok + end + end, + Exts = [idx, siz | lists:seq(1, N)], + lists:foreach(Fun, Exts). + +-define(BUFSIZE, 8192). + +copy_file(Src, Dest) -> + % ?t:format("copying from ~p to ~p~n", [Src, Dest]), + {ok, InFd} = file:open(Src, [raw, binary, read]), + {ok, OutFd} = file:open(Dest, [raw, binary, write]), + ok = copy_file1(InFd, OutFd), + file:close(InFd), + file:close(OutFd), + ok = file:change_mode(Dest, 8#0666). + +copy_file1(InFd, OutFd) -> + case file:read(InFd, ?BUFSIZE) of + {ok, Bin} -> + ok = file:write(OutFd, Bin), + copy_file1(InFd, OutFd); + eof -> + ok + end. + + +join(A, B) -> + filename:nativename(filename:join(A, B)). + +add_ext(Name, Ext) -> + lists:concat([Name, ".", Ext]). + +log(_Name, 0) -> + ok; +log(Name, N) -> + ok = disk_log:log(Name, "this is a logged message number " ++ + integer_to_list(N)), + log(Name, N-1). + +format_error(E) -> + lists:flatten(disk_log:format_error(E)). + +pps() -> + timer:sleep(100), + {erlang:ports(), lists:filter(fun(P) -> erlang:is_process_alive(P) end, + processes())}. + +qlen() -> + {_, {_, N}} = lists:keysearch(message_queue_len, 1, process_info(self())), + N. + +owners(Log) -> +%% io:format("owners ~p~n", [info(Log, owners, -1)]), + info(Log, owners, -1). +users(Log) -> +%% io:format("users ~p~n", [info(Log, users, -1)]), + info(Log, users, -1). +status(Log) -> +%% io:format("status ~p~n", [info(Log, status, -1)]), + info(Log, status, -1). +distributed(Log) -> +%% io:format("distributed ~p~n", [info(Log, distributed, -1)]), + info(Log, distributed, -1). +no_items(Log) -> +%% io:format("no_items ~p~n", [info(Log, no_items, -1)]), + info(Log, no_items, -1). +no_written_items(Log) -> +%% io:format("no_written_items ~p~n", [info(Log, no_written_items, -1)]), + info(Log, no_written_items, -1). +sz(Log) -> +%% io:format("sz ~p~n", [info(Log, size, -1)]), + info(Log, size, -1). +curb(Log) -> +%% io:format("curb ~p~n", [info(Log, no_current_bytes, -1)]), + info(Log, no_current_bytes, -1). +curf(Log) -> +%% io:format("curf ~p~n", [info(Log, current_file, -1)]), + info(Log, current_file, -1). +cur_cnt(Log) -> +%% io:format("cur_cnt ~p~n", [info(Log, no_current_items, -1)]), + info(Log, no_current_items, -1). +no_overflows(Log) -> +%% io:format("no_overflows ~p~n", [info(Log, no_overflows, -1)]), + info(Log, no_overflows, -1). + +info(Log, What, Undef) -> + case lists:keysearch(What, 1, disk_log:info(Log)) of + {value, {What, Value}} -> Value; + false -> Undef + end. + +rec(0, _) -> + ok; +rec(N, Msg) -> + receive + Msg -> + rec(N-1, Msg) + after 100 -> + test_server_fail({no_msg, N, Msg}) + end. + +%% Copied from global_SUITE.erl. +-define(UNTIL(Seq), loop_until_true(fun() -> Seq end)). + +loop_until_true(Fun) -> + case Fun() of + true -> + ok; + _ -> + timer:sleep(1000), + loop_until_true(Fun) + end. + +wait_for_ready_net() -> + Nodes = lists:sort([node() | nodes()]), + ?UNTIL(begin + lists:all(fun(N) -> Nodes =:= get_known(N) end, Nodes) and + lists:all(fun(N) -> + LNs = rpc:call(N, erlang, nodes, []), + Nodes =:= lists:sort([N | LNs]) + end, Nodes) + end). + +get_known(Node) -> + case catch gen_server:call({global_name_server,Node}, get_known) of + {'EXIT', _} -> + [list, without, nodenames]; + Known -> + lists:sort([Node | Known]) + end. + +%% Copied from erl_distribution_SUITE.erl: +start_node(Name, Param) -> + ?t:start_node(Name, slave, [{args, Param}]). + +stop_node(Node) -> + ?t:stop_node(Node). + +%from(H, [H | T]) -> T; +%from(H, [_ | T]) -> from(H, T); +%from(_H, []) -> []. + + +%% Check for NFS cache size, this is called from init_per_testcase() and +%% makes different tests run depending on the size of the NFS cache on +%% VxWorks. Possibly this could be adopted to Windows too, but we seldom use +%% NFS when testing on windows, so I can find better things to do. +%% The port program used simply reads the nfsCacheSize variable on the board. +%% If the board is configured without NFS, the port program will fail to load +%% and this will return 0, which may or may not be the wrong thing to do. + +check_nfs(Config) -> + case (catch check_cache(Config)) of + N when is_integer(N) -> + N; + _ -> + 0 + end. + +check_cache(Config) -> + ?line Check = filename:join(?datadir(Config), "nfs_check"), + ?line P = open_port({spawn, Check}, [{line,100}, eof]), + ?line Size = receive + {P,{data,{eol,S}}} -> + list_to_integer(S) + after 1000 -> + erlang:display(got_timeout), + exit(timeout) + end, + ?line receive + {P, eof} -> + ok + end, + ?line P ! {self(), close}, + ?line receive + {P, closed} -> ok + end, + Size. + +skip_expand([]) -> + []; +skip_expand([Case | T]) -> + case (catch apply(?MODULE, Case, [suite])) of + {'EXIT', _} -> + [Case | skip_expand(T)]; + [] -> + [Case | skip_expand(T)]; + Res -> + skip_expand(Res) ++ skip_expand(T) + end. + + +skip_list(Config) -> + case check_nfs(Config) of + 0 -> + skip_expand(?SKIP_NO_CACHE); + _ -> + skip_expand(?SKIP_LARGE_CACHE) + end. + +should_skip(Test,Config) -> + case os:type() of + vxworks -> + lists:member(Test, skip_list(Config)); + _ -> + false + end. + +%%----------------------------------------------------------------- +%% The error_logger handler used. +%% (Copied from stdlib/test/proc_lib_SUITE.erl.) +%%----------------------------------------------------------------- +init(Tester) -> + {ok, Tester}. + +handle_event({error_report, _GL, {Pid, crash_report, Report}}, Tester) -> + Tester ! {crash_report, Pid, Report}, + {ok, Tester}; +handle_event(_Event, State) -> + {ok, State}. + +handle_info(_, State) -> + {ok, State}. + +handle_call(_Query, State) -> {ok, {error, bad_query}, State}. + +terminate(_Reason, State) -> + State. diff --git a/lib/kernel/test/disk_log_SUITE_data/Makefile.src b/lib/kernel/test/disk_log_SUITE_data/Makefile.src new file mode 100644 index 0000000000..cae2f23d29 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/Makefile.src @@ -0,0 +1,15 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROGS = nfs_check@exe@ + +all: $(PROGS) + +nfs_check@exe@: nfs_check@obj@ + $(LD) $(CROSSLDFLAGS) -o nfs_check nfs_check@obj@ @LIBS@ + +nfs_check@obj@: nfs_check.c + $(CC) -c -o nfs_check@obj@ $(CFLAGS) nfs_check.c + diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.1 b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.1 Binary files differnew file mode 100644 index 0000000000..4ab4382c54 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.1 diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.2 b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.2 Binary files differnew file mode 100644 index 0000000000..491f23d0a2 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.2 diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.3 b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.3 Binary files differnew file mode 100644 index 0000000000..d690c59365 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.3 diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.4 b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.4 Binary files differnew file mode 100644 index 0000000000..c61526e1b7 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.4 diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.idx b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.idx Binary files differnew file mode 100644 index 0000000000..1250cdcaf3 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/kurt.LOG.idx diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.1 b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.1 Binary files differnew file mode 100644 index 0000000000..4ab4382c54 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.1 diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.2 b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.2 Binary files differnew file mode 100644 index 0000000000..491f23d0a2 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.2 diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.3 b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.3 Binary files differnew file mode 100644 index 0000000000..d690c59365 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.3 diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.4 b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.4 Binary files differnew file mode 100644 index 0000000000..c61526e1b7 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.4 diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.idx b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.idx Binary files differnew file mode 100644 index 0000000000..2d3456e88d --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.idx diff --git a/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.siz b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.siz Binary files differnew file mode 100644 index 0000000000..dea523e149 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/kurt2.LOG.siz diff --git a/lib/kernel/test/disk_log_SUITE_data/nfs_check.c b/lib/kernel/test/disk_log_SUITE_data/nfs_check.c new file mode 100644 index 0000000000..31e9ba8190 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/nfs_check.c @@ -0,0 +1,46 @@ +/* + * Author: Patrik Nyblom + * Purpose: A port program to check the NFS cache size on VxWorks (returns 0 + * for other platforms). + */ + +#ifdef VXWORKS +#include <vxWorks.h> +#include <taskVarLib.h> +#include <taskLib.h> +#include <sysLib.h> +#include <string.h> +#include <ioLib.h> +#endif + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <errno.h> +#include <sys/types.h> +#include <sys/stat.h> +#include <fcntl.h> + +#ifdef VXWORKS +extern unsigned nfsCacheSize; +#define MAIN(argc, argv) nfs_check(argc, argv) +#else +#define MAIN(argc, argv) main(argc, argv) +#endif + + +MAIN(argc, argv) +int argc; +char *argv[]; +{ +#ifdef VXWORKS + char str[100]; + sprintf(str,"%d\n", nfsCacheSize); + write(1, str, strlen(str)); +#else + fprintf(stdout,"0"); + fflush(stdout); +#endif + return 0; +} + diff --git a/lib/kernel/test/disk_log_SUITE_data/old_terms.LOG b/lib/kernel/test/disk_log_SUITE_data/old_terms.LOG Binary files differnew file mode 100644 index 0000000000..fffd8c1679 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/old_terms.LOG diff --git a/lib/kernel/test/disk_log_SUITE_data/wrap_log_test.erl b/lib/kernel/test/disk_log_SUITE_data/wrap_log_test.erl new file mode 100644 index 0000000000..e5ff70fd49 --- /dev/null +++ b/lib/kernel/test/disk_log_SUITE_data/wrap_log_test.erl @@ -0,0 +1,184 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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% +%% +%%%---------------------------------------------------------------------- +%%% Purpose : Test wrap_log_reader.erl +%%%---------------------------------------------------------------------- + +-module(wrap_log_test). + +-export([init/0, stop/0]). +-define(fsize, 80). +-define(fno, 4). + +%-define(debug, true). + +-ifdef(debug). +-define(format(S, A), io:format(S, A)). +-else. +-define(format(S, A), ok). +-endif. + +init() -> + spawn(fun() -> start(logger) end), + spawn(fun() -> start2(wlt) end), + wait_registered(logger), + wait_registered(wlt), + ok. + +wait_registered(Name) -> + case whereis(Name) of + undefined -> + timer:sleep(100), + wait_registered(Name); + _Pid -> + ok + end. + +stop() -> + catch logger ! exit, + catch wlt ! exit, + wait_unregistered(logger), + wait_unregistered(wlt), + ok. + +wait_unregistered(Name) -> + case whereis(Name) of + undefined -> + ok; + _Pid -> + timer:sleep(100), + wait_unregistered(Name) + end. + +start(Name) -> + ?format("Starting ~p~n", [Name]), + register(Name, self()), + loop(). + +start2(Name) -> + ?format("Starting ~p~n", [Name]), + register(Name, self()), + loop2(eof, Name). + +loop() -> + receive + {open, Pid, Name, File} -> + R = disk_log:open([{name, Name}, {type, wrap}, {file, File}, + {size, {?fsize, ?fno}}]), + ?format("logger: open ~p -> ~p~n", [Name, R]), + Pid ! R, + loop(); + + {open_ext, Pid, Name, File} -> + R = disk_log:open([{name, Name}, {type, wrap}, {file, File}, + {format, external}, {size, {?fsize, ?fno}}]), + ?format("logger: open ~p -> ~p~n", [Name, R]), + Pid ! R, + loop(); + + {close, Pid, Name} -> + R = disk_log:close(Name), + ?format("logger: close ~p -> ~p~n", [Name, R]), + Pid ! R, + loop(); + + {sync, Pid, Name} -> + R = disk_log:sync(Name), + ?format("logger: sync ~p -> ~p~n", [Name, R]), + Pid ! R, + loop(); + + {log_terms, Pid, Name, Terms} -> + R = disk_log:log_terms(Name, Terms), + ?format("logger: log_terms ~p -> ~p~n", [Name, R]), + Pid ! R, + loop(); + + {blog_terms, Pid, Name, Terms} -> + R = disk_log:blog_terms(Name, Terms), + ?format("logger: blog_terms ~p -> ~p~n", [Name, R]), + Pid ! R, + loop(); + + exit -> + ?format("Stopping logger~n", []), + exit(normal); + + _Else -> + ?format("logger: ignored: ~p~n", [_Else]), + loop() + end. + +loop2(C, Wlt) -> + receive + {open, Pid, Name} -> + case wrap_log_reader:open(Name) of + {ok, R} -> + ?format("~p: open ~p -> ~p~n", [Wlt, Name, {ok, R}]), + Pid ! {ok, R}, + loop2(R, Wlt); + E -> + ?format("~p: open ~p -> ~p~n", [Wlt, Name, E]), + Pid ! E, + loop2(C, Wlt) + end; + + {open, Pid, Name, No} -> + case wrap_log_reader:open(Name, No) of + {ok, R} -> + ?format("~p: open ~p, file ~p -> ~p~n", + [Wlt, Name, No, {ok, R}]), + Pid ! {ok, R}, + loop2(R, Wlt); + E -> + ?format("~p: open ~p, file ~p -> ~p~n", + [Wlt, Name, No, E]), + Pid ! E, + loop2(C, Wlt) + end; + + {close, Pid, WR} -> + R = wrap_log_reader:close(WR), + ?format("~p: close -> ~p~n", [Wlt, R]), + Pid ! R, + loop2(eof, Wlt); + + {chunk, Pid, WR} -> + did_chunk(wrap_log_reader:chunk(WR), Pid, Wlt); + + {chunk, Pid, WR, N} -> + did_chunk(wrap_log_reader:chunk(WR, N), Pid, Wlt); + + exit -> + ?format("Stopping ~p~n", [Wlt]), + exit(normal); + + _Else -> + ?format("~p: ignored: ~p~n", [Wlt, _Else]), + loop2(C, Wlt) + end. + +did_chunk({C1, L}, Pid, Wlt) -> + ?format("~p: chunk -> ~p~n", [Wlt, {C1, L}]), + Pid ! {C1, L}, + loop2(C1, Wlt); +did_chunk({C1, L, _Bad}, Pid, Wlt) -> + ?format("~p: chunk -> ~p (bad)~n", [Wlt, {C1, L, _Bad}]), + Pid ! {C1, L}, + loop2(C1, Wlt). diff --git a/lib/kernel/test/erl_boot_server_SUITE.erl b/lib/kernel/test/erl_boot_server_SUITE.erl new file mode 100644 index 0000000000..241d68fef4 --- /dev/null +++ b/lib/kernel/test/erl_boot_server_SUITE.erl @@ -0,0 +1,338 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. 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(erl_boot_server_SUITE). + +-include("test_server.hrl"). + +-export([all/1]). + +-export([start/1, start_link/1, stop/1, add/1, delete/1, responses/1]). + +%%----------------------------------------------------------------- +%% Test suite for erl_boot_server. +%% +%% This module is mainly tested in the erl_prim_loader_SUITE, +%% but the interface functions are tested here. +%% +%% Changed for the new erl_boot_server for R3A by Bjorn Gustavsson. +%%----------------------------------------------------------------- + +all(suite) -> + [start, start_link, stop, add, delete, responses]. + +-define(all_ones, {255, 255, 255, 255}). + +start(doc) -> "Tests the erl_boot_server:start/1 function."; +start(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(50)), + ?line [Host1, Host2|_] = good_hosts(Config), + + %% Bad arguments. + BadHost = "bad__host", + ?line {error, {badarg, {}}} = erl_boot_server:start({}), + ?line {error, {badarg, atom}} = erl_boot_server:start(atom), + ?line {error, {badarg, [atom, BadHost]}} = + erl_boot_server:start([atom, BadHost]), + ?line {error, {badarg, [Host1, BadHost]}} = + erl_boot_server:start([Host1, BadHost]), + + %% Test once. + ?line {ok, Pid1} = erl_boot_server:start([Host1]), + ?line {error, {already_started, Pid1}} = + erl_boot_server:start([Host1]), + ?line exit(Pid1, kill), + + %% Test again. + test_server:sleep(1), + ?line {ok, Pid2} = erl_boot_server:start([Host1, Host2]), + ?line {error, {already_started, Pid2}} = + erl_boot_server:start([Host1, Host2]), + ?line exit(Pid2, kill), + test_server:sleep(1), + + ?line test_server:timetrap_cancel(Dog), + ok. + +start_link(doc) -> "Tests the erl_boot_server:start_link/1 function."; +start_link(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line [Host1, Host2|_] = good_hosts(Config), + + OldFlag = process_flag(trap_exit, true), + ?line {error, {badarg, {}}} = erl_boot_server:start_link({}), + ?line {error, {badarg, atom}} = erl_boot_server:start_link(atom), + ?line BadHost = "bad__host", + ?line {error, {badarg, [atom, BadHost]}} = + erl_boot_server:start_link([atom, BadHost]), + + ?line {ok, Pid1} = erl_boot_server:start_link([Host1]), + ?line {error, {already_started, Pid1}} = + erl_boot_server:start_link([Host1]), + ?line shutdown(Pid1), + + ?line {ok, Pid2} = erl_boot_server:start_link([Host1, Host2]), + ?line {error, {already_started, Pid2}} = + erl_boot_server:start_link([Host1, Host2]), + ?line shutdown(Pid2), + process_flag(trap_exit, OldFlag), + + ?line test_server:timetrap_cancel(Dog), + ok. + +stop(doc) -> "Tests that no processes are left if a boot server is killed."; +stop(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(50)), + ?line [Host1|_] = good_hosts(Config), + + %% Start a boot server and kill it. Make sure that any helper processes + %% dies. + % Make sure the inet_gethost_native server is already started, + % otherwise it will make this test fail: + ?line inet:getaddr(localhost, inet), + ?line Before = processes(), + ?line {ok, Pid} = erl_boot_server:start([Host1]), + ?line New = processes() -- [Pid|Before], + ?line exit(Pid, kill), + ?line receive after 100 -> ok end, + ?line case [P || P <- New, is_process_alive(P)] of + [] -> + ok; + NotKilled -> + test_server:fail({not_killed, NotKilled}) + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +add(doc) -> "Tests the erl_boot_server:add/1 function."; +add(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line OldFlag = process_flag(trap_exit, true), + ?line {ok, Pid1} = erl_boot_server:start_link([]), + ?line [] = erl_boot_server:which_slaves(), + ?line [Host1, Host2, Host3|_] = good_hosts(Config), + + %% Try bad values. + ?line {error, {badarg, {}}} = erl_boot_server:add_slave({}), + ?line {error, {badarg, [atom]}} = erl_boot_server:add_slave([atom]), + ?line BadHost = "bad__host", + ?line {error, {badarg, BadHost}} = erl_boot_server:add_slave(BadHost), + ?line [] = erl_boot_server:which_slaves(), + + %% Add good host names. + ?line {ok, Ip1} = inet:getaddr(Host1, inet), + ?line {ok, Ip2} = inet:getaddr(Host2, inet), + ?line {ok, Ip3} = inet:getaddr(Host3, inet), + ?line MIp1 = {?all_ones, Ip1}, + ?line MIp2 = {?all_ones, Ip2}, + ?line MIp3 = {?all_ones, Ip3}, + ?line ok = erl_boot_server:add_slave(Host1), + ?line [MIp1] = erl_boot_server:which_slaves(), + ?line ok = erl_boot_server:add_slave(Host2), + ?line M_Ip1_Ip2 = lists:sort([MIp1, MIp2]), + ?line M_Ip1_Ip2 = lists:sort(erl_boot_server:which_slaves()), + ?line ok = erl_boot_server:add_slave(Host3), + ?line M_Ip1_Ip2_Ip3 = lists:sort([MIp3|M_Ip1_Ip2]), + ?line M_Ip1_Ip2_Ip3 = erl_boot_server:which_slaves(), + + %% Add duplicate names. + ?line ok = erl_boot_server:add_slave(Host3), + ?line M_Ip1_Ip2_Ip3 = erl_boot_server:which_slaves(), + + %% More bad names. + ?line {error, {badarg, BadHost}} = erl_boot_server:add_slave(BadHost), + ?line M_Ip1_Ip2_Ip3 = erl_boot_server:which_slaves(), + + %% Cleanup. + ?line shutdown(Pid1), + ?line process_flag(trap_exit, OldFlag), + ?line test_server:timetrap_cancel(Dog), + ok. + +delete(doc) -> "Tests the erl_boot_server:delete/1 function."; +delete(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line OldFlag = process_flag(trap_exit, true), + + ?line [Host1, Host2, Host3|_] = good_hosts(Config), + ?line {ok, Ip1} = inet:getaddr(Host1, inet), + ?line {ok, Ip2} = inet:getaddr(Host2, inet), + ?line {ok, Ip3} = inet:getaddr(Host3, inet), + ?line MIp1 = {?all_ones, Ip1}, + ?line MIp2 = {?all_ones, Ip2}, + ?line MIp3 = {?all_ones, Ip3}, + + ?line {ok, Pid1} = erl_boot_server:start_link([Host1, Host2, Host3]), + ?line M_Ip123 = lists:sort([MIp1, MIp2, MIp3]), + ?line M_Ip123 = erl_boot_server:which_slaves(), + + %% Do some bad attempts and check that the list of slaves is intact. + ?line {error, {badarg, {}}} = erl_boot_server:delete_slave({}), + ?line {error, {badarg, [atom]}} = erl_boot_server:delete_slave([atom]), + ?line BadHost = "bad__host", + ?line {error, {badarg, BadHost}} = erl_boot_server:delete_slave(BadHost), + ?line M_Ip123 = erl_boot_server:which_slaves(), + + %% Delete Host2 and make sure it's gone. + ?line ok = erl_boot_server:delete_slave(Host2), + ?line M_Ip13 = lists:sort([MIp1, MIp3]), + ?line M_Ip13 = erl_boot_server:which_slaves(), + + ?line ok = erl_boot_server:delete_slave(Host1), + ?line [MIp3] = erl_boot_server:which_slaves(), + ?line ok = erl_boot_server:delete_slave(Host1), + ?line [MIp3] = erl_boot_server:which_slaves(), + + ?line {error, {badarg, BadHost}} = erl_boot_server:delete_slave(BadHost), + ?line [MIp3] = erl_boot_server:which_slaves(), + + ?line ok = erl_boot_server:delete_slave(Ip3), + ?line [] = erl_boot_server:which_slaves(), + ?line ok = erl_boot_server:delete_slave(Ip3), + ?line [] = erl_boot_server:which_slaves(), + + ?line shutdown(Pid1), + ?line process_flag(trap_exit, OldFlag), + ?line test_server:timetrap_cancel(Dog), + ok. + +responses(doc) -> "Tests erl_boot_server responses to slave requests."; +responses(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(30)), + ?line process_flag(trap_exit, true), + %% Copy from inet_boot.hrl + EBOOT_PORT = 4368, + EBOOT_REQUEST = "EBOOTQ", + EBOOT_REPLY = "EBOOTR", + + ?line {ok,Host} = inet:gethostname(), + ?line {ok,Ip} = inet:getaddr(Host, inet), + + ThisVer = erlang:system_info(version), + + ?line {ok,BootPid} = erl_boot_server:start_link([Host]), + + %% Send junk + ?line S1 = open_udp(), + ?line prim_inet:sendto(S1, Ip, EBOOT_PORT, ["0"]), + receive + What -> + ?line close_udp(S1), + ?line ?t:fail({"got unexpected response",What}) + after 100 -> + ok + end, + + %% Req from a slave with same erlang vsn. + ?line S2 = open_udp(), + ?line prim_inet:sendto(S2, Ip, EBOOT_PORT, [EBOOT_REQUEST,ThisVer]), + receive + {udp,S2,Ip,_Port1,Resp1} -> + ?line close_udp(S2), + ?line EBOOT_REPLY = string:substr(Resp1, 1, length(EBOOT_REPLY)), + ?line Rest1 = string:substr(Resp1, length(EBOOT_REPLY)+1, length(Resp1)), + ?line [_,_,_ | ThisVer] = Rest1 + after 2000 -> + ?line close_udp(S2), + ?line ?t:fail("no boot server response; same vsn") + end, + + %% Req from a slave with other erlang vsn. + ?line S3 = open_udp(), + ?line prim_inet:sendto(S3, Ip, EBOOT_PORT, [EBOOT_REQUEST,"1.0"]), + receive + Anything -> + ?line close_udp(S3), + ?line ?t:fail({"got unexpected response",Anything}) + after 100 -> + ok + end, + + %% Kill the boot server and wait for it to disappear. + ?line unlink(BootPid), + ?line BootPidMref = erlang:monitor(process, BootPid), + ?line exit(BootPid, kill), + receive + {'DOWN',BootPidMref,_,_,_} -> ok + end, + + ?line {ok,BootPid2} = erl_boot_server:start_link(["127.0.0.1"]), + + %% Req from slave with invalid ip address. + ?line S4 = open_udp(), + Ret = + case Ip of + {127,0,0,1} -> + {comment,"IP address for this host is 127.0.0.1"}; + _ -> + ?line prim_inet:sendto(S4, Ip, EBOOT_PORT, + [EBOOT_REQUEST,ThisVer]), + receive + Huh -> + ?line close_udp(S4), + ?line ?t:fail({"got unexpected response",Huh}) + after 100 -> + ok + end + end, + + ?line unlink(BootPid2), + ?line exit(BootPid2, kill), + + %% Now wait for any late unexpected messages. + receive + Whatever -> + ?line ?t:fail({unexpected_message,Whatever}) + after 4000 -> + ?line close_udp(S1), + ?line close_udp(S3), + ?line close_udp(S4), + ok + end, + + ?line test_server:timetrap_cancel(Dog), + Ret. + +shutdown(Pid) -> + exit(Pid, shutdown), + receive + {'EXIT', Pid, shutdown} -> + ok + after 1000 -> + %% The timeout used to be 1 ms, which could be too short time for the + %% SMP emulator on a slow computer with one CPU. + test_server:fail(shutdown) + end. + +good_hosts(_Config) -> + %% XXX The hostnames should not be hard-coded like this. Really! + + {ok, GoodHost1} = inet:gethostname(), + GoodHost2 = "gandalf", + GoodHost3 = "sauron", + [GoodHost1, GoodHost2, GoodHost3]. + +open_udp() -> + ?line {ok, S} = prim_inet:open(udp, inet), + ?line ok = prim_inet:setopts(S, [{mode,list},{active,true}, + {deliver,term},{broadcast,true}]), + ?line {ok,_} = prim_inet:bind(S, {0,0,0,0}, 0), + S. + +close_udp(S) -> + prim_inet:close(S). diff --git a/lib/kernel/test/erl_distribution_SUITE.erl b/lib/kernel/test/erl_distribution_SUITE.erl new file mode 100644 index 0000000000..8f2e2512e0 --- /dev/null +++ b/lib/kernel/test/erl_distribution_SUITE.erl @@ -0,0 +1,1235 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. 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(erl_distribution_SUITE). + +%-define(line_trace, 1). +-include("test_server.hrl"). + +-export([all/1]). + +-export([tick/1, tick_change/1, illegal_nodenames/1, hidden_node/1, + table_waste/1, net_setuptime/1, + monitor_nodes/1, + monitor_nodes_nodedown_reason/1, + monitor_nodes_complex_nodedown_reason/1, + monitor_nodes_node_type/1, + monitor_nodes_misc/1, + monitor_nodes_otp_6481/1, + monitor_nodes_errors/1, + monitor_nodes_combinations/1, + monitor_nodes_cleanup/1, + monitor_nodes_many/1]). + +%% Performs the test at another node. +-export([tick_cli_test/1, tick_cli_test1/1, + tick_serv_test/2, tick_serv_test1/1, + keep_conn/1, time_ping/1]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +-export([start_node/2]). + +-export([pinger/1]). + + +-define(DUMMY_NODE,dummy@test01). + +%%----------------------------------------------------------------- +%% The distribution is mainly tested in the big old test_suite. +%% This test only tests the net_ticktime configuration flag. +%% Should be started in a CC view with: +%% erl -sname master -rsh ctrsh +%%----------------------------------------------------------------- + +all(suite) -> + [tick, tick_change, illegal_nodenames, hidden_node, + table_waste, net_setuptime, + monitor_nodes]. + +init_per_testcase(Func, Config) when atom(Func), list(Config) -> + Dog=?t:timetrap(?t:minutes(4)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +tick(suite) -> []; +tick(doc) -> []; +tick(Config) when list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(120)), + PaDir = filename:dirname(code:which(erl_distribution_SUITE)), + + %% First check that the normal case is OK! + ?line {ok, Node} = start_node(dist_test, "-pa " ++ PaDir), + rpc:call(Node, erl_distribution_SUITE, tick_cli_test, [node()]), + + erlang:monitor_node(Node, true), + receive + {nodedown, Node} -> + test_server:fail("nodedown from other node") + after 30000 -> + erlang:monitor_node(Node, false), + stop_node(Node) + end, + + %% Now, set the net_ticktime for the other node to 12 secs. + %% After the sleep(2sec) and cast the other node shall destroy + %% the connection as it has not received anything on the connection. + %% The nodedown message should arrive within 8 < T < 16 secs. + + %% We must have two slave nodes as the slave mechanism otherwise + %% halts the client node after tick timeout (the connection is down + %% and the slave node decides to halt !! + + %% Set the ticktime on the server node to 100 secs so the server + %% node doesn't tick the client node within the interval ... + + ?line {ok, ServNode} = start_node(dist_test_server, + "-kernel net_ticktime 100 " + "-pa " ++ PaDir), + rpc:call(ServNode, erl_distribution_SUITE, tick_serv_test, [Node, node()]), + + ?line {ok, _} = start_node(dist_test, + "-kernel net_ticktime 12 " + "-pa " ++ PaDir), + rpc:call(Node, erl_distribution_SUITE, tick_cli_test, [ServNode]), + + spawn_link(erl_distribution_SUITE, keep_conn, [Node]), + + {tick_serv, ServNode} ! {i_want_the_result, self()}, + + monitor_node(ServNode, true), + monitor_node(Node, true), + + receive + {tick_test, T} when integer(T) -> + stop_node(ServNode), + stop_node(Node), + T; + {tick_test, Error} -> + stop_node(ServNode), + stop_node(Node), + test_server:fail(Error); + {nodedown, Node} -> + stop_node(ServNode), + test_server:fail("client node died"); + {nodedown, ServNode} -> + stop_node(Node), + test_server:fail("server node died") + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +table_waste(doc) -> + ["Checks that pinging nonexistyent nodes does not waste space in distribution table"]; +table_waste(suite) -> + []; +table_waste(Config) when list(Config) -> + ?line {ok, HName} = inet:gethostname(), + F = fun(0,_F) -> []; + (N,F) -> + ?line Name = list_to_atom("erl_distribution_"++integer_to_list(N)++ + "@"++HName), + ?line pang = net_adm:ping(Name), + ?line F(N-1,F) + end, + ?line F(256,F), + ?line {ok, N} = start_node(erl_distribution_300,""), + ?line stop_node(N), + ok. + + + +illegal_nodenames(doc) -> + ["Test that pinging an illegal nodename does not kill the node"]; +illegal_nodenames(suite) -> + []; +illegal_nodenames(Config) when list(Config) -> + ?line Dog=?t:timetrap(?t:minutes(2)), + PaDir = filename:dirname(code:which(erl_distribution_SUITE)), + ?line {ok, Node}=start_node(illegal_nodenames, "-pa " ++ PaDir), + monitor_node(Node, true), + ?line RPid=rpc:call(Node, erlang, spawn, + [?MODULE, pinger, [self()]]), + receive + {RPid, pinged} -> + ok; + {nodedown, Node} -> + ?t:fail("Remote node died.") + end, + stop_node(Node), + ?t:timetrap_cancel(Dog), + ok. + +pinger(Starter) -> + io:format("Starter:~p~n",[Starter]), + net_adm:ping(a@b@c), + Starter ! {self(), pinged}, + ok. + + +net_setuptime(doc) -> ["Test that you can set the net_setuptime properly"]; +net_setuptime(Config) when is_list(Config) -> + %% In this test case, we reluctantly accept shorter times than the given + %% setup time, because the connection attempt can end in a + %% "Host unreachable" error before the timeout fires. + + Res0 = do_test_setuptime("2"), + io:format("Res0 = ~p", [Res0]), + ?line true = (Res0 =< 4000), + Res1 = do_test_setuptime("0.3"), + io:format("Res1 = ~p", [Res1]), + ?line true = (Res1 =< 500), + ok. + +do_test_setuptime(Setuptime) when is_list(Setuptime) -> + ?line PaDir = filename:dirname(code:which(?MODULE)), + ?line {ok, Node} = start_node(dist_setuptime_test, "-pa " ++ PaDir ++ + " -kernel net_setuptime " ++ Setuptime), + ?line Res = rpc:call(Node,?MODULE,time_ping,[?DUMMY_NODE]), + ?line stop_node(Node), + Res. + +time_ping(Node) -> + T0 = erlang:now(), + pang = net_adm:ping(Node), + T1 = erlang:now(), + time_diff(T0,T1). + + +%% Keep the connection with the client node up. +%% This is neccessary as the client node runs with much shorter +%% tick time !! +keep_conn(Node) -> + sleep(1), + rpc:cast(Node, erlang, time, []), + keep_conn(Node). + +tick_serv_test(Node, MasterNode) -> + spawn(erl_distribution_SUITE, keep_conn, [MasterNode]), + spawn(erl_distribution_SUITE, tick_serv_test1, [Node]). + +tick_serv_test1(Node) -> + register(tick_serv, self()), + TestServer = receive {i_want_the_result, TS} -> TS end, + monitor_node(Node, true), + receive + {nodedown, Node} -> + net_adm:ping(Node), %% Set up the connection again !! + + {tick_test, Node} ! {whats_the_result, self()}, + receive + {tick_test, Res} -> + TestServer ! {tick_test, Res} + end + end. + +tick_cli_test(Node) -> + spawn(erl_distribution_SUITE, tick_cli_test1, [Node]). + +tick_cli_test1(Node) -> + register(tick_test, self()), + erlang:monitor_node(Node, true), + sleep(2), + rpc:call(Node, erlang, time, []), %% simulate action on the connection + T1 = now(), + receive + {nodedown, Node} -> + T2 = now(), + receive + {whats_the_result, From} -> + case time_diff(T1, T2) of + T when T > 8000, T < 16000 -> + From ! {tick_test, T}; + T -> + From ! {tick_test, + {"T not in interval 8000 < T < 16000", + T}} + end + end + end. + + +tick_change(doc) -> ["OTP-4255"]; +tick_change(suite) -> []; +tick_change(Config) when list(Config) -> + ?line PaDir = filename:dirname(code:which(?MODULE)), + ?line [BN, CN] = get_nodenames(2, tick_change), + ?line DefaultTT = net_kernel:get_net_ticktime(), + ?line case DefaultTT of + I when integer(I) -> ?line ok; + _ -> ?line ?t:fail(DefaultTT) + end, + + % In case other nodes are connected + case nodes(connected) of + [] -> ?line net_kernel:set_net_ticktime(10, 0); + _ -> ?line rpc:multicall(nodes([this, connected]), net_kernel, + set_net_ticktime, [10, 5]) + end, + + ?line wait_until(fun () -> 10 == net_kernel:get_net_ticktime() end), + ?line {ok, B} = start_node(BN, "-kernel net_ticktime 10 -pa " ++ PaDir), + ?line {ok, C} = start_node(CN, "-kernel net_ticktime 10 -hidden -pa " + ++ PaDir), + + ?line OTE = process_flag(trap_exit, true), + case catch begin + ?line run_tick_change_test(B, C, 10, 1, PaDir), + ?line run_tick_change_test(B, C, 1, 10, PaDir) + end of + {'EXIT', Reason} -> + ?line stop_node(B), + ?line stop_node(C), + %% In case other nodes are connected + case nodes(connected) of + [] -> ?line net_kernel:set_net_ticktime(DefaultTT, 0); + _ -> ?line rpc:multicall(nodes([this, connected]), net_kernel, + set_net_ticktime, [DefaultTT, 10]) + end, + ?line wait_until(fun () -> + DefaultTT == net_kernel:get_net_ticktime() + end), + ?line process_flag(trap_exit, OTE), + ?t:fail(Reason); + _ -> + ok + end, + ?line process_flag(trap_exit, OTE), + ?line stop_node(B), + ?line stop_node(C), + + % In case other nodes are connected + case nodes(connected) of + [] -> ?line net_kernel:set_net_ticktime(DefaultTT, 0); + _ -> ?line rpc:multicall(nodes([this, connected]), net_kernel, + set_net_ticktime, [DefaultTT, 5]) + end, + + ?line wait_until(fun () -> DefaultTT == net_kernel:get_net_ticktime() end), + ?line ok. + + +wait_for_nodedowns(Tester, Ref) -> + receive + {nodedown, Node} -> + ?t:format("~p~n", [{node(), {nodedown, Node}}]), + ?line Tester ! {Ref, {node(), {nodedown, Node}}} + end, + wait_for_nodedowns(Tester, Ref). + +run_tick_change_test(B, C, PrevTT, TT, PaDir) -> + ?line [DN, EN] = get_nodenames(2, tick_change), + + ?line Tester = self(), + ?line Ref = make_ref(), + ?line MonitorNodes = fun (Nodes) -> + ?line lists:foreach( + fun (N) -> + ?line monitor_node(N,true) + end, + Nodes), + wait_for_nodedowns(Tester, Ref) + end, + + ?line {ok, D} = start_node(DN, "-kernel net_ticktime " + ++ integer_to_list(PrevTT) ++ " -pa " ++ PaDir), + + ?line NMA = spawn_link(fun () -> MonitorNodes([B, C, D]) end), + ?line NMB = spawn_link(B, fun () -> MonitorNodes([node(), C, D]) end), + ?line NMC = spawn_link(C, fun () -> MonitorNodes([node(), B, D]) end), + + ?line MaxTT = case PrevTT > TT of + true -> ?line PrevTT; + false -> ?line TT + end, + + ?line CheckResult = make_ref(), + ?line spawn_link(fun () -> + receive + after (25 + MaxTT)*1000 -> + Tester ! CheckResult + end + end), + + % In case other nodes than these are connected + case nodes(connected) -- [B, C, D] of + [] -> ?line ok; + OtherNodes -> ?line rpc:multicall(OtherNodes, net_kernel, + set_net_ticktime, [TT, 20]) + end, + + ?line change_initiated = net_kernel:set_net_ticktime(TT,20), + ?line sleep(3), + ?line change_initiated = rpc:call(B,net_kernel,set_net_ticktime,[TT,15]), + ?line sleep(7), + ?line change_initiated = rpc:call(C,net_kernel,set_net_ticktime,[TT,10]), + + ?line {ok, E} = start_node(EN, "-kernel net_ticktime " + ++ integer_to_list(TT) ++ " -pa " ++ PaDir), + ?line NME = spawn_link(E, fun () -> MonitorNodes([node(), B, C, D]) end), + ?line NMA2 = spawn_link(fun () -> MonitorNodes([E]) end), + ?line NMB2 = spawn_link(B, fun () -> MonitorNodes([E]) end), + ?line NMC2 = spawn_link(C, fun () -> MonitorNodes([E]) end), + + receive CheckResult -> ?line ok end, + + ?line unlink(NMA), exit(NMA, kill), + ?line unlink(NMB), exit(NMB, kill), + ?line unlink(NMC), exit(NMC, kill), + ?line unlink(NME), exit(NME, kill), + ?line unlink(NMA2), exit(NMA2, kill), + ?line unlink(NMB2), exit(NMB2, kill), + ?line unlink(NMC2), exit(NMC2, kill), + + %% The node not changing ticktime should have been disconnected from the + %% other nodes + receive {Ref, {Node, {nodedown, D}}} when Node == node() -> ?line ok + after 0 -> ?line exit({?LINE, no_nodedown}) + end, + receive {Ref, {B, {nodedown, D}}} -> ?line ok + after 0 -> ?line exit({?LINE, no_nodedown}) + end, + receive {Ref, {C, {nodedown, D}}} -> ?line ok + after 0 -> ?line exit({?LINE, no_nodedown}) + end, + receive {Ref, {E, {nodedown, D}}} -> ?line ok + after 0 -> ?line exit({?LINE, no_nodedown}) + end, + + %% No other connections should have been broken + receive + {Ref, Reason} -> + ?line stop_node(E), + ?line exit({?LINE, Reason}); + {'EXIT', Pid, Reason} when Pid == NMA; + Pid == NMB; + Pid == NMC; + Pid == NME; + Pid == NMA2; + Pid == NMB2; + Pid == NMC2 -> + ?line stop_node(E), + + ?line exit({?LINE, {node(Pid), Reason}}) + after 0 -> + ?line TT = net_kernel:get_net_ticktime(), + ?line TT = rpc:call(B, net_kernel, get_net_ticktime, []), + ?line TT = rpc:call(C, net_kernel, get_net_ticktime, []), + ?line TT = rpc:call(E, net_kernel, get_net_ticktime, []), + ?line stop_node(E), + ?line ok + end. + +%% +%% Basic tests of hidden node. +%% +hidden_node(doc) -> + ["Basic test of hidden node"]; +hidden_node(suite) -> + []; +hidden_node(Config) when list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(40)), + PaDir = filename:dirname(code:which(?MODULE)), + VArgs = "-pa " ++ PaDir, + HArgs = "-hidden -pa " ++ PaDir, + ?line {ok, V} = start_node(visible_node, VArgs), + VMN = start_monitor_nodes_proc(V), + ?line {ok, H} = start_node(hidden_node, HArgs), + % Connect visible_node -> hidden_node + connect_nodes(V, H), + test_nodes(V, H), + stop_node(H), + sleep(5), + check_monitor_nodes_res(VMN, H), + stop_node(V), + ?line {ok, H} = start_node(hidden_node, HArgs), + HMN = start_monitor_nodes_proc(H), + ?line {ok, V} = start_node(visible_node, VArgs), + % Connect hidden_node -> visible_node + connect_nodes(H, V), + test_nodes(V, H), + stop_node(V), + sleep(5), + check_monitor_nodes_res(HMN, V), + stop_node(H), + ?line ?t:timetrap_cancel(Dog), + ok. + +connect_nodes(A, B) -> + % Check that they haven't already connected. + ?line false = lists:member(A, rpc:call(B, erlang, nodes, [connected])), + ?line false = lists:member(B, rpc:call(A, erlang, nodes, [connected])), + % Connect them. + ?line pong = rpc:call(A, net_adm, ping, [B]). + + +test_nodes(V, H) -> + % No nodes should be visible on hidden_node + ?line [] = rpc:call(H, erlang, nodes, []), + % visible_node should be hidden on hidden_node + ?line true = lists:member(V, rpc:call(H, erlang, nodes, [hidden])), + % hidden_node node shouldn't be visible on visible_node + ?line false = lists:member(H, rpc:call(V, erlang, nodes, [])), + % hidden_node should be hidden on visible_node + ?line true = lists:member(H, rpc:call(V, erlang, nodes, [hidden])). + +mn_loop(MNs) -> + receive + {nodeup, N} -> + mn_loop([{nodeup, N}|MNs]); + {nodedown, N} -> + mn_loop([{nodedown, N}|MNs]); + {monitor_nodes_result, Ref, From} -> + From ! {Ref, MNs}; + _ -> + mn_loop(MNs) + end. + +start_monitor_nodes_proc(Node) -> + Ref = make_ref(), + Starter = self(), + Pid = spawn(Node, + fun() -> + net_kernel:monitor_nodes(true), + Starter ! Ref, + mn_loop([]) + end), + receive + Ref -> + ok + end, + Pid. + + +check_monitor_nodes_res(Pid, Node) -> + Ref = make_ref(), + Pid ! {monitor_nodes_result, Ref, self()}, + receive + {Ref, MNs} -> + ?line false = lists:keysearch(Node, 2, MNs) + end. + + +monitor_nodes(doc) -> + []; +monitor_nodes(suite) -> + [monitor_nodes_nodedown_reason, + monitor_nodes_complex_nodedown_reason, + monitor_nodes_node_type, + monitor_nodes_misc, + monitor_nodes_otp_6481, + monitor_nodes_errors, + monitor_nodes_combinations, + monitor_nodes_cleanup, + monitor_nodes_many]. + +%% +%% Testcase: +%% monitor_nodes_nodedown_reason +%% + +monitor_nodes_nodedown_reason(doc) -> []; +monitor_nodes_nodedown_reason(suite) -> []; +monitor_nodes_nodedown_reason(Config) when list(Config) -> + ?line MonNodeState = monitor_node_state(), + ?line ok = net_kernel:monitor_nodes(true), + ?line ok = net_kernel:monitor_nodes(true, [nodedown_reason]), + + ?line Names = get_numbered_nodenames(5, node), + ?line [NN1, NN2, NN3, NN4, NN5] = Names, + + ?line {ok, N1} = start_node(NN1), + ?line {ok, N2} = start_node(NN2), + ?line {ok, N3} = start_node(NN3), + ?line {ok, N4} = start_node(NN4, "-hidden"), + + ?line receive {nodeup, N1} -> ok end, + ?line receive {nodeup, N2} -> ok end, + ?line receive {nodeup, N3} -> ok end, + + ?line receive {nodeup, N1, []} -> ok end, + ?line receive {nodeup, N2, []} -> ok end, + ?line receive {nodeup, N3, []} -> ok end, + + ?line stop_node(N1), + ?line stop_node(N4), + ?line true = net_kernel:disconnect(N2), + ?line TickTime = net_kernel:get_net_ticktime(), + ?line SleepTime = TickTime + (TickTime div 4), + ?line spawn(N3, fun () -> + block_emu(SleepTime*1000), + halt() + end), + + ?line receive {nodedown, N1} -> ok end, + ?line receive {nodedown, N2} -> ok end, + ?line receive {nodedown, N3} -> ok end, + + ?line receive {nodedown, N1, [{nodedown_reason, R1}]} -> connection_closed = R1 end, + ?line receive {nodedown, N2, [{nodedown_reason, R2}]} -> disconnect = R2 end, + ?line receive {nodedown, N3, [{nodedown_reason, R3}]} -> net_tick_timeout = R3 end, + + ?line ok = net_kernel:monitor_nodes(false, [nodedown_reason]), + + ?line {ok, N5} = start_node(NN5), + ?line stop_node(N5), + + ?line receive {nodeup, N5} -> ok end, + ?line receive {nodedown, N5} -> ok end, + ?line print_my_messages(), + ?line ok = check_no_nodedown_nodeup(1000), + ?line ok = net_kernel:monitor_nodes(false), + ?line MonNodeState = monitor_node_state(), + ?line ok. + + +monitor_nodes_complex_nodedown_reason(doc) -> []; +monitor_nodes_complex_nodedown_reason(suite) -> []; +monitor_nodes_complex_nodedown_reason(Config) when list(Config) -> + ?line MonNodeState = monitor_node_state(), + ?line Me = self(), + ?line ok = net_kernel:monitor_nodes(true, [nodedown_reason]), + ?line [Name] = get_nodenames(1, monitor_nodes_complex_nodedown_reason), + ?line {ok, Node} = start_node(Name, ""), + ?line Pid = spawn(Node, + fun() -> + Me ! {stuff, + self(), + [make_ref(), + {processes(), erlang:ports()}]} + end), + ?line receive {nodeup, Node, []} -> ok end, + ?line {ok, NodeInfo} = net_kernel:node_info(Node), + ?line {value,{owner, Owner}} = lists:keysearch(owner, 1, NodeInfo), + ?line ComplexTerm = receive {stuff, Pid, _} = Msg -> + {Msg, term_to_binary(Msg)} + end, + ?line exit(Owner, ComplexTerm), + ?line receive + {nodedown, Node, [{nodedown_reason, NodeDownReason}]} -> + ?line ok + end, + %% If the complex nodedown_reason messed something up garbage collections + %% are likely to dump core + ?line garbage_collect(), + ?line garbage_collect(), + ?line garbage_collect(), + ?line ComplexTerm = NodeDownReason, + ?line ok = net_kernel:monitor_nodes(false, [nodedown_reason]), + ?line no_msgs(), + ?line MonNodeState = monitor_node_state(), + ?line ok. + + + + +%% +%% Testcase: +%% monitor_nodes_node_type +%% + +monitor_nodes_node_type(doc) -> []; +monitor_nodes_node_type(suite) -> []; +monitor_nodes_node_type(Config) when is_list(Config) -> + ?line MonNodeState = monitor_node_state(), + ?line ok = net_kernel:monitor_nodes(true), + ?line ok = net_kernel:monitor_nodes(true, [{node_type, all}]), + ?line Names = get_numbered_nodenames(9, node), +% ?line ?t:format("Names: ~p~n", [Names]), + ?line [NN1, NN2, NN3, NN4, NN5, NN6, NN7, NN8, NN9] = Names, + + ?line {ok, N1} = start_node(NN1), + ?line {ok, N2} = start_node(NN2), + ?line {ok, N3} = start_node(NN3, "-hidden"), + ?line {ok, N4} = start_node(NN4, "-hidden"), + + ?line receive {nodeup, N1} -> ok end, + ?line receive {nodeup, N2} -> ok end, + + ?line receive {nodeup, N1, [{node_type, visible}]} -> ok end, + ?line receive {nodeup, N2, [{node_type, visible}]} -> ok end, + ?line receive {nodeup, N3, [{node_type, hidden}]} -> ok end, + ?line receive {nodeup, N4, [{node_type, hidden}]} -> ok end, + + ?line stop_node(N1), + ?line stop_node(N2), + ?line stop_node(N3), + ?line stop_node(N4), + + ?line receive {nodedown, N1} -> ok end, + ?line receive {nodedown, N2} -> ok end, + + ?line receive {nodedown, N1, [{node_type, visible}]} -> ok end, + ?line receive {nodedown, N2, [{node_type, visible}]} -> ok end, + ?line receive {nodedown, N3, [{node_type, hidden}]} -> ok end, + ?line receive {nodedown, N4, [{node_type, hidden}]} -> ok end, + + ?line ok = net_kernel:monitor_nodes(false, [{node_type, all}]), + ?line {ok, N5} = start_node(NN5), + + ?line receive {nodeup, N5} -> ok end, + ?line stop_node(N5), + ?line receive {nodedown, N5} -> ok end, + + ?line ok = net_kernel:monitor_nodes(true, [{node_type, hidden}]), + ?line {ok, N6} = start_node(NN6), + ?line {ok, N7} = start_node(NN7, "-hidden"), + + + ?line receive {nodeup, N6} -> ok end, + ?line receive {nodeup, N7, [{node_type, hidden}]} -> ok end, + ?line stop_node(N6), + ?line stop_node(N7), + + ?line receive {nodedown, N6} -> ok end, + ?line receive {nodedown, N7, [{node_type, hidden}]} -> ok end, + + ?line ok = net_kernel:monitor_nodes(true, [{node_type, visible}]), + ?line ok = net_kernel:monitor_nodes(false, [{node_type, hidden}]), + ?line ok = net_kernel:monitor_nodes(false), + + ?line {ok, N8} = start_node(NN8), + ?line {ok, N9} = start_node(NN9, "-hidden"), + + ?line receive {nodeup, N8, [{node_type, visible}]} -> ok end, + ?line stop_node(N8), + ?line stop_node(N9), + + ?line receive {nodedown, N8, [{node_type, visible}]} -> ok end, + ?line print_my_messages(), + ?line ok = check_no_nodedown_nodeup(1000), + ?line ok = net_kernel:monitor_nodes(false, [{node_type, visible}]), + ?line MonNodeState = monitor_node_state(), + ?line ok. + + +%% +%% Testcase: +%% monitor_nodes +%% + +monitor_nodes_misc(doc) -> []; +monitor_nodes_misc(suite) -> []; +monitor_nodes_misc(Config) when is_list(Config) -> + ?line MonNodeState = monitor_node_state(), + ?line ok = net_kernel:monitor_nodes(true), + ?line ok = net_kernel:monitor_nodes(true, [{node_type, all}, nodedown_reason]), + ?line ok = net_kernel:monitor_nodes(true, [nodedown_reason, {node_type, all}]), + ?line Names = get_numbered_nodenames(3, node), +% ?line ?t:format("Names: ~p~n", [Names]), + ?line [NN1, NN2, NN3] = Names, + + ?line {ok, N1} = start_node(NN1), + ?line {ok, N2} = start_node(NN2, "-hidden"), + + ?line receive {nodeup, N1} -> ok end, + + ?line receive {nodeup, N1, [{node_type, visible}]} -> ok end, + ?line receive {nodeup, N1, [{node_type, visible}]} -> ok end, + ?line receive {nodeup, N2, [{node_type, hidden}]} -> ok end, + ?line receive {nodeup, N2, [{node_type, hidden}]} -> ok end, + + ?line stop_node(N1), + ?line stop_node(N2), + + ?line VisbleDownInfo = lists:sort([{node_type, visible}, + {nodedown_reason, connection_closed}]), + ?line HiddenDownInfo = lists:sort([{node_type, hidden}, + {nodedown_reason, connection_closed}]), + + ?line receive {nodedown, N1} -> ok end, + + ?line receive {nodedown, N1, Info1A} -> VisbleDownInfo = lists:sort(Info1A) end, + ?line receive {nodedown, N1, Info1B} -> VisbleDownInfo = lists:sort(Info1B) end, + ?line receive {nodedown, N2, Info2A} -> HiddenDownInfo = lists:sort(Info2A) end, + ?line receive {nodedown, N2, Info2B} -> HiddenDownInfo = lists:sort(Info2B) end, + + ?line ok = net_kernel:monitor_nodes(false, [{node_type, all}, nodedown_reason]), + + ?line {ok, N3} = start_node(NN3), + ?line receive {nodeup, N3} -> ok end, + ?line stop_node(N3), + ?line receive {nodedown, N3} -> ok end, + ?line print_my_messages(), + ?line ok = check_no_nodedown_nodeup(1000), + ?line ok = net_kernel:monitor_nodes(false), + ?line MonNodeState = monitor_node_state(), + ?line ok. + + +monitor_nodes_otp_6481(doc) -> + ["Tests that {nodeup, Node} messages are received before " + "messages from Node and that {nodedown, Node} messages are" + "received after messages from Node"]; +monitor_nodes_otp_6481(suite) -> + []; +monitor_nodes_otp_6481(Config) when is_list(Config) -> + ?line ?t:format("Testing nodedown...~n"), + ?line monitor_nodes_otp_6481_test(Config, nodedown), + ?line ?t:format("ok~n"), + ?line ?t:format("Testing nodeup...~n"), + ?line monitor_nodes_otp_6481_test(Config, nodeup), + ?line ?t:format("ok~n"), + ?line ok. + +monitor_nodes_otp_6481_test(Config, TestType) when is_list(Config) -> + ?line MonNodeState = monitor_node_state(), + ?line NodeMsg = make_ref(), + ?line Me = self(), + ?line [Name] = get_nodenames(1, monitor_nodes_otp_6481), + ?line case TestType of + nodedown -> ?line ok = net_kernel:monitor_nodes(true); + nodeup -> ?line ok + end, + ?line Seq = lists:seq(1,10000), + ?line MN = spawn_link( + fun () -> + ?line lists:foreach( + fun (_) -> + ?line ok = net_kernel:monitor_nodes(true) + end, + Seq), + ?line Me ! {mon_set, self()}, + ?line receive after infinity -> ok end + end), + ?line receive {mon_set, MN} -> ok end, + ?line case TestType of + nodedown -> ?line ok; + nodeup -> ?line ok = net_kernel:monitor_nodes(true) + end, + + %% Whitebox: + %% nodedown test: Since this process was the first one monitoring + %% nodes this process will be the first one notified + %% on nodedown. + %% nodeup test: Since this process was the last one monitoring + %% nodes this process will be the last one notified + %% on nodeup + + %% Verify the monitor_nodes order expected + ?line TestMonNodeState = monitor_node_state(), + %?line ?t:format("~p~n", [TestMonNodeState]), + ?line TestMonNodeState = + MonNodeState + ++ case TestType of + nodedown -> [{self(), []}]; + nodeup -> [] + end + ++ lists:map(fun (_) -> {MN, []} end, Seq) + ++ case TestType of + nodedown -> []; + nodeup -> [{self(), []}] + end, + + + ?line {ok, Node} = start_node(Name, "", this), + ?line receive {nodeup, Node} -> ok end, + + ?line spawn(Node, + fun () -> + receive after 1000 -> ok end, + lists:foreach(fun (No) -> + Me ! {NodeMsg, No} + end, + Seq), + halt() + end), + + ?line net_kernel:disconnect(Node), + ?line receive {nodedown, Node} -> ok end, + + %% Verify that '{nodeup, Node}' comes before '{NodeMsg, 1}' (the message + %% bringing up the connection). + %%?line no_msgs(500), % Why wait? It fails test sometimes /sverker + ?line {nodeup, Node} = receive Msg1 -> Msg1 end, + ?line {NodeMsg, 1} = receive Msg2 -> Msg2 end, + + %% Verify that '{nodedown, Node}' comes after the last '{NodeMsg, N}' + %% message. + ?line {nodedown, Node} = flush_node_msgs(NodeMsg, 2), + ?line no_msgs(500), + + ?line Mon = erlang:monitor(process, MN), + ?line unlink(MN), + ?line exit(MN, bang), + ?line receive {'DOWN', Mon, process, MN, bang} -> ok end, + ?line ok = net_kernel:monitor_nodes(false), + ?line MonNodeState = monitor_node_state(), + ?line ok. + +flush_node_msgs(NodeMsg, No) -> + case receive Msg -> Msg end of + {NodeMsg, No} -> flush_node_msgs(NodeMsg, No+1); + OtherMsg -> OtherMsg + end. + +monitor_nodes_errors(doc) -> + []; +monitor_nodes_errors(suite) -> + []; +monitor_nodes_errors(Config) when list(Config) -> + ?line MonNodeState = monitor_node_state(), + ?line error = net_kernel:monitor_nodes(asdf), + ?line {error, + {unknown_options, + [gurka]}} = net_kernel:monitor_nodes(true, + [gurka]), + ?line {error, + {options_not_a_list, + gurka}} = net_kernel:monitor_nodes(true, + gurka), + ?line {error, + {option_value_mismatch, + [{node_type,visible}, + {node_type,hidden}]}} + = net_kernel:monitor_nodes(true, + [{node_type,hidden}, + {node_type,visible}]), + ?line {error, + {option_value_mismatch, + [{node_type,visible}, + {node_type,all}]}} + = net_kernel:monitor_nodes(true, + [{node_type,all}, + {node_type,visible}]), + ?line {error, + {bad_option_value, + {node_type, + blaha}}} + = net_kernel:monitor_nodes(true, [{node_type, blaha}]), + ?line MonNodeState = monitor_node_state(), + ?line ok. + +monitor_nodes_combinations(doc) -> + []; +monitor_nodes_combinations(suite) -> + []; +monitor_nodes_combinations(Config) when list(Config) -> + ?line MonNodeState = monitor_node_state(), + ?line monitor_nodes_all_comb(true), + ?line [VisibleName, HiddenName] = get_nodenames(2, + monitor_nodes_combinations), + ?line {ok, Visible} = start_node(VisibleName, ""), + ?line receive_all_comb_nodeup_msgs(visible, Visible), + ?line no_msgs(), + ?line stop_node(Visible), + ?line receive_all_comb_nodedown_msgs(visible, Visible, connection_closed), + ?line no_msgs(), + ?line {ok, Hidden} = start_node(HiddenName, "-hidden"), + ?line receive_all_comb_nodeup_msgs(hidden, Hidden), + ?line no_msgs(), + ?line stop_node(Hidden), + ?line receive_all_comb_nodedown_msgs(hidden, Hidden, connection_closed), + ?line no_msgs(), + ?line monitor_nodes_all_comb(false), + ?line MonNodeState = monitor_node_state(), + ?line no_msgs(), + ?line ok. + +monitor_nodes_all_comb(Flag) -> + ?line ok = net_kernel:monitor_nodes(Flag), + ?line ok = net_kernel:monitor_nodes(Flag, + [nodedown_reason]), + ?line ok = net_kernel:monitor_nodes(Flag, + [{node_type, hidden}]), + ?line ok = net_kernel:monitor_nodes(Flag, + [{node_type, visible}]), + ?line ok = net_kernel:monitor_nodes(Flag, + [{node_type, all}]), + ?line ok = net_kernel:monitor_nodes(Flag, + [nodedown_reason, + {node_type, hidden}]), + ?line ok = net_kernel:monitor_nodes(Flag, + [nodedown_reason, + {node_type, visible}]), + ?line ok = net_kernel:monitor_nodes(Flag, + [nodedown_reason, + {node_type, all}]), + %% There currently are 8 different combinations + ?line 8. + + +receive_all_comb_nodeup_msgs(visible, Node) -> + ?t:format("Receive nodeup visible...~n"), + Exp = [{nodeup, Node}, + {nodeup, Node, []}] + ++ mk_exp_mn_all_comb_nodeup_msgs_common(visible, Node), + receive_mn_msgs(Exp), + ?t:format("ok~n"), + ok; +receive_all_comb_nodeup_msgs(hidden, Node) -> + ?t:format("Receive nodeup hidden...~n"), + Exp = mk_exp_mn_all_comb_nodeup_msgs_common(hidden, Node), + receive_mn_msgs(Exp), + ?t:format("ok~n"), + ok. + +mk_exp_mn_all_comb_nodeup_msgs_common(Type, Node) -> + InfoNt = [{node_type, Type}], + [{nodeup, Node, InfoNt}, + {nodeup, Node, InfoNt}, + {nodeup, Node, InfoNt}, + {nodeup, Node, InfoNt}]. + +receive_all_comb_nodedown_msgs(visible, Node, Reason) -> + ?t:format("Receive nodedown visible...~n"), + Exp = [{nodedown, Node}, + {nodedown, Node, [{nodedown_reason, Reason}]}] + ++ mk_exp_mn_all_comb_nodedown_msgs_common(visible, + Node, + Reason), + receive_mn_msgs(Exp), + ?t:format("ok~n"), + ok; +receive_all_comb_nodedown_msgs(hidden, Node, Reason) -> + ?t:format("Receive nodedown hidden...~n"), + Exp = mk_exp_mn_all_comb_nodedown_msgs_common(hidden, Node, Reason), + receive_mn_msgs(Exp), + ?t:format("ok~n"), + ok. + +mk_exp_mn_all_comb_nodedown_msgs_common(Type, Node, Reason) -> + InfoNt = [{node_type, Type}], + InfoNdrNt = lists:sort([{nodedown_reason, Reason}]++InfoNt), + [{nodedown, Node, InfoNt}, + {nodedown, Node, InfoNt}, + {nodedown, Node, InfoNdrNt}, + {nodedown, Node, InfoNdrNt}]. + +receive_mn_msgs([]) -> + ok; +receive_mn_msgs(Msgs) -> + ?t:format("Expecting msgs: ~p~n", [Msgs]), + receive + {_Dir, _Node} = Msg -> + ?t:format("received ~p~n", [Msg]), + case lists:member(Msg, Msgs) of + true -> receive_mn_msgs(lists:delete(Msg, Msgs)); + false -> ?t:fail({unexpected_message, Msg, + expected_messages, Msgs}) + end; + {Dir, Node, Info} -> + Msg = {Dir, Node, lists:sort(Info)}, + ?t:format("received ~p~n", [Msg]), + case lists:member(Msg, Msgs) of + true -> receive_mn_msgs(lists:delete(Msg, Msgs)); + false -> ?t:fail({unexpected_message, Msg, + expected_messages, Msgs}) + end; + Msg -> + ?t:format("received ~p~n", [Msg]), + ?t:fail({unexpected_message, Msg, + expected_messages, Msgs}) + end. + +monitor_nodes_cleanup(doc) -> + []; +monitor_nodes_cleanup(suite) -> + []; +monitor_nodes_cleanup(Config) when list(Config) -> + ?line MonNodeState = monitor_node_state(), + ?line Me = self(), + ?line No = monitor_nodes_all_comb(true), + ?line Inf = spawn(fun () -> + monitor_nodes_all_comb(true), + Me ! {mons_set, self()}, + receive after infinity -> ok end + end), + ?line TO = spawn(fun () -> + monitor_nodes_all_comb(true), + Me ! {mons_set, self()}, + receive after 500 -> ok end + end), + ?line receive {mons_set, Inf} -> ok end, + ?line receive {mons_set, TO} -> ok end, + ?line MNLen = length(MonNodeState) + No*3, + ?line MNLen = length(monitor_node_state()), + ?line MonInf = erlang:monitor(process, Inf), + ?line MonTO = erlang:monitor(process, TO), + ?line exit(Inf, bang), + ?line No = monitor_nodes_all_comb(false), + ?line receive {'DOWN', MonInf, process, Inf, bang} -> ok end, + ?line receive {'DOWN', MonTO, process, TO, normal} -> ok end, + ?line MonNodeState = monitor_node_state(), + ?line no_msgs(), + ?line ok. + +monitor_nodes_many(doc) -> + []; +monitor_nodes_many(suite) -> + []; +monitor_nodes_many(Config) when list(Config) -> + ?line MonNodeState = monitor_node_state(), + ?line [Name] = get_nodenames(1, monitor_nodes_many), + %% We want to perform more than 2^16 net_kernel:monitor_nodes + %% since this will wrap an internal counter + ?line No = (1 bsl 16) + 17, + ?line repeat(fun () -> ok = net_kernel:monitor_nodes(true) end, No), + ?line No = length(monitor_node_state()) - length(MonNodeState), + ?line {ok, Node} = start_node(Name), + ?line repeat(fun () -> receive {nodeup, Node} -> ok end end, No), + ?line stop_node(Node), + ?line repeat(fun () -> receive {nodedown, Node} -> ok end end, No), + ?line ok = net_kernel:monitor_nodes(false), + ?line no_msgs(10), + ?line MonNodeState = monitor_node_state(), + ?line ok. + +%% Misc. functions + +monitor_node_state() -> + erts_debug:set_internal_state(available_internal_state, true), + MonitoringNodes = erts_debug:get_internal_state(monitoring_nodes), + erts_debug:set_internal_state(available_internal_state, false), + MonitoringNodes. + + +check_no_nodedown_nodeup(TimeOut) -> + ?line receive + {nodeup, _, _} = Msg -> ?line ?t:fail({unexpected_nodeup, Msg}); + {nodeup, _} = Msg -> ?line ?t:fail({unexpected_nodeup, Msg}); + {nodedown, _, _} = Msg -> ?line ?t:fail({unexpected_nodedown, Msg}); + {nodedown, _} = Msg -> ?line ?t:fail({unexpected_nodedown, Msg}) + after TimeOut -> + ok + end. + +print_my_messages() -> + ?line {messages, Messages} = process_info(self(), messages), + ?line ?t:format("Messages: ~p~n", [Messages]), + ?line ok. + +%% Time difference in milliseconds !! +time_diff({TimeM, TimeS, TimeU}, {CurM, CurS, CurU}) when CurM > TimeM -> + ((CurM - TimeM) * 1000000000) + sec_diff({TimeS, TimeU}, {CurS, CurU}); +time_diff({_, TimeS, TimeU}, {_, CurS, CurU}) -> + sec_diff({TimeS, TimeU}, {CurS, CurU}). + +sec_diff({TimeS, TimeU}, {CurS, CurU}) when CurS > TimeS -> + ((CurS - TimeS) * 1000) + micro_diff(TimeU, CurU); +sec_diff({_, TimeU}, {_, CurU}) -> + micro_diff(TimeU, CurU). + +micro_diff(TimeU, CurU) -> + trunc(CurU/1000) - trunc(TimeU/1000). + +sleep(T) -> receive after T * 1000 -> ok end. + +start_node(Name, Param, this) -> + NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)), + ?t:start_node(Name, peer, [{args, NewParam}, {erl, [this]}]); +start_node(Name, Param, "this") -> + NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)), + ?t:start_node(Name, peer, [{args, NewParam}, {erl, [this]}]); +start_node(Name, Param, Rel) when atom(Rel) -> + NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)), + ?t:start_node(Name, peer, [{args, NewParam}, {erl, [{release, atom_to_list(Rel)}]}]); +start_node(Name, Param, Rel) when list(Rel) -> + NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)), + ?t:start_node(Name, peer, [{args, NewParam}, {erl, [{release, Rel}]}]). + +start_node(Name, Param) -> + NewParam = Param ++ " -pa " ++ filename:dirname(code:which(?MODULE)), + ?t:start_node(Name, slave, [{args, NewParam}]). +% M = list_to_atom(from($@, atom_to_list(node()))), +% slave:start_link(M, Name, Param). + +start_node(Name) -> + start_node(Name, ""). + +stop_node(Node) -> + ?t:stop_node(Node). +% erlang:monitor_node(Node, true), +% rpc:cast(Node, init, stop, []), +% receive +% {nodedown, Node} -> +% ok +% after 10000 -> +% test_server:fail({stop_node, Node}) +% end. + +% from(H, [H | T]) -> T; +% from(H, [_ | T]) -> from(H, T); +% from(H, []) -> []. + +get_nodenames(N, T) -> + get_nodenames(N, T, []). + +get_nodenames(0, _, Acc) -> + Acc; +get_nodenames(N, T, Acc) -> + {A, B, C} = now(), + get_nodenames(N-1, T, [list_to_atom(atom_to_list(T) + ++ "-" + ++ atom_to_list(?MODULE) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C)) | Acc]). + +get_numbered_nodenames(N, T) -> + get_numbered_nodenames(N, T, []). + +get_numbered_nodenames(0, _, Acc) -> + Acc; +get_numbered_nodenames(N, T, Acc) -> + {A, B, C} = now(), + NL = [list_to_atom(atom_to_list(T) ++ integer_to_list(N) + ++ "-" + ++ atom_to_list(?MODULE) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C)) | Acc], + get_numbered_nodenames(N-1, T, NL). + +wait_until(Fun) -> + case Fun() of + true -> + ok; + _ -> + receive + after 100 -> + wait_until(Fun) + end + end. + +repeat(Fun, 0) when function(Fun) -> + ok; +repeat(Fun, N) when function(Fun), integer(N), N > 0 -> + Fun(), + repeat(Fun, N-1). + +no_msgs(Wait) -> + receive after Wait -> no_msgs() end. + +no_msgs() -> + {messages, []} = process_info(self(), messages). + +block_emu(Ms) -> + erts_debug:set_internal_state(available_internal_state, true), + Res = erts_debug:set_internal_state(block, Ms), + erts_debug:set_internal_state(available_internal_state, false), + Res. diff --git a/lib/kernel/test/erl_distribution_wb_SUITE.erl b/lib/kernel/test/erl_distribution_wb_SUITE.erl new file mode 100644 index 0000000000..627fed1fdd --- /dev/null +++ b/lib/kernel/test/erl_distribution_wb_SUITE.erl @@ -0,0 +1,705 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. 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(erl_distribution_wb_SUITE). + +-include("test_server.hrl"). +-include_lib("kernel/include/inet.hrl"). + +-export([all/1]). + +-export([init_per_testcase/2, fin_per_testcase/2, whitebox/1, + switch_options/1, missing_compulsory_dflags/1]). + +%% 1) +%% +%% Connections are now always set up symetrically with respect to +%% publication. If connecting node doesn't send DFLAG_PUBLISHED +%% the other node wont send DFLAG_PUBLISHED. If the connecting +%% node send DFLAG_PUBLISHED but the other node doesn't send +%% DFLAG_PUBLISHED, the connecting node should consider its +%% DFLAG_PUBLISHED as dropped, i.e the connecting node wont be +%% published on the other node. + +-define(to_port(Socket, Data), + case inet_tcp:send(Socket, Data) of + {error, closed} -> + self() ! {tcp_closed, Socket}, + {error, closed}; + R -> + R + end). + +-define(DFLAG_PUBLISHED,1). +-define(DFLAG_ATOM_CACHE,2). +-define(DFLAG_EXTENDED_REFERENCES,4). +-define(DFLAG_DIST_MONITOR,8). +-define(DFLAG_FUN_TAGS,16#10). +-define(DFLAG_DIST_MONITOR_NAME,16#20). +-define(DFLAG_HIDDEN_ATOM_CACHE,16#40). +-define(DFLAG_NEW_FUN_TAGS,16#80). +-define(DFLAG_EXTENDED_PIDS_PORTS,16#100). + +%% From R9 and forward extended references is compulsory +%% From R10 and forward extended pids and ports are compulsory +-define(COMPULSORY_DFLAGS, (?DFLAG_EXTENDED_REFERENCES bor ?DFLAG_EXTENDED_PIDS_PORTS)). + + +-define(shutdown(X), exit(X)). +-define(int16(X), [((X) bsr 8) band 16#ff, (X) band 16#ff]). + +-define(int32(X), + [((X) bsr 24) band 16#ff, ((X) bsr 16) band 16#ff, + ((X) bsr 8) band 16#ff, (X) band 16#ff]). + +-define(i16(X1,X0), + (?u16(X1,X0) - + (if (X1) > 127 -> 16#10000; true -> 0 end))). + +-define(u16(X1,X0), + (((X1) bsl 8) bor (X0))). + +-define(u32(X3,X2,X1,X0), + (((X3) bsl 24) bor ((X2) bsl 16) bor ((X1) bsl 8) bor (X0))). + +all(suite) -> + [whitebox,switch_options,missing_compulsory_dflags]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Dog=?t:timetrap(?t:minutes(1)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +switch_options(doc) -> + ["Tests switching of options for the tcp port, as this is done" + " when the distribution port is to be shortcut into the emulator." + " Maybe this should be in the inet test suite, but only the distribution" + " does such horrible things..."]; +switch_options(Config) when is_list(Config) -> + ok = test_switch_active(), + ok = test_switch_active_partial() , + ok = test_switch_active_and_packet(), + ok. + + +whitebox(doc) -> + ["Whitebox testing of distribution handshakes. Tests both BC with R5 and " + "the md5 version. Note that after R6B, this should be revised to " + "remove BC code."]; +whitebox(Config) when is_list(Config) -> + ?line {ok, Node} = start_node(?MODULE,""), + ?line Cookie = erlang:get_cookie(), + ?line {_,Host} = split(node()), + ?line ok = pending_up_md5(Node, join(ccc,Host), Cookie), + ?line ok = simultaneous_md5(Node, join('A',Host), Cookie), + ?line ok = simultaneous_md5(Node, join(zzzzzzzzzzzzzz,Host), Cookie), + ?line stop_node(Node), + ok. + +%% +%% The actual tests +%% + +%% +%% Switch tcp options test +%% + +test_switch_active() -> + ?line {Client, Server} = socket_pair(0, 4), + ?line ok = write_packets_32(Client, 1, 5), + receive after 2000 -> ok end, + ?line ok = read_packets(Server, 1, 1), + receive after 2000 -> ok end, + ?line ok = read_packets(Server, 2, 2), + ?line inet:setopts(Server, [{active, true}]), + ?line ok = receive_packets(Server, 3, 5), + close_pair({Client, Server}), + ok. + +test_switch_active_partial() -> + ?line {Client, Server} = socket_pair(0, 4), + ?line ok = write_packets_32(Client, 1, 2), + ?line ok = gen_tcp:send(Client,[?int32(4), [0,0,0]]), + receive after 2000 -> ok end, + ?line ok = read_packets(Server, 1, 1), + receive after 2000 -> ok end, + ?line ok = read_packets(Server, 2, 2), + ?line inet:setopts(Server, [{active, true}]), + ?line ok = gen_tcp:send(Client,[3]), + ?line ok = write_packets_32(Client, 4, 5), + ?line ok = receive_packets(Server, 3, 5), + close_pair({Client, Server}), + ok. + +do_test_switch_active_and_packet(SendBefore, SendAfter) -> + ?line {Client, Server} = socket_pair(0, 2), + ?line ok = write_packets_16(Client, 1, 2), + ?line ok = gen_tcp:send(Client,SendBefore), + receive after 2000 -> ok end, + ?line ok = read_packets(Server, 1, 1), + receive after 2000 -> ok end, + ?line ok = read_packets(Server, 2, 2), + ?line inet:setopts(Server, [{packet,4}, {active, true}]), + ?line ok = gen_tcp:send(Client,SendAfter), + ?line ok = write_packets_32(Client, 4, 5), + ?line ok = receive_packets(Server, 3, 5), + close_pair({Client, Server}), + ok. + +test_switch_active_and_packet() -> + ?line ok = do_test_switch_active_and_packet([0],[0,0,4,0,0,0,3]), + ?line ok = do_test_switch_active_and_packet([0,0],[0,4,0,0,0,3]), + ?line ok = do_test_switch_active_and_packet([0,0,0],[4,0,0,0,3]), + ?line ok = do_test_switch_active_and_packet([0,0,0,4],[0,0,0,3]), + ?line ok = do_test_switch_active_and_packet([0,0,0,4,0],[0,0,3]), + ?line ok = do_test_switch_active_and_packet([0,0,0,4,0,0],[0,3]), + ?line ok = do_test_switch_active_and_packet([0,0,0,4,0,0,0],[3]), + ?line ok = do_test_switch_active_and_packet([0,0,0,4,0,0,0,3],[]), + ok. + + +%% +%% Handshake tests +%% +pending_up_md5(Node,OurName,Cookie) -> + ?line {NA,NB} = split(Node), + ?line {port,PortNo,_} = erl_epmd:port_please(NA,NB), + ?line {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, + [{active,false}, + {packet,2}]), + ?line send_name(SocketA,OurName,5), + ?line ok = recv_status(SocketA), + ?line {hidden,Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1) + ?line OurChallengeA = gen_challenge(), + ?line OurDigestA = gen_digest(HisChallengeA, Cookie), + ?line send_challenge_reply(SocketA, OurChallengeA, OurDigestA), + ?line ok = recv_challenge_ack(SocketA, OurChallengeA, Cookie), + %%% + %%% OK, one connection is up, now lets be nasty and try another up: + %%% + %%% But wait for a while, the other node might not have done setnode + %%% just yet... + ?line receive after 1000 -> ok end, + ?line {ok, SocketB} = gen_tcp:connect(atom_to_list(NB),PortNo, + [{active,false}, + {packet,2}]), + ?line send_name(SocketB,OurName,5), + ?line alive = recv_status(SocketB), + ?line send_status(SocketB, true), + ?line gen_tcp:close(SocketA), + ?line {hidden,Node,5,HisChallengeB} = recv_challenge(SocketB), % See 1) + ?line OurChallengeB = gen_challenge(), + ?line OurDigestB = gen_digest(HisChallengeB, Cookie), + ?line send_challenge_reply(SocketB, OurChallengeB, OurDigestB), + ?line ok = recv_challenge_ack(SocketB, OurChallengeB, Cookie), + %%% + %%% Well, are we happy? + %%% + + ?line inet:setopts(SocketB, [{active, false}, + {packet, 4}]), + ?line gen_tcp:send(SocketB,build_rex_message('',OurName)), + ?line {Header, Message} = recv_message(SocketB), + ?line io:format("Received header ~p, data ~p.~n", + [Header, Message]), + ?line gen_tcp:close(SocketB), + ok. + +simultaneous_md5(Node, OurName, Cookie) when OurName < Node -> + ?line pong = net_adm:ping(Node), + ?line LSocket = case gen_tcp:listen(0, [{active, false}, {packet,2}]) of + {ok, Socket} -> + Socket; + Else -> + exit(Else) + end, + ?line EpmdSocket = register(OurName, LSocket, 1, 5), + ?line {NA, NB} = split(Node), + ?line rpc:cast(Node, net_adm, ping, [OurName]), + ?line receive after 1000 -> ok end, + ?line {port, PortNo, _} = erl_epmd:port_please(NA,NB), + ?line {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, + [{active,false}, + {packet,2}]), + ?line send_name(SocketA,OurName,5), + %% We are still not marked up on the other side, as our first message + %% is not sent. + ?line SocketB = case gen_tcp:accept(LSocket) of + {ok, Socket1} -> + ?line Socket1; + Else2 -> + ?line exit(Else2) + end, + ?line nok = recv_status(SocketA), + % Now we are expected to close A + ?line gen_tcp:close(SocketA), + % But still Socket B will continue + ?line {normal,Node,5} = recv_name(SocketB), % See 1) + ?line send_status(SocketB, ok_simultaneous), + ?line MyChallengeB = gen_challenge(), + ?line send_challenge(SocketB, OurName, MyChallengeB,5), + ?line HisChallengeB = recv_challenge_reply(SocketB, MyChallengeB, Cookie), + ?line DigestB = gen_digest(HisChallengeB,Cookie), + ?line send_challenge_ack(SocketB, DigestB), + ?line inet:setopts(SocketB, [{active, false}, + {packet, 4}]), + % This should be the ping message. + ?line {Header, Message} = recv_message(SocketB), + ?line io:format("Received header ~p, data ~p.~n", + [Header, Message]), + ?line gen_tcp:close(SocketB), + ?line gen_tcp:close(LSocket), + ?line gen_tcp:close(EpmdSocket), + ok; + +simultaneous_md5(Node, OurName, Cookie) when OurName > Node -> + ?line pong = net_adm:ping(Node), + ?line LSocket = case gen_tcp:listen(0, [{active, false}, {packet,2}]) of + {ok, Socket} -> + ?line Socket; + Else -> + ?line exit(Else) + end, + ?line EpmdSocket = register(OurName, LSocket, 1, 5), + ?line {NA, NB} = split(Node), + ?line rpc:cast(Node, net_adm, ping, [OurName]), + ?line receive after 1000 -> ok end, + ?line {port, PortNo, _} = erl_epmd:port_please(NA,NB), + ?line {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, + [{active,false}, + {packet,2}]), + ?line SocketB = case gen_tcp:accept(LSocket) of + {ok, Socket1} -> + ?line Socket1; + Else2 -> + ?line exit(Else2) + end, + ?line send_name(SocketA,OurName,5), + ?line ok_simultaneous = recv_status(SocketA), + %% Socket B should die during this + ?line case catch begin + ?line {normal,Node,5} = recv_name(SocketB), % See 1) + ?line send_status(SocketB, ok_simultaneous), + ?line MyChallengeB = gen_challenge(), + ?line send_challenge(SocketB, OurName, MyChallengeB, + 5), + ?line HisChallengeB = recv_challenge_reply( + SocketB, + MyChallengeB, + Cookie), + ?line DigestB = gen_digest(HisChallengeB,Cookie), + ?line send_challenge_ack(SocketB, DigestB), + ?line inet:setopts(SocketB, [{active, false}, + {packet, 4}]), + ?line {HeaderB, MessageB} = recv_message(SocketB), + ?line io:format("Received header ~p, data ~p.~n", + [HeaderB, MessageB]) + end of + {'EXIT', Exitcode} -> + ?line io:format("Expected exitsignal caught: ~p.~n", + [Exitcode]); + Success -> + ?line io:format("Unexpected success: ~p~n", + [Success]), + ?line exit(unexpected_success) + end, + ?line gen_tcp:close(SocketB), + %% But still Socket A will continue + ?line {hidden,Node,5,HisChallengeA} = recv_challenge(SocketA), % See 1) + ?line OurChallengeA = gen_challenge(), + ?line OurDigestA = gen_digest(HisChallengeA, Cookie), + ?line send_challenge_reply(SocketA, OurChallengeA, OurDigestA), + ?line ok = recv_challenge_ack(SocketA, OurChallengeA, Cookie), + + ?line inet:setopts(SocketA, [{active, false}, + {packet, 4}]), + ?line gen_tcp:send(SocketA,build_rex_message('',OurName)), + ?line {Header, Message} = recv_message(SocketA), + ?line io:format("Received header ~p, data ~p.~n", + [Header, Message]), + ?line gen_tcp:close(SocketA), + ?line gen_tcp:close(LSocket), + ?line gen_tcp:close(EpmdSocket), + ok. + +missing_compulsory_dflags(doc) -> []; +missing_compulsory_dflags(Config) when is_list(Config) -> + ?line [Name1, Name2] = get_nodenames(2, missing_compulsory_dflags), + ?line {ok, Node} = start_node(Name1,""), + ?line {NA,NB} = split(Node), + ?line {port,PortNo,_} = erl_epmd:port_please(NA,NB), + ?line {ok, SocketA} = gen_tcp:connect(atom_to_list(NB),PortNo, + [{active,false}, + {packet,2}]), + ?line BadNode = list_to_atom(atom_to_list(Name2)++"@"++atom_to_list(NB)), + ?line send_name(SocketA,BadNode,5,0), + ?line not_allowed = recv_status(SocketA), + ?line gen_tcp:close(SocketA), + ?line stop_node(Node), + ?line ok. + +%% +%% Here comes the utilities +%% + +%% +%% Switch option utilities +%% +write_packets_32(_, M, N) when M > N -> + ok; +write_packets_32(Sock, M, N) -> + ok = gen_tcp:send(Sock,[?int32(4), ?int32(M)]), + write_packets_32(Sock, M+1, N). + +write_packets_16(_, M, N) when M > N -> + ok; +write_packets_16(Sock, M, N) -> + ok = gen_tcp:send(Sock,[?int16(4), ?int32(M)]), + write_packets_16(Sock, M+1, N). + +read_packets(_, M, N) when M > N -> + ok; +read_packets(Sock, M, N) -> + Expected = ?int32(M), + case gen_tcp:recv(Sock, 0) of + {ok, Expected} -> + read_packets(Sock, M+1, N); + {ok, Unexpected} -> + exit({unexpected_data_read, Unexpected}); + Error -> + exit({error_read, Error}) + end. + +receive_packets(Sock, M, N) when M > N -> + receive + {tcp, Sock, Data} -> + exit({extra_data, Data}) + after 0 -> + ok + end; + +receive_packets(Sock, M, N) -> + Expect = ?int32(M), + receive + {tcp, Sock, Expect} -> + receive_packets(Sock, M+1, N); + {tcp, Sock, Unexpected} -> + exit({unexpected_data_received, Unexpected}) + after 500 -> + exit({no_data_received_for,M}) + end. + +socket_pair(ClientPack, ServerPack) -> + {ok, Listen} = gen_tcp:listen(0, [{active, false}, + {packet, ServerPack}]), + {ok, Host} = inet:gethostname(), + {ok, Port} = inet:port(Listen), + {ok, Client} = gen_tcp:connect(Host, Port, [{active, false}, + {packet, ClientPack}]), + {ok, Server} = gen_tcp:accept(Listen), + gen_tcp:close(Listen), + {Client, Server}. + +close_pair({Client, Server}) -> + gen_tcp:close(Client), + gen_tcp:close(Server), + ok. + + +%% +%% Handshake utilities +%% + +%% +%% MD5 hashing +%% + +%% This is no proper random number, but that is not really important in +%% this test +gen_challenge() -> + {_,_,N} = erlang:now(), + N. + +%% Generate a message digest from Challenge number and Cookie +gen_digest(Challenge, Cookie) when is_integer(Challenge), is_atom(Cookie) -> + C0 = erlang:md5_init(), + C1 = erlang:md5_update(C0, atom_to_list(Cookie)), + C2 = erlang:md5_update(C1, integer_to_list(Challenge)), + binary_to_list(erlang:md5_final(C2)). + + +%% +%% The differrent stages of the MD5 handshake +%% + +send_status(Socket, Stat) -> + case gen_tcp:send(Socket, [$s | atom_to_list(Stat)]) of + {error, _} -> + ?shutdown(could_not_send_status); + _ -> + true + end. + + +recv_status(Socket) -> + case gen_tcp:recv(Socket, 0) of + {ok, [$s|StrStat]} -> + list_to_atom(StrStat); + Bad -> + exit(Bad) + end. + +send_challenge(Socket, Node, Challenge, Version) -> + send_challenge(Socket, Node, Challenge, Version, ?COMPULSORY_DFLAGS). +send_challenge(Socket, Node, Challenge, Version, Flags) -> + {ok, {{_Ip1,_Ip2,_Ip3,_Ip4}, _}} = inet:sockname(Socket), + ?to_port(Socket, [$n,?int16(Version),?int32(Flags), + ?int32(Challenge), atom_to_list(Node)]). + +recv_challenge(Socket) -> + case gen_tcp:recv(Socket, 0) of + {ok,[$n,V1,V0,Fl1,Fl2,Fl3,Fl4,CA3,CA2,CA1,CA0 | Ns]} -> + Flags = ?u32(Fl1,Fl2,Fl3,Fl4), + Type = case Flags band ?DFLAG_PUBLISHED of + 0 -> + hidden; + _ -> + normal + end, + Node =list_to_atom(Ns), + Version = ?u16(V1,V0), + Challenge = ?u32(CA3,CA2,CA1,CA0), + {Type,Node,Version,Challenge}; + _ -> + ?shutdown(no_node) + end. + +send_challenge_reply(Socket, Challenge, Digest) -> + ?to_port(Socket, [$r,?int32(Challenge),Digest]). + +recv_challenge_reply(Socket, ChallengeA, Cookie) -> + case gen_tcp:recv(Socket, 0) of + {ok,[$r,CB3,CB2,CB1,CB0 | SumB]} when length(SumB) == 16 -> + SumA = gen_digest(ChallengeA, Cookie), + ChallengeB = ?u32(CB3,CB2,CB1,CB0), + if SumB == SumA -> + ChallengeB; + true -> + ?shutdown(bad_challenge_reply) + end; + _ -> + ?shutdown(no_node) + end. + +send_challenge_ack(Socket, Digest) -> + ?to_port(Socket, [$a,Digest]). + +recv_challenge_ack(Socket, ChallengeB, CookieA) -> + case gen_tcp:recv(Socket, 0) of + {ok,[$a | SumB]} when length(SumB) == 16 -> + SumA = gen_digest(ChallengeB, CookieA), + if SumB == SumA -> + ok; + true -> + ?shutdown(bad_challenge_ack) + end; + _ -> + ?shutdown(bad_challenge_ack) + end. + +send_name(Socket, MyNode0, Version) -> + send_name(Socket, MyNode0, Version, ?COMPULSORY_DFLAGS). +send_name(Socket, MyNode0, Version, Flags) -> + MyNode = atom_to_list(MyNode0), + ok = ?to_port(Socket, [<<$n,Version:16,Flags:32>>|MyNode]). + +%% +%% recv_name is common for both old and new handshake. +%% +recv_name(Socket) -> + case gen_tcp:recv(Socket, 0) of + {ok,Data} -> + get_name(Data); + Res -> + ?shutdown({no_node,Res}) + end. + +get_name([$m,VersionA,VersionB,_Ip1,_Ip2,_Ip3,_Ip4|OtherNode]) -> + {normal, list_to_atom(OtherNode), ?u16(VersionA,VersionB)}; +get_name([$h,VersionA,VersionB,_Ip1,_Ip2,_Ip3,_Ip4|OtherNode]) -> + {hidden, list_to_atom(OtherNode), ?u16(VersionA,VersionB)}; +get_name([$n,VersionA, VersionB, Flag1, Flag2, Flag3, Flag4 | OtherNode]) -> + Type = case ?u32(Flag1, Flag2, Flag3, Flag4) band ?DFLAG_PUBLISHED of + 0 -> + hidden; + _ -> + normal + end, + {Type, list_to_atom(OtherNode), + ?u16(VersionA,VersionB)}; +get_name(Data) -> + ?shutdown(Data). + +%% +%% The communication with EPMD follows +%% +get_epmd_port() -> + case init:get_argument(epmd_port) of + {ok, [[PortStr|_]|_]} when is_list(PortStr) -> + list_to_integer(PortStr); + error -> + 4369 % Default epmd port + end. + +do_register_node(NodeName, TcpPort, VLow, VHigh) -> + case gen_tcp:connect({127,0,0,1}, get_epmd_port(), []) of + {ok, Socket} -> + {N0,_} = split(NodeName), + Name = atom_to_list(N0), + Extra = "", + Elen = length(Extra), + Len = 1+2+1+1+2+2+2+length(Name)+2+Elen, + gen_tcp:send(Socket, [?int16(Len), $x, + ?int16(TcpPort), + $M, + 0, + ?int16(VHigh), + ?int16(VLow), + ?int16(length(Name)), + Name, + ?int16(Elen), + Extra]), + case wait_for_reg_reply(Socket, []) of + {error, epmd_close} -> + exit(epmd_broken); + Other -> + Other + end; + Error -> + Error + end. + +wait_for_reg_reply(Socket, SoFar) -> + receive + {tcp, Socket, Data0} -> + case SoFar ++ Data0 of + [$y, Result, A, B] -> + case Result of + 0 -> + {alive, Socket, ?u16(A, B)}; + _ -> + {error, duplicate_name} + end; + Data when length(Data) < 4 -> + wait_for_reg_reply(Socket, Data); + Garbage -> + {error, {garbage_from_epmd, Garbage}} + end; + {tcp_closed, Socket} -> + {error, epmd_close} + after 10000 -> + gen_tcp:close(Socket), + {error, no_reg_reply_from_epmd} + end. + + +register(NodeName, ListenSocket, VLow, VHigh) -> + {ok,{_,TcpPort}} = inet:sockname(ListenSocket), + case do_register_node(NodeName, TcpPort, VLow, VHigh) of + {alive, Socket, _Creation} -> + Socket; + Other -> + exit(Other) + end. + + +%% +%% Utilities +%% + +%% Split a nodename +split([$@|T],A) -> + {lists:reverse(A),T}; +split([H|T],A) -> + split(T,[H|A]). + +split(Atom) -> + {A,B} = split(atom_to_list(Atom),[]), + {list_to_atom(A),list_to_atom(B)}. + +%% Build a distribution message that will make rex answer +build_rex_message(Cookie,OurName) -> + [$?,term_to_binary({6,self(),Cookie,rex}), + term_to_binary({'$gen_cast', + {cast, + rpc, + cast, + [OurName, hello, world, []], + self()} })]. + +%% Receive a distribution message +recv_message(Socket) -> + case gen_tcp:recv(Socket, 0) of + {ok,Data} -> + B0 = list_to_binary(Data), + {_,B1} = erlang:split_binary(B0,1), + Header = binary_to_term(B1), + Siz = byte_size(term_to_binary(Header)), + {_,B2} = erlang:split_binary(B1,Siz), + Message = case (catch binary_to_term(B2)) of + {'EXIT', _} -> + could_not_digest_message; + Other -> + Other + end, + {Header, Message}; + Res -> + exit({no_message,Res}) + end. + +%% Build a nodename +join(Name,Host) -> + list_to_atom(atom_to_list(Name) ++ "@" ++ atom_to_list(Host)). + +%% start/stop slave. +start_node(Name, Param) -> + ?t:start_node(Name, slave, [{args, Param}]). + +stop_node(Node) -> + ?t:stop_node(Node). + + +get_nodenames(N, T) -> + get_nodenames(N, T, []). + +get_nodenames(0, _, Acc) -> + Acc; +get_nodenames(N, T, Acc) -> + {A, B, C} = now(), + get_nodenames(N-1, T, [list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(T) + ++ "-" + ++ integer_to_list(A) + ++ "-" + ++ integer_to_list(B) + ++ "-" + ++ integer_to_list(C)) | Acc]). diff --git a/lib/kernel/test/erl_prim_loader_SUITE.erl b/lib/kernel/test/erl_prim_loader_SUITE.erl new file mode 100644 index 0000000000..4d090f4db5 --- /dev/null +++ b/lib/kernel/test/erl_prim_loader_SUITE.erl @@ -0,0 +1,517 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. 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(erl_prim_loader_SUITE). + +-include_lib("kernel/include/file.hrl"). +-include("test_server.hrl"). + +-export([all/1]). + +-export([get_path/1, set_path/1, get_file/1, + inet_existing/1, inet_coming_up/1, inet_disconnects/1, + multiple_slaves/1, file_requests/1, + local_archive/1, remote_archive/1, + primary_archive/1]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +%%----------------------------------------------------------------- +%% Test suite for erl_prim_loader. (Most code is run during system start/stop.) +%%----------------------------------------------------------------- + +all(suite) -> + [ + get_path, set_path, get_file, + inet_existing, inet_coming_up, + inet_disconnects, multiple_slaves, + file_requests, local_archive, + remote_archive, primary_archive + ]. + +init_per_testcase(Func, Config) when atom(Func), list(Config) -> + Dog=?t:timetrap(?t:minutes(3)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +get_path(doc) -> []; +get_path(Config) when is_list(Config) -> + ?line case erl_prim_loader:get_path() of + {ok, Path} when is_list(Path) -> + ok; + _ -> + test_server:fail(get_path) + end, + ok. + +set_path(doc) -> []; +set_path(Config) when is_list(Config) -> + ?line {ok, Path} = erl_prim_loader:get_path(), + ?line ok = erl_prim_loader:set_path(Path), + ?line {ok, Path} = erl_prim_loader:get_path(), + NewPath = Path ++ ["dummy_dir","/dummy_dir/dummy_dir"], + ?line ok = erl_prim_loader:set_path(NewPath), + ?line {ok, NewPath} = erl_prim_loader:get_path(), + + ?line ok = erl_prim_loader:set_path(Path), % Reset path. + ?line {ok, Path} = erl_prim_loader:get_path(), + + ?line {'EXIT',_} = (catch erl_prim_loader:set_path(not_a_list)), + ?line {ok, Path} = erl_prim_loader:get_path(), + ok. + +get_file(doc) -> []; +get_file(Config) when is_list(Config) -> + ?line case erl_prim_loader:get_file("lists" ++ code:objfile_extension()) of + {ok,Bin,File} when binary(Bin), list(File) -> + ok; + _ -> + test_server:fail(get_valid_file) + end, + ?line error = erl_prim_loader:get_file("duuuuuuummmy_file"), + ?line error = erl_prim_loader:get_file(duuuuuuummmy_file), + ?line error = erl_prim_loader:get_file({dummy}), + ok. + +inet_existing(doc) -> ["Start a node using the 'inet' loading method, ", + "from an already started boot server."]; +inet_existing(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {comment, "VxWorks: tested separately"}; + _ -> + ?line Name = erl_prim_test_inet_existing, + ?line Host = host(), + ?line Cookie = atom_to_list(erlang:get_cookie()), + ?line IpStr = ip_str(Host), + ?line LFlag = get_loader_flag(os:type()), + ?line Args = LFlag ++ " -hosts " ++ IpStr ++ + " -setcookie " ++ Cookie, + ?line {ok, BootPid} = erl_boot_server:start_link([Host]), + ?line {ok, Node} = start_node(Name, Args), + ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), + ?line stop_node(Node), + ?line unlink(BootPid), + ?line exit(BootPid, kill), + ok + end. + +inet_coming_up(doc) -> ["Start a node using the 'inet' loading method, ", + "but start the boot server afterwards."]; +inet_coming_up(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {comment, "VxWorks: tested separately"}; + _ -> + ?line Name = erl_prim_test_inet_coming_up, + ?line Cookie = atom_to_list(erlang:get_cookie()), + ?line Host = host(), + ?line IpStr = ip_str(Host), + ?line LFlag = get_loader_flag(os:type()), + ?line Args = LFlag ++ + " -hosts " ++ IpStr ++ + " -setcookie " ++ Cookie, + ?line {ok, Node} = start_node(Name, Args, [{wait, false}]), + + %% Wait a while, then start boot server, and wait for node to start. + ?line test_server:sleep(test_server:seconds(6)), + io:format("erl_boot_server:start_link([~p]).", [Host]), + ?line {ok, BootPid} = erl_boot_server:start_link([Host]), + ?line wait_really_started(Node, 25), + + %% Check loader argument, then cleanup. + ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), + ?line stop_node(Node), + ?line unlink(BootPid), + ?line exit(BootPid, kill), + ok + end. + +wait_really_started(Node, 0) -> + test_server:fail({not_booted,Node}); +wait_really_started(Node, N) -> + case rpc:call(Node, init, get_status, []) of + {started, _} -> + ok; + _ -> + test_server:sleep(1000), + wait_really_started(Node, N - 1) + end. + +inet_disconnects(doc) -> ["Start a node using the 'inet' loading method, ", + "then lose the connection."]; +inet_disconnects(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {comment, "VxWorks: tested separately"}; + _ -> + ?line Name = erl_prim_test_inet_disconnects, + ?line Host = host(), + ?line Cookie = atom_to_list(erlang:get_cookie()), + ?line IpStr = ip_str(Host), + ?line LFlag = get_loader_flag(os:type()), + ?line Args = LFlag ++ " -hosts " ++ IpStr ++ + " -setcookie " ++ Cookie, + + ?line {ok, BootPid} = erl_boot_server:start([Host]), + Self = self(), + %% This process shuts down the boot server during loading. + ?line Stopper = spawn_link(fun() -> stop_boot(BootPid, Self) end), + ?line receive + {Stopper,ready} -> ok + end, + + %% Let the loading begin... + ?line {ok, Node} = start_node(Name, Args, [{wait, false}]), + + %% When the stopper is ready, the slave node should be + %% looking for a boot server again. + receive + {Stopper,ok} -> + ok; + {Stopper,{error,Reason}} -> + ?line ?t:fail(Reason) + after 60000 -> + ?line ?t:fail(stopper_died) + end, + + %% Start new boot server to see that loading is continued. + ?line {ok, BootPid2} = erl_boot_server:start_link([Host]), + ?line wait_really_started(Node, 25), + ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), + ?line stop_node(Node), + ?line unlink(BootPid2), + ?line exit(BootPid2, kill), + ok + end. + +%% Trace boot server calls and stop the server before loading is finished. +stop_boot(BootPid, Super) -> + erlang:trace(all, true, [call]), + 1 = erlang:trace_pattern({erl_boot_server,send_file_result,3}, true, [local]), + BootRef = erlang:monitor(process, BootPid), + Super ! {self(),ready}, + Result = get_calls(100, BootPid), + exit(BootPid, kill), + erlang:trace_pattern({erl_boot_server,send_file_result,3}, false, [local]), + erlang:trace(all, false, [call]), + receive + {'DOWN',BootRef,_,_, killed} -> ok + end, + Super ! {self(),Result}. + +get_calls(0, _) -> + ok; +get_calls(Count, Pid) -> + receive + {trace,_,call,_MFA} -> + get_calls(Count-1, Pid) + after 10000 -> + {error,{trace_msg_timeout,Count}} + end. + +multiple_slaves(doc) -> + ["Start nodes in parallell, all using the 'inet' loading method, ", + "verify that the boot server manages"]; +multiple_slaves(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {comment, "VxWorks: tested separately"}; + {ose,_} -> + {comment, "OSE: multiple nodes not supported"}; + _ -> + ?line Name = erl_prim_test_multiple_slaves, + ?line Host = host(), + ?line Cookie = atom_to_list(erlang:get_cookie()), + ?line IpStr = ip_str(Host), + ?line LFlag = get_loader_flag(os:type()), + ?line Args = LFlag ++ " -hosts " ++ IpStr ++ + " -setcookie " ++ Cookie, + + NoOfNodes = 10, % no of slave nodes to be started + + NamesAndNodes = + lists:map(fun(N) -> + NameN = atom_to_list(Name) ++ + integer_to_list(N), + NodeN = NameN ++ "@" ++ Host, + {list_to_atom(NameN),list_to_atom(NodeN)} + end, lists:seq(1, NoOfNodes)), + + ?line Nodes = start_multiple_nodes(NamesAndNodes, Args, []), + + %% "queue up" the nodes to wait for the boot server to respond + %% (note: test_server supervises each node start by accept() + %% on a socket, the timeout value for the accept has to be quite + %% long for this test to work). + ?line test_server:sleep(test_server:seconds(5)), + %% start the code loading circus! + ?line {ok,BootPid} = erl_boot_server:start_link([Host]), + %% give the nodes a chance to boot up before attempting to stop them + ?line test_server:sleep(test_server:seconds(10)), + + ?line wait_and_shutdown(lists:reverse(Nodes), 30), + + ?line unlink(BootPid), + ?line exit(BootPid, kill), + ok + end. + +start_multiple_nodes([{Name,Node} | NNs], Args, Started) -> + ?line {ok,Node} = start_node(Name, Args, [{wait, false}]), + start_multiple_nodes(NNs, Args, [Node | Started]); +start_multiple_nodes([], _, Nodes) -> + Nodes. + +wait_and_shutdown([Node | Nodes], Tries) -> + ?line wait_really_started(Node, Tries), + ?line {ok,[["inet"]]} = rpc:call(Node, init, get_argument, [loader]), + ?line stop_node(Node), + wait_and_shutdown(Nodes, Tries); +wait_and_shutdown([], _) -> + ok. + + +file_requests(suite) -> {req, [{local_slave_nodes, 1}, {time, 10}]}; +file_requests(doc) -> ["Start a node using the 'inet' loading method, ", + "verify that the boot server responds to file requests."]; +file_requests(Config) when is_list(Config) -> + ?line {ok, Node, BootPid} = complete_start_node(erl_prim_test_file_req), + + %% compare with results from file server calls (the + %% boot server uses the same file sys and cwd) + {ok,Files} = file:list_dir("."), + ?line {ok,Files} = rpc:call(Node, erl_prim_loader, list_dir, ["."]), + {ok,Info} = file:read_file_info("test_server.beam"), + ?line {ok,Info} = rpc:call(Node, erl_prim_loader, read_file_info, ["test_server.beam"]), + {ok,Cwd} = file:get_cwd(), + ?line {ok,Cwd} = rpc:call(Node, erl_prim_loader, get_cwd, []), + case file:get_cwd("C:") of + {error,enotsup} -> + ok; + {ok,DCwd} -> + ?line {ok,DCwd} = rpc:call(Node, erl_prim_loader, get_cwd, ["C:"]) + end, + + ?line stop_node(Node), + ?line unlink(BootPid), + ?line exit(BootPid, kill), + ok. + +complete_start_node(Name) -> + ?line Host = host(), + ?line Cookie = atom_to_list(erlang:get_cookie()), + ?line IpStr = ip_str(Host), + ?line LFlag = get_loader_flag(os:type()), + ?line Args = LFlag ++ " -hosts " ++ IpStr ++ + " -setcookie " ++ Cookie, + + ?line {ok,BootPid} = erl_boot_server:start_link([Host]), + + ?line {ok,Node} = start_node(Name, Args), + ?line wait_really_started(Node, 25), + {ok, Node, BootPid}. + +local_archive(suite) -> + []; +local_archive(doc) -> + ["Read files from local archive."]; +local_archive(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + KernelDir = filename:basename(code:lib_dir(kernel)), + Archive = filename:join([PrivDir, KernelDir ++ init:archive_extension()]), + file:delete(Archive), + ?line {ok, Archive} = create_archive(Archive, [KernelDir]), + + Node = node(), + BeamName = "inet.beam", + ?line ok = test_archive(Node, Archive, KernelDir, BeamName), + ?line ok = rpc:call(Node, erl_prim_loader, release_archives, []), + + ?line ok = file:delete(Archive), + ok. + +remote_archive(suite) -> + {req, [{local_slave_nodes, 1}, {time, 10}]}; +remote_archive(doc) -> + ["Read files from remote archive."]; +remote_archive(Config) when is_list(Config) -> + PrivDir = ?config(priv_dir, Config), + KernelDir = filename:basename(code:lib_dir(kernel)), + Archive = filename:join([PrivDir, KernelDir ++ init:archive_extension()]), + file:delete(Archive), + ?line {ok, Archive} = create_archive(Archive, [KernelDir]), + + ?line {ok, Node, BootPid} = complete_start_node(remote_archive), + + BeamName = "inet.beam", + ?line ok = test_archive(Node, Archive, KernelDir, BeamName), + + ?line stop_node(Node), + ?line unlink(BootPid), + ?line exit(BootPid, kill), + ok. + +primary_archive(suite) -> + {req, [{local_slave_nodes, 1}, {time, 10}]}; +primary_archive(doc) -> + ["Read files from primary archive."]; +primary_archive(Config) when is_list(Config) -> + %% Copy the orig files to priv_dir + PrivDir = ?config(priv_dir, Config), + Archive = filename:join([PrivDir, "primary_archive.zip"]), + file:delete(Archive), + DataDir = ?config(data_dir, Config), + ?line {ok, _} = zip:create(Archive, ["primary_archive"], + [{compress, []}, {cwd, DataDir}]), + ?line {ok, _} = zip:extract(Archive, [{cwd, PrivDir}]), + TopDir = filename:join([PrivDir, "primary_archive"]), + + %% Compile the code + DictDir = "primary_archive_dict-1.0", + DummyDir = "primary_archive_dummy", + ?line ok = compile_app(TopDir, DictDir), + ?line ok = compile_app(TopDir, DummyDir), + + %% Create the archive + {ok, TopFiles} = file:list_dir(TopDir), + ?line {ok, {_, ArchiveBin}} = zip:create(Archive, TopFiles, + [memory, {compress, []}, {cwd, TopDir}]), + + %% Use temporary node to simplify cleanup + ?line Cookie = atom_to_list(erlang:get_cookie()), + ?line Args = " -setcookie " ++ Cookie, + ?line {ok,Node} = start_node(primary_archive, Args), + ?line wait_really_started(Node, 25), + + %% Set primary archive + ?line {_,_,_} = rpc:call(Node, erlang, date, []), + ?line {ok, Ebins} = rpc:call(Node, erl_prim_loader, set_primary_archive, [Archive, ArchiveBin]), + ExpectedEbins = [Archive, DictDir ++ "/ebin", DummyDir ++ "/ebin"], + io:format("ExpectedEbins: ~p\n", [ExpectedEbins]), + ?line ExpectedEbins = lists:sort(Ebins), + + ?line {ok, TopFiles2} = rpc:call(Node, erl_prim_loader, list_dir, [Archive]), + ?line [DictDir, DummyDir] = lists:sort(TopFiles2), + BeamName = "primary_archive_dict_app.beam", + ?line ok = test_archive(Node, Archive, DictDir, BeamName), + + ?line {ok, []} = rpc:call(Node, erl_prim_loader, set_primary_archive, [undefined, undefined]), + + ?line stop_node(Node), + ?line ok = file:delete(Archive), + ok. + +test_archive(Node, TopDir, AppDir, BeamName) -> + %% List dir + io:format("test_archive: ~p\n", [rpc:call(Node, erl_prim_loader, list_dir, [TopDir])]), + ?line {ok, TopFiles} = rpc:call(Node, erl_prim_loader, list_dir, [TopDir]), + ?line true = lists:member(AppDir, TopFiles), + AbsAppDir = TopDir ++ "/" ++ AppDir, + ?line {ok, AppFiles} = rpc:call(Node, erl_prim_loader, list_dir, [AbsAppDir]), + ?line true = lists:member("ebin", AppFiles), + Ebin = AbsAppDir ++ "/ebin", + ?line {ok, EbinFiles} = rpc:call(Node, erl_prim_loader, list_dir, [Ebin]), + Beam = Ebin ++ "/" ++ BeamName, + ?line true = lists:member(BeamName, EbinFiles), + ?line error = rpc:call(Node, erl_prim_loader, list_dir, [TopDir ++ "/no_such_file"]), + ?line error = rpc:call(Node, erl_prim_loader, list_dir, [TopDir ++ "/ebin/no_such_file"]), + + %% File info + ?line {ok, #file_info{type = directory}} = + rpc:call(Node, erl_prim_loader, read_file_info, [TopDir]), + ?line {ok, #file_info{type = directory}} = + rpc:call(Node, erl_prim_loader, read_file_info, [Ebin]), + ?line {ok, #file_info{type = regular} = FI} = + rpc:call(Node, erl_prim_loader, read_file_info, [Beam]), + ?line error = rpc:call(Node, erl_prim_loader, read_file_info, [TopDir ++ "/no_such_file"]), + ?line error = rpc:call(Node, erl_prim_loader, read_file_info, [TopDir ++ "/ebin/no_such_file"]), + + %% Get file + ?line {ok, Bin, Beam} = rpc:call(Node, erl_prim_loader, get_file, [Beam]), + ?line if + FI#file_info.size =:= byte_size(Bin) -> ok; + true -> exit({FI#file_info.size, byte_size(Bin)}) + end, + ?line error = rpc:call(Node, erl_prim_loader, get_file, ["/no_such_file"]), + ?line error = rpc:call(Node, erl_prim_loader, get_file, ["/ebin/no_such_file"]), + ok. + +create_archive(Archive, AppDirs) -> + LibDir = code:lib_dir(), + Opts = [{compress, []}, {cwd, LibDir}], + io:format("zip:create(~p,\n\t~p,\n\t~p).\n", [Archive, AppDirs, Opts]), + zip:create(Archive, AppDirs, Opts). + +%% Misc. functions + +ip_str({A, B, C, D}) -> + lists:concat([A, ".", B, ".", C, ".", D]); +ip_str(Host) -> + {ok,Ip} = inet:getaddr(Host, inet), + ip_str(Ip). + +start_node(Name, Args) -> + start_node(Name, Args, []). + +start_node(Name, Args, Opts) -> + Opts2 = [{args, Args}|Opts], + io:format("test_server:start_node(~p, peer, ~p).\n", + [Name, Opts2]), + Res = test_server:start_node(Name, peer, Opts2), + io:format("start_node -> ~p\n", [Res]), + Res. + +host() -> + {ok,Host} = inet:gethostname(), + Host. + +stop_node(Node) -> + test_server:stop_node(Node). + +get_loader_flag({ose,_}) -> + " -loader ose_inet "; +get_loader_flag(_) -> + " -loader inet ". + +compile_app(TopDir, AppName) -> + AppDir = filename:join([TopDir, AppName]), + SrcDir = filename:join([AppDir, "src"]), + OutDir = filename:join([AppDir, "ebin"]), + ?line {ok, Files} = file:list_dir(SrcDir), + compile_files(Files, SrcDir, OutDir). + +compile_files([File | Files], SrcDir, OutDir) -> + case filename:extension(File) of + ".erl" -> + AbsFile = filename:join([SrcDir, File]), + case compile:file(AbsFile, [{outdir, OutDir}]) of + {ok, _Mod} -> + compile_files(Files, SrcDir, OutDir); + Error -> + {compilation_error, AbsFile, OutDir, Error} + end; + _ -> + compile_files(Files, SrcDir, OutDir) + end; +compile_files([], _, _) -> + ok. + diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/ebin/primary_archive_dict.app b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/ebin/primary_archive_dict.app new file mode 100644 index 0000000000..2506ae67e8 --- /dev/null +++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/ebin/primary_archive_dict.app @@ -0,0 +1,12 @@ +{application, primary_archive_dict, + [{description, "primary_archive_dict"}, + {vsn, "1.0"}, + {modules, [ + primary_archive_dict, + primary_archive_dict_sup + ]}, + {registered, [ + primary_archive_dict_sup + ]}, + {applications, [kernel, stdlib]}, + {mod, {primary_archive_dict_app, [[]]}}]}. diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/priv/primary_archive.txt b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/priv/primary_archive.txt new file mode 100644 index 0000000000..8fa2c8c064 --- /dev/null +++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/priv/primary_archive.txt @@ -0,0 +1 @@ +Some private data... diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict.erl b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict.erl new file mode 100644 index 0000000000..2444224810 --- /dev/null +++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict.erl @@ -0,0 +1,125 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. 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(primary_archive_dict). +-behaviour(sys). + +%% Public +-export([new/1, store/3, erase/2, find/2, foldl/3, erase/1]). + +%% Internal +-export([init/3, loop/3]). + +%% supervisor callback +-export([start_link/2]). + +%% sys callback functions +-export([ + system_continue/3, + system_terminate/4, + system_code_change/4 + ]). + +-define(SUPERVISOR, primary_archive_dict_sup). + +start_link(Name, Debug) -> + proc_lib:start_link(?MODULE, init, [self(), Name, Debug], infinity, []). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Client + +new(Name) -> + supervisor:start_child(?SUPERVISOR, [Name]). + +store(Pid, Key, Val) -> + call(Pid, {store, Key, Val}). + +erase(Pid, Key) -> + call(Pid, {erase, Key}). + +find(Pid, Key) -> + call(Pid, {find, Key}). + +foldl(Pid, Fun, Acc) -> + call(Pid, {foldl, Fun, Acc}). + +erase(Pid) -> + call(Pid, stop). + +call(Name, Msg) when is_atom(Name) -> + call(whereis(Name), Msg); +call(Pid, Msg) when is_pid(Pid) -> + Ref = erlang:monitor(process, Pid), + Pid ! {self(), Ref, Msg}, + receive + {Ref, Reply} -> + erlang:demonitor(Ref, [flush]), + Reply; + {'DOWN', Ref, _, _, Reason} -> + {error, Reason} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Server + +init(Parent, Name, Debug) -> + register(Name, self()), + Dict = dict:new(), + proc_lib:init_ack(Parent, {ok, self()}), + loop(Dict, Parent, Debug). + +loop(Dict, Parent, Debug) -> + receive + {system, From, Msg} -> + sys:handle_system_msg(Msg, From, Parent, ?MODULE, Debug, Dict); + {ReplyTo, Ref, {store, Key, Val}} -> + Dict2 = dict:store(Key, Val, Dict), + ReplyTo ! {Ref, ok}, + ?MODULE:loop(Dict2, Parent, Debug); + {ReplyTo, Ref, {erase, Key}} -> + Dict2 = dict:erase(Key, Dict), + ReplyTo ! {Ref, ok}, + ?MODULE:loop(Dict2, Parent, Debug); + {ReplyTo, Ref, {find, Key}} -> + Res = dict:find(Key, Dict), + ReplyTo ! {Ref, Res}, + ?MODULE:loop(Dict, Parent, Debug); + {ReplyTo, Ref, {foldl, Fun, Acc}} -> + Acc2 = dict:foldl(Fun, Acc, Dict), + ReplyTo ! {Ref, {ok, Acc2}}, + ?MODULE:loop(Dict, Parent, Debug); + {ReplyTo, Ref, stop} -> + ReplyTo ! {Ref, ok}, + exit(normal); + Msg -> + error_logger:format("~p got unexpected message: ~p\n", + [self(), Msg]), + ?MODULE:loop(Dict, Parent, Debug) + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% sys callbacks + +system_continue(Parent, Debug, Dict) -> + ?MODULE:loop(Dict, Parent, Debug). + +system_terminate(Reason, _Parent, _Debug, _Dict) -> + exit(Reason). + +system_code_change(Dict,_Module,_OldVsn,_Extra) -> + {ok, Dict}. diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_app.erl b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_app.erl new file mode 100644 index 0000000000..075632ab95 --- /dev/null +++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_app.erl @@ -0,0 +1,29 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. 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(primary_archive_dict_app). +-behaviour(application). + +%% Public +-export([start/2, stop/1]). + +start(_Type, Args) -> + primary_archive_dict_sup:start_link(Args). + +stop(_State) -> + ok. diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_sup.erl b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_sup.erl new file mode 100644 index 0000000000..12fe90aaab --- /dev/null +++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dict-1.0/src/primary_archive_dict_sup.erl @@ -0,0 +1,39 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. 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(primary_archive_dict_sup). +-behaviour(supervisor). + +%% Public +-export([start_link/1]). + +%% Internal +-export([init/1, start_simple_child/2]). + +-define(CHILD_MOD, primary_archive_dict). + +start_link(Debug) -> + supervisor:start_link({local, ?MODULE}, ?MODULE, [Debug]). + +init([Debug]) -> + Flags = {simple_one_for_one, 0, 3600}, + MFA = {?MODULE, start_simple_child, [Debug]}, + {ok, {Flags, [{?MODULE, MFA, transient, timer:seconds(3), worker, [?CHILD_MOD]}]}}. + +start_simple_child(Debug, Name) -> + ?CHILD_MOD:start_link(Name, Debug). diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/ebin/primary_archive_dummy.app b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/ebin/primary_archive_dummy.app new file mode 100644 index 0000000000..e6222a1d9e --- /dev/null +++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/ebin/primary_archive_dummy.app @@ -0,0 +1,11 @@ +{application, code_archive_dummy, + [{description, "primary_archive_dummy"}, + {vsn, "0.1"}, + {modules, [ + primary_archive_dummy, + primary_archive_dummy_app, + primary_archive_dummy_sup + ]}, + {registered, []}, + {applications, [kernel, stdlib, primary_archive_dict]}, + {mod, {primary_archive_dummy_app, [[]]}}]}. diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy.erl b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy.erl new file mode 100644 index 0000000000..186e752c3d --- /dev/null +++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy.erl @@ -0,0 +1,29 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. 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(primary_archive_dummy). +-behaviour(application). + +%% Public +-export([start/2, stop/1]). + +start(_Type, Args) -> + primary_archive_dummy_sup:start_link(Args). + +stop(_State) -> + ok. diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_app.erl b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_app.erl new file mode 100644 index 0000000000..4a29c86a89 --- /dev/null +++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_app.erl @@ -0,0 +1,29 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. 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(primary_archive_dummy_app). +-behaviour(application). + +%% Public +-export([start/2, stop/1]). + +start(_Type, Args) -> + primary_archive_dummy_sup:start_link(Args). + +stop(_State) -> + ok. diff --git a/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_sup.erl b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_sup.erl new file mode 100644 index 0000000000..c8cee46d08 --- /dev/null +++ b/lib/kernel/test/erl_prim_loader_SUITE_data/primary_archive/primary_archive_dummy/src/primary_archive_dummy_sup.erl @@ -0,0 +1,33 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. 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(primary_archive_dummy_sup). +-behaviour(supervisor). + +%% Public +-export([start_link/1]). + +%% Internal +-export([init/1]). + +start_link(Debug) -> + supervisor:start_link({local, ?MODULE}, ?MODULE, [Debug]). + +init([Debug]) -> + Flags = {one_for_one, 0, 3600}, + {ok, {Flags, []}}. diff --git a/lib/kernel/test/error_logger_SUITE.erl b/lib/kernel/test/error_logger_SUITE.erl new file mode 100644 index 0000000000..a737949bbb --- /dev/null +++ b/lib/kernel/test/error_logger_SUITE.erl @@ -0,0 +1,300 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. 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(error_logger_SUITE). + +-include("test_server.hrl"). + +%%----------------------------------------------------------------- +%% We don't have to test the normal behaviour here, i.e. the tty +%% handler. +%% We will add an own error handler in order to verify that the +%% error_logger deliver the expected events. +%%----------------------------------------------------------------- + +-export([all/1, error_report/1, info_report/1, error/1, info/1, + emulator/1, tty/1, logfile/1, add/1, delete/1]). + +-export([generate_error/0]). + +-export([init/1, + handle_event/2, handle_call/2, handle_info/2, + terminate/2]). + + +all(suite) -> + [error_report, info_report, error, info, + emulator, tty, logfile, add, delete]. + +%%----------------------------------------------------------------- + +error_report(suite) -> []; +error_report(doc) -> []; +error_report(Config) when list(Config) -> + ?line error_logger:add_report_handler(?MODULE, self()), + Rep1 = [{tag1,"data1"},{tag2,data2},{tag3,3}], + Rep2 = [testing,"testing",{tag1,"tag1"}], + Rep3 = "This is a string !", + Rep4 = {this,is,a,tuple}, + ?line ok = error_logger:error_report(Rep1), + reported(error_report, std_error, Rep1), + ?line ok = error_logger:error_report(Rep2), + reported(error_report, std_error, Rep2), + ?line ok = error_logger:error_report(Rep3), + reported(error_report, std_error, Rep3), + ?line ok = error_logger:error_report(Rep4), + reported(error_report, std_error, Rep4), + + ?line ok = error_logger:error_report(test_type, Rep1), + reported(error_report, test_type, Rep1), + ?line ok = error_logger:error_report(test_type, Rep2), + reported(error_report, test_type, Rep2), + ?line ok = error_logger:error_report(test_type, Rep3), + reported(error_report, test_type, Rep3), + ?line ok = error_logger:error_report(test_type, Rep4), + reported(error_report, test_type, Rep4), + + ?line ok = error_logger:error_report("test_type", Rep1), + reported(error_report, "test_type", Rep1), + ?line ok = error_logger:error_report({test,type}, Rep2), + reported(error_report, {test,type}, Rep2), + ?line ok = error_logger:error_report([test,type], Rep3), + reported(error_report, [test,type], Rep3), + ?line ok = error_logger:error_report(1, Rep4), + reported(error_report, 1, Rep4), + + ?line my_yes = error_logger:delete_report_handler(?MODULE), + ok. + +%%----------------------------------------------------------------- + +info_report(suite) -> []; +info_report(doc) -> []; +info_report(Config) when list(Config) -> + ?line error_logger:add_report_handler(?MODULE, self()), + Rep1 = [{tag1,"data1"},{tag2,data2},{tag3,3}], + Rep2 = [testing,"testing",{tag1,"tag1"}], + Rep3 = "This is a string !", + Rep4 = {this,is,a,tuple}, + ?line ok = error_logger:info_report(Rep1), + reported(info_report, std_info, Rep1), + ?line ok = error_logger:info_report(Rep2), + reported(info_report, std_info, Rep2), + ?line ok = error_logger:info_report(Rep3), + reported(info_report, std_info, Rep3), + ?line ok = error_logger:info_report(Rep4), + reported(info_report, std_info, Rep4), + + ?line ok = error_logger:info_report(test_type, Rep1), + reported(info_report, test_type, Rep1), + ?line ok = error_logger:info_report(test_type, Rep2), + reported(info_report, test_type, Rep2), + ?line ok = error_logger:info_report(test_type, Rep3), + reported(info_report, test_type, Rep3), + ?line ok = error_logger:info_report(test_type, Rep4), + reported(info_report, test_type, Rep4), + + ?line ok = error_logger:info_report("test_type", Rep1), + reported(info_report, "test_type", Rep1), + ?line ok = error_logger:info_report({test,type}, Rep2), + reported(info_report, {test,type}, Rep2), + ?line ok = error_logger:info_report([test,type], Rep3), + reported(info_report, [test,type], Rep3), + ?line ok = error_logger:info_report(1, Rep4), + reported(info_report, 1, Rep4), + + ?line my_yes = error_logger:delete_report_handler(?MODULE), + ok. + +%%----------------------------------------------------------------- + +error(suite) -> []; +error(doc) -> []; +error(Config) when list(Config) -> + ?line error_logger:add_report_handler(?MODULE, self()), + Msg1 = "This is a plain text string~n", + Msg2 = "This is a text with arguments ~p~n", + Arg2 = "This is the argument", + Msg3 = {erroneous,msg}, + + ?line ok = error_logger:error_msg(Msg1), + reported(error, Msg1, []), + ?line ok = error_logger:error_msg(Msg2, Arg2), + reported(error, Msg2, Arg2), + ?line ok = error_logger:error_msg(Msg3), + reported(error, Msg3, []), + + ?line ok = error_logger:error_msg(Msg1, []), + reported(error, Msg1, []), + ?line ok = error_logger:error_msg(Msg2, Arg2), + reported(error, Msg2, Arg2), + ?line ok = error_logger:error_msg(Msg3, []), + reported(error, Msg3, []), + + ?line ok = error_logger:format(Msg1, []), + reported(error, Msg1, []), + ?line ok = error_logger:format(Msg2, Arg2), + reported(error, Msg2, Arg2), + ?line ok = error_logger:format(Msg3, []), + reported(error, Msg3, []), + + ?line my_yes = error_logger:delete_report_handler(?MODULE), + ok. + +%%----------------------------------------------------------------- + +info(suite) -> []; +info(doc) -> []; +info(Config) when list(Config) -> + ?line error_logger:add_report_handler(?MODULE, self()), + Msg1 = "This is a plain text string~n", + Msg2 = "This is a text with arguments ~p~n", + Arg2 = "This is the argument", + Msg3 = {erroneous,msg}, + + ?line ok = error_logger:info_msg(Msg1), + reported(info_msg, Msg1, []), + ?line ok = error_logger:info_msg(Msg2, Arg2), + reported(info_msg, Msg2, Arg2), + ?line ok = error_logger:info_msg(Msg3), + reported(info_msg, Msg3, []), + + ?line ok = error_logger:info_msg(Msg1, []), + reported(info_msg, Msg1, []), + ?line ok = error_logger:info_msg(Msg2, Arg2), + reported(info_msg, Msg2, Arg2), + ?line ok = error_logger:info_msg(Msg3, []), + reported(info_msg, Msg3, []), + + ?line my_yes = error_logger:delete_report_handler(?MODULE), + ok. + +%%----------------------------------------------------------------- + +emulator(suite) -> []; +emulator(doc) -> []; +emulator(Config) when list(Config) -> + ?line error_logger:add_report_handler(?MODULE, self()), + spawn(?MODULE, generate_error, []), + reported(emulator), + ?line my_yes = error_logger:delete_report_handler(?MODULE), + ok. + +generate_error() -> + erlang:error({badmatch,4}). + +%%----------------------------------------------------------------- +%% We don't enables or disables tty error logging here. We do not +%% want to interact with the test run. +%%----------------------------------------------------------------- + +tty(suite) -> []; +tty(doc) -> []; +tty(Config) when is_list(Config) -> + ?line {'EXIT', _Reason} = (catch error_logger:tty(dummy)), + ok. + +%%----------------------------------------------------------------- +%% If where already exists a logfile we skip this test case !! +%%----------------------------------------------------------------- + +logfile(suite) -> []; +logfile(doc) -> []; +logfile(Config) when list(Config) -> + ?line case error_logger:logfile(filename) of + {error, no_log_file} -> % Ok, we continues. + do_logfile(); + _ -> + ok + end. + +do_logfile() -> + ?line {error, _} = error_logger:logfile(close), + ?line {error, _} = error_logger:logfile({open,{error}}), + ?line ok = error_logger:logfile({open, "dummy_logfile.log"}), + ?line "dummy_logfile.log" = error_logger:logfile(filename), + ?line ok = error_logger:logfile(close), + ?line {'EXIT',_} = (catch error_logger:logfile(dummy)), + ok. + +%%----------------------------------------------------------------- + +add(suite) -> []; +add(doc) -> []; +add(Config) when list(Config) -> + ?line {'EXIT',_} = (catch error_logger:add_report_handler("dummy")), + ?line {'EXIT',_} = error_logger:add_report_handler(non_existing), + ?line my_error = error_logger:add_report_handler(?MODULE, [error]), + ok. + +%%----------------------------------------------------------------- + +delete(suite) -> []; +delete(doc) -> []; +delete(Config) when list(Config) -> + ?line {'EXIT',_} = (catch error_logger:delete_report_handler("dummy")), + ?line {error,_} = error_logger:delete_report_handler(non_existing), + ok. + +%%----------------------------------------------------------------- +%% Check that the report has been received. +%%----------------------------------------------------------------- +reported(Tag, Type, Report) -> + receive + {Tag, Type, Report} -> + test_server:messages_get(), + ok + after 1000 -> + test_server:fail(no_report_received) + end. + +reported(emulator) -> + receive + {error, "~s~n", String} when list(String) -> + test_server:messages_get(), + ok + after 1000 -> + test_server:fail(no_report_received) + end. + +%%----------------------------------------------------------------- +%% The error_logger handler (gen_event behaviour). +%% Sends a notification to the Tester process about the events +%% generated by the Tester process. +%%----------------------------------------------------------------- +init(Tester) when pid(Tester) -> + {ok, Tester}; +init(Config) when list(Config) -> + my_error. + +handle_event({Tag, _GL, {_EPid, Type, Report}}, Tester) -> + Tester ! {Tag, Type, Report}, + {ok, Tester}; +handle_event(_Event, Tester) -> + {ok, Tester}. + +handle_info({emulator, _GL, String}, Tester) -> + Tester ! {emulator, String}, + {ok, Tester}; +handle_info(_, Tester) -> + {ok, Tester}. + +handle_call(_Query, Tester) -> {ok, {error, bad_query}, Tester}. + +terminate(_Reason, _Tester) -> + my_yes. diff --git a/lib/kernel/test/error_logger_warn_SUITE.erl b/lib/kernel/test/error_logger_warn_SUITE.erl new file mode 100644 index 0000000000..6629eca1ad --- /dev/null +++ b/lib/kernel/test/error_logger_warn_SUITE.erl @@ -0,0 +1,503 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-2009. 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(error_logger_warn_SUITE). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + basic/1,warnings_info/1,warnings_warnings/1, + rb_basic/1,rb_warnings_info/1,rb_warnings_warnings/1, + rb_trunc/1,rb_utc/1,file_utc/1]). + +%% Internal exports. +-export([init/1,handle_event/2,handle_info/2,handle_call/2]). + +-include("test_server.hrl"). + +-define(EXPECT(Pattern), + (fun() -> + receive + Pattern = X -> + erlang:display({got_expected,?MODULE,?LINE,X}), + ok + after 5000 -> + exit({timeout_in_expect,?MODULE,?LINE}) + end + end)()). + +% Default timetrap timeout (set in init_per_testcase). +-define(default_timeout, ?t:minutes(1)). + + +all(suite) -> + [basic, warnings_info, warnings_warnings, + rb_basic, rb_warnings_info, rb_warnings_warnings, + rb_trunc,rb_utc, file_utc]. + +init_per_testcase(_Case, Config) -> + ?line Dog = ?t:timetrap(?default_timeout), + [{watchdog, Dog} | Config]. +fin_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +basic(doc) -> + ["Tests basic error logger functionality"]; +basic(Config) when is_list(Config) -> + put(elw_config,Config), + basic(). + +warnings_info(doc) -> + ["Tests mapping warnings to info functionality"]; +warnings_info(Config) when is_list(Config) -> + put(elw_config,Config), + warnings_info(). + +warnings_warnings(doc) -> + ["Tests mapping warnings to warnings functionality"]; +warnings_warnings(Config) when is_list(Config) -> + put(elw_config,Config), + warnings_warnings(). + +rb_basic(doc) -> + ["Tests basic rb functionality"]; +rb_basic(Config) when is_list(Config) -> + put(elw_config,Config), + rb_basic(). + +rb_warnings_info(doc) -> + ["Tests warnings as info rb functionality"]; +rb_warnings_info(Config) when is_list(Config) -> + put(elw_config,Config), + rb_warnings_info(). + +rb_warnings_warnings(doc) -> + ["Tests warnings as warnings rb functionality"]; +rb_warnings_warnings(Config) when is_list(Config) -> + put(elw_config,Config), + rb_warnings_warnings(). + +rb_trunc(doc) -> + ["Tests rb functionality on truncated data"]; +rb_trunc(Config) when is_list(Config) -> + put(elw_config,Config), + rb_trunc(). + +rb_utc(doc) -> + ["Tests UTC mapping in rb (-sasl utc_log true)"]; +rb_utc(Config) when is_list(Config) -> + put(elw_config,Config), + rb_utc(). + +file_utc(doc) -> + ["Tests UTC mapping in file logger (-stdlib utc_log true)"]; +file_utc(Config) when is_list(Config) -> + put(elw_config,Config), + file_utc(). + + +% a small gen_event + +init([Pid]) -> + {ok, Pid}. + +handle_event(Event,Pid) -> + Pid ! {handle_event,Event}, + {ok,Pid}. + +handle_info(Unexpected,Pid) -> + Pid ! {unexpected_info,Unexpected}, + {ok,Pid}. + +handle_call(Unexpected, Pid) -> + Pid ! {unexpected_call, Unexpected}, + {ok,Pid}. + +start_node(Name,Args) -> + MyDir = filename:dirname(code:which(?MODULE)), + element(2,test_server:start_node(Name, slave, [{args, Args ++ " -pa " ++ MyDir}])). + +stop_node(Name) -> + test_server:stop_node(Name). + +install_relay(Node) -> + rpc:call(Node,error_logger,add_report_handler,[?MODULE,[self()]]). + + +format(Node,A,B) -> + rpc:call(Node,error_logger,format,[A,B]). +error_msg(Node,A,B) -> + rpc:call(Node,error_logger,error_msg,[A,B]). +error_report(Node,B) -> + rpc:call(Node,error_logger,error_report,[B]). +warning_msg(Node,A,B) -> + rpc:call(Node,error_logger,warning_msg,[A,B]). +warning_report(Node,B) -> + rpc:call(Node,error_logger,warning_report,[B]). +info_msg(Node,A,B) -> + rpc:call(Node,error_logger,info_msg,[A,B]). +info_report(Node,B) -> + rpc:call(Node,error_logger,info_report,[B]). + +nn() -> + error_logger_warn_suite_helper. + + + + +basic() -> + ?line Node = start_node(nn(),[]), + ?line ok = install_relay(Node), + ?line Self = self(), + ?line GL = group_leader(), + ?line format(Node,"~p~n",[Self]), + ?line ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), + ?line error_msg(Node,"~p~n",[Self]), + ?line ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), + ?line warning_msg(Node,"~p~n",[Self]), + ?line ?EXPECT({handle_event,{error,GL,{_,"~p~n",[Self]}}}), + ?line info_msg(Node,"~p~n",[Self]), + ?line ?EXPECT({handle_event,{info_msg,GL,{_,"~p~n",[Self]}}}), + ?line Report = [{self,Self},{gl,GL},make_ref()], + ?line error_report(Node,Report), + ?line ?EXPECT({handle_event,{error_report,GL,{_,std_error,Report}}}), + ?line warning_report(Node,Report), + ?line ?EXPECT({handle_event,{error_report,GL,{_,std_error,Report}}}), + ?line info_report(Node,Report), + ?line ?EXPECT({handle_event,{info_report,GL,{_,std_info,Report}}}), + + ?line stop_node(Node), + ok. + +warnings_info() -> + ?line Node = start_node(nn(),"+Wi"), + ?line ok = install_relay(Node), + ?line Self = self(), + ?line GL = group_leader(), + ?line Report = [{self,Self},{gl,GL},make_ref()], + ?line warning_msg(Node,"~p~n",[Self]), + ?line ?EXPECT({handle_event,{info_msg,GL,{_,"~p~n",[Self]}}}), + ?line warning_report(Node,Report), + ?line ?EXPECT({handle_event,{info_report,GL,{_,std_info,Report}}}), + ?line stop_node(Node), + ok. + +warnings_warnings() -> + ?line Node = start_node(nn(),"+Ww"), + ?line ok = install_relay(Node), + ?line Self = self(), + ?line GL = group_leader(), + ?line Report = [{self,Self},{gl,GL},make_ref()], + ?line warning_msg(Node,"~p~n",[Self]), + ?line ?EXPECT({handle_event,{warning_msg,GL,{_,"~p~n",[Self]}}}), + ?line warning_report(Node,Report), + ?line ?EXPECT({handle_event,{warning_report,GL,{_,std_warning,Report}}}), + ?line stop_node(Node), + ok. + + +% RB... + +quote(String) -> + case os:type() of + {win32,_} -> + "\\\""++String++"\\\""; + _ -> + "'\""++String++"\"'" + end. + +iquote(String) -> + case os:type() of + {win32,_} -> + "\\\""++String++"\\\""; + _ -> + "\""++String++"\"" + end. + +oquote(String) -> + case os:type() of + {win32,_} -> + "\""++String++"\""; + _ -> + "'"++String++"'" + end. + + +findstr(String,FileName) -> + File=binary_to_list(element(2,file:read_file(FileName))), + findstrc(String,File). + +findstrc(String,File) -> + case string:str(File,String) of + N when is_integer(N), + N > 0 -> + S2 = lists:sublist(File,N,length(File)), + case string:str(S2,"\n") of + 0 -> + 1; + M -> + S3 = lists:sublist(S2,M,length(S2)), + 1 + findstrc(String,S3) + end; + _ -> + 0 + end. + +% Doesn't count empty lines +lines(File) -> + length( + string:tokens( + binary_to_list( + element(2,file:read_file(File))), + "\n")). + +%directories anf filenames +ld() -> + Config = get(elw_config), + PrivDir = ?config(priv_dir, Config), + filename:absname(PrivDir). + +lf() -> + filename:join([ld(),"logfile.txt"]). +rd() -> + Config = get(elw_config), + PrivDir = ?config(priv_dir, Config), + LogDir = filename:join(PrivDir,"log"), + file:make_dir(LogDir), + filename:absname(LogDir). +rf() -> + filename:join([rd(),"1"]). + +nice_stop_node(Name) -> + erlang:monitor_node(Name, true), + rpc:call(Name, init, stop, []), + receive + {nodedown,Name} -> ok + end. + +%rensa rd() f�re varje rapport-test s� man bara f�r en fil... +clean_rd() -> + {ok,L} = file:list_dir(rd()), + lists:foreach(fun(F) -> + file:delete(F) + end, + [filename:append(rd(),X) || X <- L]), + ok. + +fake_gl(Node,What,A) -> + Fun = fun() -> + group_leader(self(),self()), + error_logger:What(A) + end, + rpc:call(Node,erlang,apply,[Fun,[]]). +fake_gl(Node,What,A,B) -> + Fun = fun() -> + group_leader(self(),self()), + error_logger:What(A,B) + end, + rpc:call(Node,erlang,apply,[Fun,[]]). + + +one_rb_lines(Param) -> + file:delete(lf()), + rb:start_log(lf()), + apply(rb,show,Param), + rb:stop_log(), + lines(lf()). + +one_rb_findstr(Param,String) -> + file:delete(lf()), + rb:start_log(lf()), + apply(rb,show,Param), + rb:stop_log(), + findstr(String,lf()). + +% Tests +rb_basic() -> + ?line clean_rd(), + % Behold, the magic parameters to activate rb logging... + ?line Node = start_node(nn(),"-boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5"), + ?line Self = self(), + ?line GL = group_leader(), + ?line Report = [{self,Self},{gl,GL},make_ref()], + ?line fake_gl(Node,warning_msg,"~p~n",[Self]), + ?line fake_gl(Node,warning_report,Report), + ?line nice_stop_node(Node), + ?line application:start(sasl), + ?line rb:start([{report_dir, rd()}]), + ?line rb:list(), + ?line true = (one_rb_lines([error]) > 1), + ?line true = (one_rb_lines([error_report]) > 1), + ?line 1 = one_rb_findstr([error],pid_to_list(Self)), + ?line 1 = one_rb_findstr([error_report],pid_to_list(Self)), + ?line 2 = one_rb_findstr([],pid_to_list(Self)), + ?line true = (one_rb_findstr([progress],"===") > 4), + ?line rb:stop(), + ?line application:stop(sasl), + ?line stop_node(Node), + ok. + +rb_warnings_info() -> + ?line clean_rd(), + ?line Node = start_node(nn(),"+W i -boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5"), + ?line Self = self(), + ?line GL = group_leader(), + ?line Report = [{self,Self},{gl,GL},make_ref()], + ?line fake_gl(Node,warning_msg,"~p~n",[Self]), + ?line fake_gl(Node,warning_report,Report), + ?line nice_stop_node(Node), + ?line application:start(sasl), + ?line rb:start([{report_dir, rd()}]), + ?line rb:list(), + ?line true = (one_rb_lines([error]) =:= 0), + ?line true = (one_rb_lines([error_report]) =:= 0), + ?line 0 = one_rb_findstr([error],pid_to_list(Self)), + ?line 0 = one_rb_findstr([error_report],pid_to_list(Self)), + ?line 0 = one_rb_findstr([warning_msg],pid_to_list(Self)), + ?line 0 = one_rb_findstr([warning_report],pid_to_list(Self)), + ?line 1 = one_rb_findstr([info_msg],pid_to_list(Self)), + ?line 1 = one_rb_findstr([info_report],pid_to_list(Self)), + ?line 2 = one_rb_findstr([],pid_to_list(Self)), + ?line true = (one_rb_findstr([progress],"===") > 4), + ?line rb:stop(), + ?line application:stop(sasl), + ?line stop_node(Node), + ok. + +rb_warnings_warnings() -> + ?line clean_rd(), + ?line Node = start_node(nn(),"+W w -boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5"), + ?line Self = self(), + ?line GL = group_leader(), + ?line Report = [{self,Self},{gl,GL},make_ref()], + ?line fake_gl(Node,warning_msg,"~p~n",[Self]), + ?line fake_gl(Node,warning_report,Report), + ?line nice_stop_node(Node), + ?line application:start(sasl), + ?line rb:start([{report_dir, rd()}]), + ?line rb:list(), + ?line true = (one_rb_lines([error]) =:= 0), + ?line true = (one_rb_lines([error_report]) =:= 0), + ?line 0 = one_rb_findstr([error],pid_to_list(Self)), + ?line 0 = one_rb_findstr([error_report],pid_to_list(Self)), + ?line 1 = one_rb_findstr([warning_msg],pid_to_list(Self)), + ?line 1 = one_rb_findstr([warning_report],pid_to_list(Self)), + ?line 0 = one_rb_findstr([info_msg],pid_to_list(Self)), + ?line 0 = one_rb_findstr([info_report],pid_to_list(Self)), + ?line 2 = one_rb_findstr([],pid_to_list(Self)), + ?line true = (one_rb_findstr([progress],"===") > 4), + ?line rb:stop(), + ?line application:stop(sasl), + ?line stop_node(Node), + ok. + +rb_trunc() -> + ?line clean_rd(), + ?line Node = start_node(nn(),"+W w -boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5"), + ?line Self = self(), + ?line GL = group_leader(), + ?line Report = [{self,Self},{gl,GL},make_ref()], + ?line fake_gl(Node,warning_msg,"~p~n",[Self]), + ?line fake_gl(Node,warning_report,Report), + ?line nice_stop_node(Node), + ?line application:start(sasl), + ?line {ok,File} = file:read_file(rf()), + ?line S=byte_size(File)-2, + ?line <<TFile:S/binary,_/binary>>=File, + ?line file:write_file(rf(),TFile), + ?line rb:start([{report_dir, rd()}]), + ?line rb:list(), + ?line true = (one_rb_lines([error]) =:= 0), + ?line true = (one_rb_lines([error_report]) =:= 0), + ?line 0 = one_rb_findstr([error],pid_to_list(Self)), + ?line 0 = one_rb_findstr([error_report],pid_to_list(Self)), + ?line 1 = one_rb_findstr([warning_msg],pid_to_list(Self)), + ?line 0 = one_rb_findstr([warning_report],pid_to_list(Self)), + ?line 0 = one_rb_findstr([info_msg],pid_to_list(Self)), + ?line 0 = one_rb_findstr([info_report],pid_to_list(Self)), + ?line 1 = one_rb_findstr([],pid_to_list(Self)), + ?line true = (one_rb_findstr([progress],"===") > 4), + ?line rb:stop(), + ?line application:stop(sasl), + ?line stop_node(Node), + ok. + +rb_utc() -> + ?line clean_rd(), + ?line Node = start_node(nn(),"+W w -boot start_sasl -sasl error_logger_mf_dir "++ + quote(rd())++" error_logger_mf_maxbytes 5000 " + "error_logger_mf_maxfiles 5 -sasl utc_log true"), + ?line Self = self(), + ?line GL = group_leader(), + ?line Report = [{self,Self},{gl,GL},make_ref()], + ?line fake_gl(Node,warning_msg,"~p~n",[Self]), + ?line fake_gl(Node,warning_report,Report), + ?line nice_stop_node(Node), + ?line application:stop(sasl), + ?line UtcLog=case application:get_env(sasl,utc_log) of + {ok,true} -> + true; + _AllOthers -> + application:set_env(sasl,utc_log,true), + false + end, + ?line application:start(sasl), + ?line rb:start([{report_dir, rd()}]), + ?line rb:list(), + ?line Pr=one_rb_findstr([progress],"==="), + ?line Wm=one_rb_findstr([warning_msg],"==="), + ?line Wr=one_rb_findstr([warning_report],"==="), + ?line Sum=Pr+Wm+Wr, + ?line Sum=one_rb_findstr([],"UTC"), + ?line rb:stop(), + ?line application:stop(sasl), + ?line application:set_env(sasl,utc_log,UtcLog), + ?line stop_node(Node), + ok. + +file_utc() -> + ?line file:delete(lf()), + ?line SS="+W w -stdlib utc_log true -kernel error_logger "++ oquote("{file,"++iquote(lf())++"}"), + %erlang:display(SS), + ?line Node = start_node(nn(),SS), + %erlang:display(rpc:call(Node,application,get_env,[kernel,error_logger])), + ?line Self = self(), + ?line GL = group_leader(), + ?line fake_gl(Node,error_msg,"~p~n",[Self]), + ?line fake_gl(Node,warning_msg,"~p~n",[Self]), + ?line fake_gl(Node,info_msg,"~p~n",[Self]), + ?line Report = [{self,Self},{gl,GL},make_ref()], + ?line fake_gl(Node,error_report,Report), + ?line fake_gl(Node,warning_report,Report), + ?line fake_gl(Node,info_report,Report), + ?line nice_stop_node(Node), + ?line receive after 5000 -> ok end, % Let the node die, needed + ?line 6 = findstr("UTC",lf()), + ?line 2 = findstr("WARNING",lf()), + ?line 2 = findstr("ERROR",lf()), + ?line 2 = findstr("INFO",lf()), + ?line stop_node(Node), + ok. diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl new file mode 100644 index 0000000000..c645d0f842 --- /dev/null +++ b/lib/kernel/test/file_SUITE.erl @@ -0,0 +1,3716 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. 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% +%% + +%% This is a developement feature when developing a new file module, +%% ugly but practical. +-ifndef(FILE_MODULE). +-define(FILE_MODULE, file). +-endif. +-ifndef(FILE_SUITE). +-define(FILE_SUITE, file_SUITE). +-endif. +-ifndef(FILE_INIT). +-define(FILE_INIT(Config), Config). +-endif. +-ifndef(FILE_FINI). +-define(FILE_FINI(Config), Config). +-endif. +-ifndef(FILE_INIT_PER_TESTCASE). +-define(FILE_INIT_PER_TESTCASE(Config), Config). +-endif. +-ifndef(FILE_FIN_PER_TESTCASE). +-define(FILE_FIN_PER_TESTCASE(Config), Config). +-endif. + +-module(?FILE_SUITE). + +-export([all/1, + init/1, fini/1, + init_per_testcase/2, fin_per_testcase/2, + read_write_file/1, dirs/1, files/1, names/1]). +-export([cur_dir_0/1, cur_dir_1/1, make_del_dir/1, + pos/1, pos1/1, pos2/1]). +-export([close/1, consult/1, consult1/1, path_consult/1, delete/1]). +-export([eval/1, eval1/1, path_eval/1, script/1, script1/1, path_script/1, + open/1, open1/1, + old_modes/1, new_modes/1, path_open/1, open_errors/1]). +-export([file_info/1, file_info_basic_file/1, file_info_basic_directory/1, + file_info_bad/1, file_info_times/1, file_write_file_info/1]). +-export([rename/1, access/1, truncate/1, sync/1, + read_write/1, pread_write/1, append/1]). +-export([errors/1, e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]). +-export([otp_5814/1]). + +-export([compression/1, read_not_really_compressed/1, + read_compressed_cooked/1, read_compressed_cooked_binary/1, + read_cooked_tar_problem/1, + write_compressed/1, compress_errors/1, catenated_gzips/1]). + +-export([links/1, make_link/1, read_link_info_for_non_link/1, symlinks/1]). + +-export([copy/1]). + +-export([new_slave/2, old_slave/2, run_test/2]). + +-export([delayed_write/1, read_ahead/1, segment_read/1, segment_write/1]). + +-export([ipread/1]). + +-export([pid2name/1]). + +-export([interleaved_read_write/1]). + +-export([altname/1]). + +-export([large_file/1]). + +-export([read_line_1/1, read_line_2/1, read_line_3/1,read_line_4/1]). + +%% Debug exports +-export([create_file_slow/2, create_file/2, create_bin/2]). +-export([verify_file/2, verify_bin/3]). +-export([bytes/2, iterate/3]). + + + +-include("test_server.hrl"). +-include_lib("kernel/include/file.hrl"). + + + +all(suite) -> + {conf, init, + [altname, read_write_file, dirs, files, + delete, rename, names, errors, + compression, links, copy, + delayed_write, read_ahead, segment_read, segment_write, + ipread, pid2name, interleaved_read_write, + otp_5814, large_file, read_line_1, read_line_2, read_line_3, read_line_4], + fini}. + +init(Config) when is_list(Config) -> + case os:type() of + {win32, _} -> + Priv = ?config(priv_dir, Config), + HasAccessTime = + case ?FILE_MODULE:read_file_info(Priv) of + {ok, #file_info{atime={_, {0, 0, 0}}}} -> + %% This is a unfortunately a FAT file system. + [no_access_time]; + {ok, _} -> + [] + end, + ?FILE_INIT(HasAccessTime++Config); + _ -> + ?FILE_INIT(Config) + end. + +fini(Config) when is_list(Config) -> + case os:type() of + {win32, _} -> + os:cmd("subst z: /d"); + _ -> + ok + end, + ?FILE_FINI(Config). + +init_per_testcase(_Func, Config) -> + %%error_logger:info_msg("~p:~p *****~n", [?MODULE, _Func]), + ?FILE_INIT_PER_TESTCASE(Config). + +fin_per_testcase(_Func, Config) -> + %% error_logger:info_msg("~p:~p END *****~n", [?MODULE, _Func]), + ?FILE_FIN_PER_TESTCASE(Config). + +%% Matches a term (the last) against alternatives +expect(X, _, X) -> + X; +expect(_, X, X) -> + X. + +expect(X, _, _, X) -> + X; +expect(_, X, _, X) -> + X; +expect(_, _, X, X) -> + X. + +expect(X, _, _, _, X) -> + X; +expect(_, X, _, _, X) -> + X; +expect(_, _, X, _, X) -> + X; +expect(_, _, _, X, X) -> + X. + +%% Calculate the time difference +time_dist({YY, MM, DD, H, M, S}, DT) -> + time_dist({{YY, MM, DD}, {H, M, S}}, DT); +time_dist(DT, {YY, MM, DD, H, M, S}) -> + time_dist(DT, {{YY, MM, DD}, {H, M, S}}); +time_dist({_D1, _T1} = DT1, {_D2, _T2} = DT2) -> + calendar:datetime_to_gregorian_seconds(DT2) + - calendar:datetime_to_gregorian_seconds(DT1). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +read_write_file(suite) -> []; +read_write_file(doc) -> []; +read_write_file(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_read_write_file"), + + %% Try writing and reading back some term + ?line SomeTerm = {"This term",{will,be},[written,$t,$o],1,file,[]}, + ?line ok = ?FILE_MODULE:write_file(Name,term_to_binary(SomeTerm)), + ?line {ok,Bin1} = ?FILE_MODULE:read_file(Name), + ?line SomeTerm = binary_to_term(Bin1), + + %% Try a "null" term + ?line NullTerm = [], + ?line ok = ?FILE_MODULE:write_file(Name,term_to_binary(NullTerm)), + ?line {ok,Bin2} = ?FILE_MODULE:read_file(Name), + ?line NullTerm = binary_to_term(Bin2), + + %% Try some "complicated" types + ?line BigNum = 123456789012345678901234567890, + ?line ComplTerm = {self(),make_ref(),BigNum,3.14159}, + ?line ok = ?FILE_MODULE:write_file(Name,term_to_binary(ComplTerm)), + ?line {ok,Bin3} = ?FILE_MODULE:read_file(Name), + ?line ComplTerm = binary_to_term(Bin3), + + %% Try reading a nonexistent file + ?line Name2 = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_nonexistent_file"), + ?line {error, enoent} = ?FILE_MODULE:read_file(Name2), + ?line {error, enoent} = ?FILE_MODULE:read_file(""), + ?line {error, enoent} = ?FILE_MODULE:read_file(''), + + % Try writing to a bad filename + ?line {error, enoent} = + ?FILE_MODULE:write_file("",term_to_binary(NullTerm)), + + % Try writing something else than a binary + ?line {error, badarg} = ?FILE_MODULE:write_file(Name,{1,2,3}), + ?line {error, badarg} = ?FILE_MODULE:write_file(Name,self()), + + %% Some non-term binaries + ?line ok = ?FILE_MODULE:write_file(Name,[]), + ?line {ok,Bin4} = ?FILE_MODULE:read_file(Name), + ?line 0 = byte_size(Bin4), + + ?line ok = ?FILE_MODULE:write_file(Name,[Bin1,[],[[Bin2]]]), + ?line {ok,Bin5} = ?FILE_MODULE:read_file(Name), + ?line {Bin1,Bin2} = split_binary(Bin5,byte_size(Bin1)), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +dirs(suite) -> [make_del_dir, cur_dir_0, cur_dir_1]. + +make_del_dir(suite) -> []; +make_del_dir(doc) -> []; +make_del_dir(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_mk-dir"), + ?line ok = ?FILE_MODULE:make_dir(NewDir), + ?line {error, eexist} = ?FILE_MODULE:make_dir(NewDir), + ?line ok = ?FILE_MODULE:del_dir(NewDir), + ?line {error, enoent} = ?FILE_MODULE:del_dir(NewDir), + + %% Check that we get an error when trying to create... + %% a deep directory + ?line NewDir2 = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_mk-dir/foo"), + ?line {error, enoent} = ?FILE_MODULE:make_dir(NewDir2), + %% a nameless directory + ?line {error, enoent} = ?FILE_MODULE:make_dir(""), + %% a directory with illegal name + ?line {error, badarg} = ?FILE_MODULE:make_dir({1,2,3}), + + %% a directory with illegal name, even if it's a (bad) list + ?line {error, badarg} = ?FILE_MODULE:make_dir([1,2,3,{}]), + + %% Maybe this isn't an error, exactly, but worth mentioning anyway: + %% ok = ?FILE_MODULE:make_dir([$f,$o,$o,0,$b,$a,$r])), + %% The above line works, and created a directory "./foo" + %% More elegant would maybe have been to fail, or to really create + %% a directory, but with a name that incorporates the "bar" part of + %% the list, so that [$f,$o,$o,0,$f,$o,$o] wouldn't refer to the same + %% dir. But this would slow it down. + + %% Try deleting some bad directories + %% Deleting the parent directory to the current, sounds dangerous, huh? + %% Don't worry ;-) the parent directory should never be empty, right? + ?line {error, eexist} = ?FILE_MODULE:del_dir('..'), + ?line {error, enoent} = ?FILE_MODULE:del_dir(""), + ?line {error, badarg} = ?FILE_MODULE:del_dir([3,2,1,{}]), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +cur_dir_0(suite) -> []; +cur_dir_0(doc) -> []; +cur_dir_0(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + %% Find out the current dir, and cd to it ;-) + ?line {ok,BaseDir} = ?FILE_MODULE:get_cwd(), + ?line Dir1 = BaseDir ++ "", %% Check that it's a string + ?line ok = ?FILE_MODULE:set_cwd(Dir1), + + %% Make a new dir, and cd to that + ?line RootDir = ?config(priv_dir,Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_curdir"), + ?line ok = ?FILE_MODULE:make_dir(NewDir), + ?line io:format("cd to ~s",[NewDir]), + ?line ok = ?FILE_MODULE:set_cwd(NewDir), + + %% Create a file in the new current directory, and check that it + %% really is created there + ?line UncommonName = "uncommon.fil", + ?line {ok,Fd} = ?FILE_MODULE:open(UncommonName,read_write), + ?line ok = ?FILE_MODULE:close(Fd), + ?line {ok,NewDirFiles} = ?FILE_MODULE:list_dir("."), + ?line true = lists:member(UncommonName,NewDirFiles), + + %% Delete the directory and return to the old current directory + %% and check that the created file isn't there (too!) + ?line expect({error, einval}, {error, eacces}, + ?FILE_MODULE:del_dir(NewDir)), + ?line ?FILE_MODULE:delete(UncommonName), + ?line {ok,[]} = ?FILE_MODULE:list_dir("."), + ?line ok = ?FILE_MODULE:set_cwd(Dir1), + ?line io:format("cd back to ~s",[Dir1]), + ?line ok = ?FILE_MODULE:del_dir(NewDir), + ?line {error, enoent} = ?FILE_MODULE:set_cwd(NewDir), + ?line ok = ?FILE_MODULE:set_cwd(Dir1), + ?line io:format("cd back to ~s",[Dir1]), + ?line {ok,OldDirFiles} = ?FILE_MODULE:list_dir("."), + ?line false = lists:member(UncommonName,OldDirFiles), + + %% Try doing some bad things + ?line {error, badarg} = ?FILE_MODULE:set_cwd({foo,bar}), + ?line {error, enoent} = ?FILE_MODULE:set_cwd(""), + ?line {error, enoent} = ?FILE_MODULE:set_cwd(".......a......"), + ?line {ok,BaseDir} = ?FILE_MODULE:get_cwd(), %% Still there? + + %% On Windows, there should only be slashes, no backslashes, + %% in the return value of get_cwd(). + %% (The test is harmless on Unix, because filenames usually + %% don't contain backslashes.) + + ?line {ok, BaseDir} = ?FILE_MODULE:get_cwd(), + ?line false = lists:member($\\, BaseDir), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests ?FILE_MODULE:get_cwd/1. + +cur_dir_1(suite) -> []; +cur_dir_1(doc) -> []; +cur_dir_1(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + + ?line case os:type() of + {unix, _} -> + ?line {error, enotsup} = ?FILE_MODULE:get_cwd("d:"); + vxworks -> + ?line {error, enotsup} = ?FILE_MODULE:get_cwd("d:"); + {win32, _} -> + win_cur_dir_1(Config) + end, + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +win_cur_dir_1(_Config) -> + ?line {ok,BaseDir} = ?FILE_MODULE:get_cwd(), + + %% Get the drive letter from the current directory, + %% and try to get current directory for that drive. + + ?line [Drive,$:|_] = BaseDir, + ?line {ok,BaseDir} = ?FILE_MODULE:get_cwd([Drive,$:]), + io:format("BaseDir = ~s\n", [BaseDir]), + + %% Unfortunately, there is no way to move away from the + %% current drive as we can't use the "subst" command from + %% a SSH connection. We can't test any more. + + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +files(suite) -> [open,pos,file_info,consult,eval,script,truncate,sync]. + +open(suite) -> [open1,old_modes,new_modes,path_open,close,access,read_write, + pread_write,append,open_errors]. + +open1(suite) -> []; +open1(doc) -> []; +open1(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_files"), + ?line ok = ?FILE_MODULE:make_dir(NewDir), + ?line Name = filename:join(NewDir, "foo1.fil"), + ?line {ok,Fd1} = ?FILE_MODULE:open(Name,read_write), + ?line {ok,Fd2} = ?FILE_MODULE:open(Name,read), + ?line Str = "{a,tuple}.\n", + ?line io:format(Fd1,Str,[]), + ?line {ok,0} = ?FILE_MODULE:position(Fd1,bof), + ?line Str = io:get_line(Fd1,''), + ?line Str = io:get_line(Fd2,''), + ?line ok = ?FILE_MODULE:close(Fd2), + ?line {ok,0} = ?FILE_MODULE:position(Fd1,bof), + ?line ok = ?FILE_MODULE:truncate(Fd1), + ?line eof = io:get_line(Fd1,''), + ?line ok = ?FILE_MODULE:close(Fd1), + ?line {ok,Fd3} = ?FILE_MODULE:open(Name,read), + ?line eof = io:get_line(Fd3,''), + ?line ok = ?FILE_MODULE:close(Fd3), + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests all open modes. + +old_modes(suite) -> []; +old_modes(doc) -> []; +old_modes(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_old_open_modes"), + ?line ok = ?FILE_MODULE:make_dir(NewDir), + ?line Name1 = filename:join(NewDir, "foo1.fil"), + ?line Marker = "hello, world", + + %% write + ?line {ok, Fd1} = ?FILE_MODULE:open(Name1, write), + ?line ok = io:write(Fd1, Marker), + ?line ok = io:put_chars(Fd1, ".\n"), + ?line ok = ?FILE_MODULE:close(Fd1), + + %% read + ?line {ok, Fd2} = ?FILE_MODULE:open(Name1, read), + ?line {ok, Marker} = io:read(Fd2, prompt), + ?line ok = ?FILE_MODULE:close(Fd2), + + %% read_write + ?line {ok, Fd3} = ?FILE_MODULE:open(Name1, read_write), + ?line {ok, Marker} = io:read(Fd3, prompt), + ?line ok = io:write(Fd3, Marker), + ?line ok = ?FILE_MODULE:close(Fd3), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + + +new_modes(suite) -> []; +new_modes(doc) -> []; +new_modes(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_new_open_modes"), + ?line ok = ?FILE_MODULE:make_dir(NewDir), + ?line Name1 = filename:join(NewDir, "foo1.fil"), + ?line Marker = "hello, world", + + %% write + ?line {ok, Fd1} = ?FILE_MODULE:open(Name1, [write]), + ?line ok = io:write(Fd1, Marker), + ?line ok = io:put_chars(Fd1, ".\n"), + ?line ok = ?FILE_MODULE:close(Fd1), + + %% read + ?line {ok, Fd2} = ?FILE_MODULE:open(Name1, [read]), + ?line {ok, Marker} = io:read(Fd2, prompt), + ?line ok = ?FILE_MODULE:close(Fd2), + + %% read and write + ?line {ok, Fd3} = ?FILE_MODULE:open(Name1, [read, write]), + ?line {ok, Marker} = io:read(Fd3, prompt), + ?line ok = io:write(Fd3, Marker), + ?line ok = ?FILE_MODULE:close(Fd3), + + %% read by default + ?line {ok, Fd4} = ?FILE_MODULE:open(Name1, []), + ?line {ok, Marker} = io:read(Fd4, prompt), + ?line ok = ?FILE_MODULE:close(Fd4), + + %% read and binary + ?line {ok, Fd5} = ?FILE_MODULE:open(Name1, [read, binary]), + ?line {ok, Marker} = io:read(Fd5, prompt), + ?line ok = ?FILE_MODULE:close(Fd5), + + %% read, raw + ?line {ok, Fd6} = ?FILE_MODULE:open(Name1, [read, raw]), + ?line {ok, [$\[]} = ?FILE_MODULE:read(Fd6, 1), + ?line ok = ?FILE_MODULE:close(Fd6), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +path_open(suite) -> []; +path_open(doc) -> []; +path_open(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_path_open"), + ?line ok = ?FILE_MODULE:make_dir(NewDir), + ?line FileName = "path_open.fil", + ?line Name = filename:join(RootDir, FileName), + ?line {ok,Fd1,_FullName1} = + ?FILE_MODULE:path_open( + [RootDir, + "nosuch1", + NewDir],FileName,write), + ?line io:format(Fd1,"ABCDEFGH",[]), + ?line ok = ?FILE_MODULE:close(Fd1), + + %% locate it in the last dir + ?line {ok,Fd2,_FullName2} = + ?FILE_MODULE:path_open( + ["nosuch1", + NewDir, + RootDir],FileName,read), + ?line {ok,2} = + ?FILE_MODULE:position(Fd2,2), "C" = io:get_chars(Fd2,'',1), + ?line ok = ?FILE_MODULE:close(Fd2), + %% Try a failing path + ?line {error, enoent} = ?FILE_MODULE:path_open( + ["nosuch1", + NewDir],FileName,read), + %% Check that it's found regardless of path, if an absolute name given + ?line {ok,Fd3,_FullPath3} = + ?FILE_MODULE:path_open( + ["nosuch1", + NewDir],Name,read), + ?line {ok,2} = + ?FILE_MODULE:position(Fd3,2), "C" = io:get_chars(Fd3,'',1), + ?line ok = ?FILE_MODULE:close(Fd3), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +close(suite) -> []; +close(doc) -> []; +close(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_close.fil"), + ?line {ok,Fd1} = ?FILE_MODULE:open(Name,read_write), + %% Just closing it is no fun, we did that a million times already + %% This is a common error, for code written before Erlang 4.3 + %% bacause then ?FILE_MODULE:open just returned a Pid, and not everyone + %% really checked what they got. + ?line {'EXIT',_Msg} = (catch ok = ?FILE_MODULE:close({ok,Fd1})), + ?line ok = ?FILE_MODULE:close(Fd1), + + %% Try closing one more time + ?line Val = ?FILE_MODULE:close(Fd1), + ?line io:format("Second close gave: ~p",[Val]), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +access(suite) -> []; +access(doc) -> []; +access(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_access.fil"), + ?line Str = "ABCDEFGH", + ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write), + ?line io:format(Fd1,Str,[]), + ?line ok = ?FILE_MODULE:close(Fd1), + %% Check that we can't write when in read only mode + ?line {ok,Fd2} = ?FILE_MODULE:open(Name,read), + ?line case catch io:format(Fd2,"XXXX",[]) of + ok -> + test_server:fail({format,write}); + _ -> + ok + end, + ?line ok = ?FILE_MODULE:close(Fd2), + ?line {ok,Fd3} = ?FILE_MODULE:open(Name,read), + ?line Str = io:get_line(Fd3,''), + ?line ok = ?FILE_MODULE:close(Fd3), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests ?FILE_MODULE:read/2 and ?FILE_MODULE:write/2. + +read_write(suite) -> []; +read_write(doc) -> []; +read_write(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_read_write"), + ?line ok = ?FILE_MODULE:make_dir(NewDir), + ?line Marker = "hello, world", + ?line MarkerB = list_to_binary(Marker), + + %% Plain file. + ?line Name1 = filename:join(NewDir, "plain.fil"), + ?line {ok, Fd1} = ?FILE_MODULE:open(Name1, [read, write]), + ?line read_write_test(Fd1, Marker, []), + + %% Raw file. + ?line Name2 = filename:join(NewDir, "raw.fil"), + ?line {ok, Fd2} = ?FILE_MODULE:open(Name2, [read, write, raw]), + ?line read_write_test(Fd2, Marker, []), + + %% Plain binary file. + ?line Name3 = filename:join(NewDir, "plain-b.fil"), + ?line {ok, Fd3} = ?FILE_MODULE:open(Name3, [read, write, binary]), + ?line read_write_test(Fd3, MarkerB, <<>>), + + %% Raw binary file. + ?line Name4 = filename:join(NewDir, "raw-b.fil"), + ?line {ok, Fd4} = ?FILE_MODULE:open(Name4, [read, write, raw, binary]), + ?line read_write_test(Fd4, MarkerB, <<>>), + + ?line test_server:timetrap_cancel(Dog), + ok. + +read_write_test(File, Marker, Empty) -> + ?line ok = ?FILE_MODULE:write(File, Marker), + ?line {ok, 0} = ?FILE_MODULE:position(File, 0), + ?line {ok, Empty} = ?FILE_MODULE:read(File, 0), + ?line {ok, Marker} = ?FILE_MODULE:read(File, 100), + ?line eof = ?FILE_MODULE:read(File, 100), + ?line {ok, Empty} = ?FILE_MODULE:read(File, 0), + ?line ok = ?FILE_MODULE:close(File), + ?line [] = flush(), + ok. + + +%% Tests ?FILE_MODULE:pread/2 and ?FILE_MODULE:pwrite/2. + +pread_write(suite) -> []; +pread_write(doc) -> []; +pread_write(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_pread_write"), + ?line ok = ?FILE_MODULE:make_dir(NewDir), + ?line List = "hello, world", + ?line Bin = list_to_binary(List), + + %% Plain file. + ?line Name1 = filename:join(NewDir, "plain.fil"), + ?line {ok, Fd1} = ?FILE_MODULE:open(Name1, [read, write]), + ?line pread_write_test(Fd1, List), + + %% Raw file. + ?line Name2 = filename:join(NewDir, "raw.fil"), + ?line {ok, Fd2} = ?FILE_MODULE:open(Name2, [read, write, raw]), + ?line pread_write_test(Fd2, List), + + %% Plain file. Binary mode. + ?line Name3 = filename:join(NewDir, "plain-binary.fil"), + ?line {ok, Fd3} = ?FILE_MODULE:open(Name3, [binary, read, write]), + ?line pread_write_test(Fd3, Bin), + + %% Raw file. Binary mode. + ?line Name4 = filename:join(NewDir, "raw-binary.fil"), + ?line {ok, Fd4} = ?FILE_MODULE:open(Name4, [binary, read, write, raw]), + ?line pread_write_test(Fd4, Bin), + + ?line test_server:timetrap_cancel(Dog), + ok. + +pread_write_test(File, Data) -> + ?line io:format("~p:pread_write_test(~p,~p)~n", [?MODULE, File, Data]), + ?line Size = if is_binary(Data) -> byte_size(Data); + is_list(Data) -> length(Data) + end, + ?line I = Size + 17, + ?line ok = ?FILE_MODULE:pwrite(File, 0, Data), + Res = ?FILE_MODULE:pread(File, 0, I), + ?line {ok, Data} = Res, + ?line eof = ?FILE_MODULE:pread(File, I, 1), + ?line ok = ?FILE_MODULE:pwrite(File, [{0, Data}, {I, Data}]), + ?line {ok, [Data, eof, Data]} = + ?FILE_MODULE:pread(File, [{0, Size}, {2*I, 1}, {I, Size}]), + ?line Plist = lists:seq(21*I, 0, -I), + ?line Pwrite = lists:map(fun(P)->{P,Data}end, Plist), + ?line Pread = [{22*I,Size} | lists:map(fun(P)->{P,Size}end, Plist)], + ?line Presult = [eof | lists:map(fun(_)->Data end, Plist)], + ?line ok = ?FILE_MODULE:pwrite(File, Pwrite), + ?line {ok, Presult} = ?FILE_MODULE:pread(File, Pread), + ?line ok = ?FILE_MODULE:close(File), + ?line [] = flush(), + ok. + +append(doc) -> "Test appending to a file."; +append(suite) -> []; +append(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_append"), + ?line ok = ?FILE_MODULE:make_dir(NewDir), + + ?line First = "First line\n", + ?line Second = "Seond lines comes here\n", + ?line Third = "And here is the third line\n", + + %% Write a small text file. + ?line Name1 = filename:join(NewDir, "a_file.txt"), + ?line {ok, Fd1} = ?FILE_MODULE:open(Name1, [write]), + ?line ok = io:format(Fd1, First, []), + ?line ok = io:format(Fd1, Second, []), + ?line ok = ?FILE_MODULE:close(Fd1), + + %% Open it a again and a append a line to it. + ?line {ok, Fd2} = ?FILE_MODULE:open(Name1, [append]), + ?line ok = io:format(Fd2, Third, []), + ?line ok = ?FILE_MODULE:close(Fd2), + + %% Read it back and verify. + ?line Expected = list_to_binary([First, Second, Third]), + ?line {ok, Expected} = ?FILE_MODULE:read_file(Name1), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +open_errors(suite) -> []; +open_errors(doc) -> []; +open_errors(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line DataDir = + filename:dirname( + filename:join(?config(data_dir, Config), "x")), + ?line DataDirSlash = DataDir++"/", + ?line {error, E1} = ?FILE_MODULE:open(DataDir, [read]), + ?line {error, E2} = ?FILE_MODULE:open(DataDirSlash, [read]), + ?line {error, E3} = ?FILE_MODULE:open(DataDir, [write]), + ?line {error, E4} = ?FILE_MODULE:open(DataDirSlash, [write]), + ?line {eisdir,eisdir,eisdir,eisdir} = {E1,E2,E3,E4}, + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +pos(suite) -> [pos1,pos2]. + +pos1(suite) -> []; +pos1(doc) -> []; +pos1(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_pos1.fil"), + ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write), + ?line io:format(Fd1,"ABCDEFGH",[]), + ?line ok = ?FILE_MODULE:close(Fd1), + ?line {ok,Fd2} = ?FILE_MODULE:open(Name,read), + + %% Start pos is first char + ?line io:format("Relative positions"), + ?line "A" = io:get_chars(Fd2,'',1), + ?line {ok,2} = ?FILE_MODULE:position(Fd2,{cur,1}), + ?line "C" = io:get_chars(Fd2,'',1), + ?line {ok,0} = ?FILE_MODULE:position(Fd2,{cur,-3}), + ?line "A" = io:get_chars(Fd2,'',1), + %% Backwards from first char should be an error + ?line {ok,0} = ?FILE_MODULE:position(Fd2,{cur,-1}), + ?line {error, einval} = ?FILE_MODULE:position(Fd2,{cur,-1}), + %% Reset position and move again + ?line {ok,0} = ?FILE_MODULE:position(Fd2,0), + ?line {ok,2} = ?FILE_MODULE:position(Fd2,{cur,2}), + ?line "C" = io:get_chars(Fd2,'',1), + %% Go a lot forwards + ?line {ok,13} = ?FILE_MODULE:position(Fd2,{cur,10}), + ?line eof = io:get_chars(Fd2,'',1), + + %% Try some fixed positions + ?line io:format("Fixed positions"), + ?line {ok,8} = + ?FILE_MODULE:position(Fd2,8), eof = io:get_chars(Fd2,'',1), + ?line {ok,8} = + ?FILE_MODULE:position(Fd2,cur), eof = io:get_chars(Fd2,'',1), + ?line {ok,7} = + ?FILE_MODULE:position(Fd2,7), "H" = io:get_chars(Fd2,'',1), + ?line {ok,0} = + ?FILE_MODULE:position(Fd2,0), "A" = io:get_chars(Fd2,'',1), + ?line {ok,3} = + ?FILE_MODULE:position(Fd2,3), "D" = io:get_chars(Fd2,'',1), + ?line {ok,12} = + ?FILE_MODULE:position(Fd2,12), eof = io:get_chars(Fd2,'',1), + ?line {ok,3} = + ?FILE_MODULE:position(Fd2,3), "D" = io:get_chars(Fd2,'',1), + %% Try the {bof,X} notation + ?line {ok,3} = ?FILE_MODULE:position(Fd2,{bof,3}), + ?line "D" = io:get_chars(Fd2,'',1), + + %% Try eof positions + ?line io:format("EOF positions"), + ?line {ok,8} = + ?FILE_MODULE:position(Fd2,{eof,0}), eof=io:get_chars(Fd2,'',1), + ?line {ok,7} = + ?FILE_MODULE:position(Fd2,{eof,-1}), + ?line "H" = io:get_chars(Fd2,'',1), + ?line {ok,0} = + ?FILE_MODULE:position(Fd2,{eof,-8}), "A"=io:get_chars(Fd2,'',1), + ?line {error, einval} = ?FILE_MODULE:position(Fd2,{eof,-9}), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +pos2(suite) -> []; +pos2(doc) -> []; +pos2(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_pos2.fil"), + ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write), + ?line io:format(Fd1,"ABCDEFGH",[]), + ?line ok = ?FILE_MODULE:close(Fd1), + ?line {ok,Fd2} = ?FILE_MODULE:open(Name,read), + ?line {error, einval} = ?FILE_MODULE:position(Fd2,-1), + + %% Make sure that we still can search after an error. + ?line {ok,0} = ?FILE_MODULE:position(Fd2, 0), + ?line {ok,3} = ?FILE_MODULE:position(Fd2, {bof,3}), + ?line "D" = io:get_chars(Fd2,'',1), + + ?line [] = flush(), + ?line io:format("DONE"), + ?line test_server:timetrap_cancel(Dog), + ok. + +file_info(suite) -> [file_info_basic_file, file_info_basic_directory, + file_info_bad, file_info_times, file_write_file_info]. + +file_info_basic_file(suite) -> []; +file_info_basic_file(doc) -> []; +file_info_basic_file(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir, Config), + + %% Create a short file. + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_basic_test.fil"), + ?line {ok,Fd1} = ?FILE_MODULE:open(Name, write), + ?line io:put_chars(Fd1, "foo bar"), + ?line ok = ?FILE_MODULE:close(Fd1), + + %% Test that the file has the expected attributes. + %% The times are tricky, so we will save them to a separate test case. + ?line {ok,#file_info{size=Size,type=Type,access=Access, + atime=AccessTime,mtime=ModifyTime}} = + ?FILE_MODULE:read_file_info(Name), + ?line io:format("Access ~p, Modify ~p", [AccessTime, ModifyTime]), + ?line Size = 7, + ?line Type = regular, + ?line read_write = Access, + ?line true = abs(time_dist(filter_atime(AccessTime, Config), + filter_atime(ModifyTime, + Config))) < 2, + ?line all_integers(tuple_to_list(AccessTime) ++ tuple_to_list(ModifyTime)), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +file_info_basic_directory(suite) -> []; +file_info_basic_directory(doc) -> []; +file_info_basic_directory(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + + %% Note: filename:join/1 removes any trailing slash, + %% which is essential for ?FILE_MODULE:file_info/1 to work on + %% platforms such as Windows95. + ?line RootDir = filename:join([?config(priv_dir, Config)]), + + %% Test that the RootDir directory has the expected attributes. + ?line test_directory(RootDir, read_write), + + %% Note that on Windows file systems, + %% "/" or "c:/" are *NOT* directories. + %% Therefore, test that ?FILE_MODULE:file_info/1 behaves as if they were + %% directories. + ?line case os:type() of + {win32, _} -> + ?line test_directory("/", read_write), + ?line test_directory("c:/", read_write), + ?line test_directory("c:\\", read_write); + {unix, _} -> + ?line test_directory("/", read); + vxworks -> + %% Check is just done for owner + ?line test_directory("/", read_write) + end, + ?line test_server:timetrap_cancel(Dog). + +test_directory(Name, ExpectedAccess) -> + ?line {ok,#file_info{size=Size,type=Type,access=Access, + atime=AccessTime,mtime=ModifyTime}} = + ?FILE_MODULE:read_file_info(Name), + ?line io:format("Testing directory ~s", [Name]), + ?line io:format("Directory size is ~p", [Size]), + ?line io:format("Access ~p", [Access]), + ?line io:format("Access time ~p; Modify time~p", + [AccessTime, ModifyTime]), + ?line Type = directory, + ?line Access = ExpectedAccess, + ?line all_integers(tuple_to_list(AccessTime) ++ tuple_to_list(ModifyTime)), + ?line [] = flush(), + ok. + +all_integers([{A,B,C}|T]) -> + all_integers([A,B,C|T]); +all_integers([Int|Rest]) when is_integer(Int) -> + ?line all_integers(Rest); +all_integers([]) -> ok. + +%% Try something nonexistent. + +file_info_bad(suite) -> []; +file_info_bad(doc) -> []; +file_info_bad(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = filename:join([?config(priv_dir, Config)]), + ?line {error, enoent} = + ?FILE_MODULE:read_file_info( + filename:join(RootDir, + atom_to_list(?MODULE)++ "_nonexistent")), + ?line {error, enoent} = ?FILE_MODULE:read_file_info(""), + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Test that the file times behave as they should. + +file_info_times(suite) -> []; +file_info_times(doc) -> []; +file_info_times(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(60)), + %% We have to try this twice, since if the test runs across the change + %% of a month the time diff calculations will fail. But it won't happen + %% if you run it twice in succession. + ?line test_server:m_out_of_n( + 1,2, + fun() -> ?line file_info_int(Config) end), + ?line test_server:timetrap_cancel(Dog), + ok. + +file_info_int(Config) -> + %% Note: filename:join/1 removes any trailing slash, + %% which is essential for ?FILE_MODULE:file_info/1 to work on + %% platforms such as Windows95. + + ?line RootDir = filename:join([?config(priv_dir, Config)]), + ?line test_server:format("RootDir = ~p", [RootDir]), + + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_file_info.fil"), + ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write), + ?line io:put_chars(Fd1,"foo"), + + %% check that the file got a modify date max a few seconds away from now + ?line {ok,#file_info{type=regular,atime=AccTime1,mtime=ModTime1}} = + ?FILE_MODULE:read_file_info(Name), + ?line Now = erlang:localtime(), %??? + ?line io:format("Now ~p",[Now]), + ?line io:format("Open file Acc ~p Mod ~p",[AccTime1,ModTime1]), + ?line true = abs(time_dist(filter_atime(Now, Config), + filter_atime(AccTime1, + Config))) < 8, + ?line true = abs(time_dist(Now,ModTime1)) < 8, + + %% Sleep until we can be sure the seconds value has changed. + %% Note: FAT-based filesystem (like on Windows 95) have + %% a resolution of 2 seconds. + ?line test_server:sleep(test_server:seconds(2.2)), + + %% close the file, and watch the modify date change + ?line ok = ?FILE_MODULE:close(Fd1), + ?line {ok,#file_info{size=Size,type=regular,access=Access, + atime=AccTime2,mtime=ModTime2}} = + ?FILE_MODULE:read_file_info(Name), + ?line io:format("Closed file Acc ~p Mod ~p",[AccTime2,ModTime2]), + ?line true = time_dist(ModTime1,ModTime2) >= 0, + + %% this file is supposed to be binary, so it'd better keep it's size + ?line Size = 3, + ?line Access = read_write, + + %% Do some directory checking + ?line {ok,#file_info{size=DSize,type=directory,access=DAccess, + atime=AccTime3,mtime=ModTime3}} = + ?FILE_MODULE:read_file_info(RootDir), + %% this dir was modified only a few secs ago + ?line io:format("Dir Acc ~p; Mod ~p; Now ~p", [AccTime3, ModTime3, Now]), + ?line true = abs(time_dist(Now,ModTime3)) < 5, + ?line DAccess = read_write, + ?line io:format("Dir size is ~p",[DSize]), + + ?line [] = flush(), + ok. + +%% Filter access times, to copy with a deficiency of FAT file systems +%% (on Windows): The access time is actually only a date. + +filter_atime(Atime, Config) -> + case lists:member(no_access_time, Config) of + true -> + case Atime of + {Date, _} -> + {Date, {0, 0, 0}}; + {Y, M, D, _, _, _} -> + {Y, M, D, 0, 0, 0} + end; + false -> + Atime + end. + +%% Test the write_file_info/2 function. + +file_write_file_info(suite) -> []; +file_write_file_info(doc) -> []; +file_write_file_info(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = get_good_directory(Config), + ?line test_server:format("RootDir = ~p", [RootDir]), + + %% Set the file to read only AND update the file times at the same time. + %% (This used to fail on Windows NT/95 for a local filesystem.) + %% Note: Seconds must be even; see note in file_info_times/1. + + ?line Name1 = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_write_file_info_ro"), + ?line ok = ?FILE_MODULE:write_file(Name1, "hello"), + ?line Time = {{1997, 01, 02}, {12, 35, 42}}, + ?line Info = #file_info{mode=8#400, atime=Time, mtime=Time, ctime=Time}, + ?line ok = ?FILE_MODULE:write_file_info(Name1, Info), + + %% Read back the times. + + ?line {ok, ActualInfo} = ?FILE_MODULE:read_file_info(Name1), + ?line #file_info{mode=_Mode, atime=ActAtime, mtime=Time, + ctime=ActCtime} = ActualInfo, + ?line FilteredAtime = filter_atime(Time, Config), + ?line FilteredAtime = filter_atime(ActAtime, Config), + ?line case os:type() of + {win32, _} -> + %% On Windows, "ctime" means creation time and it can + %% be set. + ActCtime = Time; + _ -> + ok + end, + ?line {error, eacces} = ?FILE_MODULE:write_file(Name1, "hello again"), + + %% Make the file writable again. + + ?line ?FILE_MODULE:write_file_info(Name1, #file_info{mode=8#600}), + ?line ok = ?FILE_MODULE:write_file(Name1, "hello again"), + + %% And unwritable. + ?line ?FILE_MODULE:write_file_info(Name1, #file_info{mode=8#400}), + ?line {error, eacces} = ?FILE_MODULE:write_file(Name1, "hello again"), + + %% Write the times again. + %% Note: Seconds must be even; see note in file_info_times/1. + + ?line NewTime = {{1997, 02, 15}, {13, 18, 20}}, + ?line NewInfo = #file_info{atime=NewTime, mtime=NewTime, ctime=NewTime}, + ?line ok = ?FILE_MODULE:write_file_info(Name1, NewInfo), + ?line {ok, ActualInfo2} = ?FILE_MODULE:read_file_info(Name1), + ?line #file_info{atime=NewActAtime, mtime=NewTime, + ctime=NewActCtime} = ActualInfo2, + ?line NewFilteredAtime = filter_atime(NewTime, Config), + ?line NewFilteredAtime = filter_atime(NewActAtime, Config), + ?line case os:type() of + {win32, _} -> NewActCtime = NewTime; + _ -> ok + end, + + %% The file should still be unwritable. + ?line {error, eacces} = ?FILE_MODULE:write_file(Name1, "hello again"), + + %% Make the file writeable again, so that we can remove the + %% test suites ... :-) + ?line ?FILE_MODULE:write_file_info(Name1, #file_info{mode=8#600}), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Returns a directory on a file system that has correct file times. + +get_good_directory(Config) -> + ?line ?config(priv_dir, Config). + +consult(suite) -> [consult1, path_consult]. + +consult1(suite) -> []; +consult1(doc) -> []; +consult1(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_consult.fil"), + ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write), + %% note that there is no final \n (only a space) + ?line io:format(Fd1, + "{this,[is,1.0],'journey'}.\n\"into\". (sound). ", + []), + ?line ok = ?FILE_MODULE:close(Fd1), + ?line {ok,[{this,[is,1.0],journey},"into",sound]} = + ?FILE_MODULE:consult(Name), + + ?line {ok,Fd2} = ?FILE_MODULE:open(Name,write), + %% note the missing double quote + ?line io:format( + Fd2,"{this,[is,1.0],'journey'}.\n \"into. (sound). ",[]), + ?line ok = ?FILE_MODULE:close(Fd2), + ?line {error, {_, _, _} = Msg} = ?FILE_MODULE:consult(Name), + ?line io:format("Errmsg: ~p",[Msg]), + + ?line {error, enoent} = ?FILE_MODULE:consult(Name ++ ".nonexistent"), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +path_consult(suite) -> []; +path_consult(doc) -> []; +path_consult(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line FileName = atom_to_list(?MODULE)++"_path_consult.fil", + ?line Name = filename:join(RootDir, FileName), + ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write), + ?line io:format(Fd1,"{this,is,a,journey,into,sound}.\n",[]), + ?line ok = ?FILE_MODULE:close(Fd1), + %% File last in path + ?line {ok,[{this,is,a,journey,into,sound}],Dir} = + ?FILE_MODULE:path_consult( + [filename:join(RootDir, "dir1"), + filename:join(RootDir, ".."), + filename:join(RootDir, "dir2"), + RootDir], FileName), + ?line true = lists:prefix(RootDir,Dir), + + %% While maybe not an error, it may be worth noting that + %% when the full path to a file is given, it's always found + %% regardless of the contents of the path + ?line {ok,_,_} = ?FILE_MODULE:path_consult(["nosuch1","nosuch2"],Name), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +eval(suite) -> [eval1,path_eval]. + +eval1(suite) -> []; +eval1(doc) -> []; +eval1(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE)++"_eval.fil"), + ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write), + %% note that there is no final \n (only a space) + ?line io:format(Fd1,"put(evaluated_ok,\ntrue). ",[]), + ?line ok = ?FILE_MODULE:close(Fd1), + ?line ok = ?FILE_MODULE:eval(Name), + ?line true = get(evaluated_ok), + + ?line {ok,Fd2} = ?FILE_MODULE:open(Name,write), + %% note that there is no final \n (only a space) + ?line io:format(Fd2,"put(evaluated_ok,\nR). ",[]), + ?line ok = ?FILE_MODULE:close(Fd2), + ?line ok = ?FILE_MODULE:eval( + Name, + erl_eval:add_binding('R', true, erl_eval:new_bindings())), + ?line true = get(evaluated_ok), + + ?line {ok,Fd3} = ?FILE_MODULE:open(Name,write), + %% garbled + ?line io:format(Fd3,"puGARBLED-GARBLED\ntrue). ",[]), + ?line ok = ?FILE_MODULE:close(Fd3), + ?line {error, {_, _, _} = Msg} = ?FILE_MODULE:eval(Name), + ?line io:format("Errmsg1: ~p",[Msg]), + + ?line {error, enoent} = ?FILE_MODULE:eval(Name ++ ".nonexistent"), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +path_eval(suite) -> []; +path_eval(doc) -> []; +path_eval(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line FileName = atom_to_list(?MODULE)++"_path_eval.fil", + ?line Name = filename:join(RootDir, FileName), + ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write), + ?line io:format(Fd1,"put(evaluated_ok,true).\n",[]), + ?line ok = ?FILE_MODULE:close(Fd1), + %% File last in path + ?line {ok,Dir} = + ?FILE_MODULE:path_eval( + [filename:join(RootDir, "dir1"), + filename:join(RootDir, ".."), + filename:join(RootDir, "dir2"), + RootDir],FileName), + ?line true = get(evaluated_ok), + ?line true = lists:prefix(RootDir,Dir), + + %% While maybe not an error, it may be worth noting that + %% when the full path to a file is given, it's always found + %% regardless of the contents of the path + ?line {ok,Fd2} = ?FILE_MODULE:open(Name,write), + ?line io:format(Fd2,"put(evaluated_ok,R).\n",[]), + ?line ok = ?FILE_MODULE:close(Fd2), + ?line {ok,_} = ?FILE_MODULE:path_eval( + ["nosuch1","nosuch2"], + Name, + erl_eval:add_binding('R', true, erl_eval:new_bindings())), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +script(suite) -> [script1,path_script]. + +script1(suite) -> []; +script1(doc) -> ""; +script1(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE)++"_script.fil"), + ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write), + %% note that there is no final \n (only a space) + ?line io:format(Fd1,"A = 11,\nB = 6,\nA+B. ",[]), + ?line ok = ?FILE_MODULE:close(Fd1), + ?line {ok,17} = ?FILE_MODULE:script(Name), + + ?line {ok,Fd2} = ?FILE_MODULE:open(Name,write), + %% note that there is no final \n (only a space) + ?line io:format(Fd2,"A = 11,\nA+B. ",[]), + ?line ok = ?FILE_MODULE:close(Fd2), + ?line {ok,17} = ?FILE_MODULE:script( + Name, + erl_eval:add_binding('B', 6, erl_eval:new_bindings())), + + ?line {ok,Fd3} = ?FILE_MODULE:open(Name,write), + ?line io:format(Fd3,"A = 11,\nB = six,\nA+B. ",[]), + ?line ok = ?FILE_MODULE:close(Fd3), + ?line {error, {_, _, _} = Msg} = ?FILE_MODULE:script(Name), + ?line io:format("Errmsg1: ~p",[Msg]), + + ?line {error, enoent} = ?FILE_MODULE:script(Name ++ ".nonexistent"), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +path_script(suite) -> []; +path_script(doc) -> []; +path_script(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line FileName = atom_to_list(?MODULE)++"_path_script.fil", + ?line Name = filename:join(RootDir, FileName), + ?line {ok,Fd1} = ?FILE_MODULE:open(Name,write), + ?line io:format(Fd1,"A = 11,\nB = 6,\nA+B.\n",[]), + ?line ok = ?FILE_MODULE:close(Fd1), + %% File last in path + ?line {ok, 17, Dir} = + ?FILE_MODULE:path_script( + [filename:join(RootDir, "dir1"), + filename:join(RootDir, ".."), + filename:join(RootDir, "dir2"), + RootDir],FileName), + ?line true = lists:prefix(RootDir,Dir), + + %% While maybe not an error, it may be worth noting that + %% when the full path to a file is given, it's always found + %% regardless of the contents of the path + ?line {ok,Fd2} = ?FILE_MODULE:open(Name,write), + ?line io:format(Fd2,"A = 11,\nA+B.",[]), + ?line ok = ?FILE_MODULE:close(Fd2), + ?line {ok, 17, Dir} = + ?FILE_MODULE:path_script( + ["nosuch1","nosuch2"], + Name, + erl_eval:add_binding('B', 6, erl_eval:new_bindings())), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + + + +truncate(suite) -> []; +truncate(doc) -> []; +truncate(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_truncate.fil"), + + %% Create a file with some data. + ?line MyData = "0123456789abcdefghijklmnopqrstuvxyz", + ?line ok = ?FILE_MODULE:write_file(Name, MyData), + + %% Truncate the file to 10 characters. + ?line {ok, Fd} = ?FILE_MODULE:open(Name, read_write), + ?line {ok, 10} = ?FILE_MODULE:position(Fd, 10), + ?line ok = ?FILE_MODULE:truncate(Fd), + ?line ok = ?FILE_MODULE:close(Fd), + + %% Read back the file and check that it has been truncated. + ?line Expected = list_to_binary("0123456789"), + ?line {ok, Expected} = ?FILE_MODULE:read_file(Name), + + %% Open the file read only and verify that it is not possible to + %% truncate it, OTP-1960 + ?line {ok, Fd2} = ?FILE_MODULE:open(Name, read), + ?line {ok, 5} = ?FILE_MODULE:position(Fd2, 5), + ?line {error, _} = ?FILE_MODULE:truncate(Fd2), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + + +sync(suite) -> []; +sync(doc) -> "Tests that ?FILE_MODULE:sync/1 at least doesn't crash."; +sync(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Sync = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_sync.fil"), + + %% Raw open. + ?line {ok, Fd} = ?FILE_MODULE:open(Sync, [write, raw]), + ?line ok = ?FILE_MODULE:sync(Fd), + ?line ok = ?FILE_MODULE:close(Fd), + + %% Ordinary open. + ?line {ok, Fd2} = ?FILE_MODULE:open(Sync, [write]), + ?line ok = ?FILE_MODULE:sync(Fd2), + ?line ok = ?FILE_MODULE:close(Fd2), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +delete(suite) -> []; +delete(doc) -> []; +delete(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_delete.fil"), + ?line {ok, Fd1} = ?FILE_MODULE:open(Name, write), + ?line io:format(Fd1,"ok.\n",[]), + ?line ok = ?FILE_MODULE:close(Fd1), + %% Check that the file is readable + ?line {ok, Fd2} = ?FILE_MODULE:open(Name, read), + ?line ok = ?FILE_MODULE:close(Fd2), + ?line ok = ?FILE_MODULE:delete(Name), + %% Check that the file is not readable anymore + ?line {error, _} = ?FILE_MODULE:open(Name, read), + %% Try deleting a nonexistent file + ?line {error, enoent} = ?FILE_MODULE:delete(Name), + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +rename(suite) ->[]; +rename(doc) ->[]; +rename(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line FileName1 = atom_to_list(?MODULE)++"_rename.fil", + ?line FileName2 = atom_to_list(?MODULE)++"_rename.ful", + ?line Name1 = filename:join(RootDir, FileName1), + ?line Name2 = filename:join(RootDir, FileName2), + ?line {ok,Fd1} = ?FILE_MODULE:open(Name1,write), + ?line ok = ?FILE_MODULE:close(Fd1), + %% Rename, and check that id really changed name + ?line ok = ?FILE_MODULE:rename(Name1,Name2), + ?line {error, _} = ?FILE_MODULE:open(Name1,read), + ?line {ok,Fd2} = ?FILE_MODULE:open(Name2,read), + ?line ok = ?FILE_MODULE:close(Fd2), + %% Try renaming something to itself + ?line ok = ?FILE_MODULE:rename(Name2,Name2), + %% Try renaming something that doesn't exist + ?line {error, enoent} = ?FILE_MODULE:rename(Name1,Name2), + %% Try renaming to something else than a string + ?line {error, badarg} = ?FILE_MODULE:rename(Name1,{foo,bar}), + + %% Move between directories + ?line DirName1 = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_rename_dir"), + ?line DirName2 = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_second_rename_dir"), + ?line Name1foo = filename:join(DirName1, "foo.fil"), + ?line Name2foo = filename:join(DirName2, "foo.fil"), + ?line Name2bar = filename:join(DirName2, "bar.dir"), + ?line ok = ?FILE_MODULE:make_dir(DirName1), + %% The name has to include the full file name, path in not enough + ?line expect({error, eisdir}, {error, eexist}, + ?FILE_MODULE:rename(Name2,DirName1)), + ?line ok = ?FILE_MODULE:rename(Name2, Name1foo), + %% Now rename the directory + ?line ok = ?FILE_MODULE:rename(DirName1,DirName2), + %% And check that the file is there now + ?line {ok,Fd3} = ?FILE_MODULE:open(Name2foo, read), + ?line ok = ?FILE_MODULE:close(Fd3), + %% Try some dirty things now: move the directory into itself + ?line {error, Msg1} = ?FILE_MODULE:rename(DirName2, Name2bar), + ?line io:format("Errmsg1: ~p",[Msg1]), + %% move dir into a file in itself + ?line {error, Msg2} = ?FILE_MODULE:rename(DirName2, Name2foo), + ?line io:format("Errmsg2: ~p",[Msg2]), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +names(suite) -> []; +names(doc) -> []; +names(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line FileName = "foo1.fil", + ?line Name1 = filename:join(RootDir, FileName), + ?line Name2 = [RootDir,"/","foo1",".","fil"], + ?line Name3 = [RootDir,"/",foo,$1,[[[],[],'.']],"f",il], + ?line Name4 = list_to_atom(Name1), + ?line {ok,Fd0} = ?FILE_MODULE:open(Name1,write), + ?line ok = ?FILE_MODULE:close(Fd0), + + %% Try some file names + ?line {ok,Fd1} = ?FILE_MODULE:open(Name1,read), + ?line ok = ?FILE_MODULE:close(Fd1), + ?line {ok,Fd2f} = ?FILE_MODULE:open(lists:flatten(Name2),read), + ?line ok = ?FILE_MODULE:close(Fd2f), + ?line {ok,Fd2} = ?FILE_MODULE:open(Name2,read), + ?line ok = ?FILE_MODULE:close(Fd2), + ?line {ok,Fd3} = ?FILE_MODULE:open(Name3,read), + ?line ok = ?FILE_MODULE:close(Fd3), + ?line {ok,Fd4} = ?FILE_MODULE:open(Name4,read), + ?line ok = ?FILE_MODULE:close(Fd4), + + %% Try some path names + ?line Path1 = RootDir, + ?line Path2 = [RootDir], + ?line Path3 = ['',[],[RootDir,[[]]]], + ?line Path4 = list_to_atom(Path1), + ?line {ok,Fd11,_} = ?FILE_MODULE:path_open([Path1],FileName,read), + ?line ok = ?FILE_MODULE:close(Fd11), + ?line {ok,Fd12,_} = ?FILE_MODULE:path_open([Path2],FileName,read), + ?line ok = ?FILE_MODULE:close(Fd12), + ?line {ok,Fd13,_} = ?FILE_MODULE:path_open([Path3],FileName,read), + ?line ok = ?FILE_MODULE:close(Fd13), + ?line {ok,Fd14,_} = ?FILE_MODULE:path_open([Path4],FileName,read), + ?line ok = ?FILE_MODULE:close(Fd14), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +errors(suite) -> [e_delete, e_rename, e_make_dir, e_del_dir]. + +e_delete(suite) -> []; +e_delete(doc) -> []; +e_delete(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line Base = filename:join(RootDir, + atom_to_list(?MODULE)++"_e_delete"), + ?line ok = ?FILE_MODULE:make_dir(Base), + + %% Delete a non-existing file. + ?line {error, enoent} = + ?FILE_MODULE:delete(filename:join(Base, "non_existing")), + + %% Delete a directory. + ?line {error, eperm} = ?FILE_MODULE:delete(Base), + + %% Use a path-name with a non-directory component. + ?line Afile = filename:join(Base, "a_file"), + ?line ok = ?FILE_MODULE:write_file(Afile, "hello\n"), + ?line {error, E} = + expect({error, enotdir}, {error, enoent}, + ?FILE_MODULE:delete(filename:join(Afile, "another_file"))), + ?line io:format("Result: ~p~n", [E]), + + %% No permission. + ?line case os:type() of + {unix, _} -> + ?line ?FILE_MODULE:write_file_info( + Base, #file_info {mode=0}), + ?line {error, eacces} = ?FILE_MODULE:delete(Afile), + ?line ?FILE_MODULE:write_file_info( + Base, #file_info {mode=8#600}); + {win32, _} -> + %% Remove a character device. + ?line {error, eacces} = ?FILE_MODULE:delete("nul"); + vxworks -> + ok + end, + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +%%% FreeBSD gives EEXIST when renaming a file to an empty dir, although the +%%% manual page can be interpreted as saying that EISDIR should be given. +%%% (What about FreeBSD? We store our nightly build results on a FreeBSD +%%% file system, that's what.) + +e_rename(suite) -> []; +e_rename(doc) -> []; +e_rename(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {comment, "Windriver: dosFs must be fixed first!"}; + _ -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line Base = filename:join(RootDir, + atom_to_list(?MODULE)++"_e_rename"), + ?line ok = ?FILE_MODULE:make_dir(Base), + + %% Create an empty directory. + ?line EmptyDir = filename:join(Base, "empty_dir"), + ?line ok = ?FILE_MODULE:make_dir(EmptyDir), + + %% Create a non-empty directory. + ?line NonEmptyDir = filename:join(Base, "non_empty_dir"), + ?line ok = ?FILE_MODULE:make_dir(NonEmptyDir), + ?line ok = ?FILE_MODULE:write_file( + filename:join(NonEmptyDir, "a_file"), + "hello\n"), + + %% Create another non-empty directory. + ?line ADirectory = filename:join(Base, "a_directory"), + ?line ok = ?FILE_MODULE:make_dir(ADirectory), + ?line ok = ?FILE_MODULE:write_file( + filename:join(ADirectory, "a_file"), + "howdy\n\n"), + + %% Create a data file. + ?line File = filename:join(Base, "just_a_file"), + ?line ok = ?FILE_MODULE:write_file(File, "anything goes\n\n"), + + %% Move an existing directory to a non-empty directory. + ?line {error, eexist} = + ?FILE_MODULE:rename(ADirectory, NonEmptyDir), + + %% Move a root directory. + ?line {error, einval} = ?FILE_MODULE:rename("/", "arne"), + + %% Move Base into Base/new_name. + ?line {error, einval} = + ?FILE_MODULE:rename(Base, filename:join(Base, "new_name")), + + %% Overwrite a directory with a file. + ?line expect({error, eexist}, %FreeBSD (?) + {error, eisdir}, + ?FILE_MODULE:rename(File, EmptyDir)), + ?line expect({error, eexist}, %FreeBSD (?) + {error, eisdir}, + ?FILE_MODULE:rename(File, NonEmptyDir)), + + %% Move a non-existing file. + ?line NonExistingFile = + filename:join(Base, "non_existing_file"), + ?line {error, enoent} = + ?FILE_MODULE:rename(NonExistingFile, NonEmptyDir), + + %% Overwrite a file with a directory. + ?line expect({error, eexist}, %FreeBSD (?) + {error, enotdir}, + ?FILE_MODULE:rename(ADirectory, File)), + + %% Move a file to another filesystem. + %% XXX - This test case is bogus. We cannot be guaranteed that + %% the source and destination are on + %% different filesystems. + %% + %% XXX - Gross hack! + ?line Comment = + case os:type() of + {unix, _} -> + OtherFs = "/tmp", + ?line NameOnOtherFs = + filename:join(OtherFs, filename:basename(File)), + ?line {ok, Com} = + case ?FILE_MODULE:rename(File, NameOnOtherFs) of + {error, exdev} -> + %% The file could be in + %% the same filesystem! + {ok, ok}; + ok -> + {ok, {comment, + "Moving between filesystems " + "suceeded, files are probably " + "in the same filesystem!"}}; + {error, eperm} -> + {ok, {comment, "SBS! You don't " + "have the permission to do " + "this test!"}}; + Else -> + Else + end, + Com; + {win32, _} -> + %% At least Windows NT can + %% successfully move a file to + %% another drive. + ok + end, + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + Comment + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +e_make_dir(suite) -> []; +e_make_dir(doc) -> []; +e_make_dir(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line Base = filename:join(RootDir, + atom_to_list(?MODULE)++"_e_make_dir"), + ?line ok = ?FILE_MODULE:make_dir(Base), + + %% A component of the path does not exist. + ?line {error, enoent} = + ?FILE_MODULE:make_dir(filename:join([Base, "a", "b"])), + + %% Use a path-name with a non-directory component. + ?line Afile = filename:join(Base, "a_directory"), + ?line ok = ?FILE_MODULE:write_file(Afile, "hello\n"), + ?line case ?FILE_MODULE:make_dir( + filename:join(Afile, "another_directory")) of + {error, enotdir} -> io:format("Result: enotdir"); + {error, enoent} -> io:format("Result: enoent") + end, + + %% No permission (on Unix only). + case os:type() of + {unix, _} -> + ?line ?FILE_MODULE:write_file_info(Base, #file_info {mode=0}), + ?line {error, eacces} = + ?FILE_MODULE:make_dir(filename:join(Base, "xxxx")), + ?line ?FILE_MODULE:write_file_info( + Base, #file_info {mode=8#600}); + {win32, _} -> + ok; + vxworks -> + ok + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +e_del_dir(suite) -> []; +e_del_dir(doc) -> []; +e_del_dir(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line Base = test_server:temp_name(filename:join(RootDir, "e_del_dir")), + ?line io:format("Base: ~p", [Base]), + ?line ok = ?FILE_MODULE:make_dir(Base), + + %% Delete a non-existent directory. + ?line {error, enoent} = + ?FILE_MODULE:del_dir(filename:join(Base, "non_existing")), + + %% Use a path-name with a non-directory component. + ?line Afile = filename:join(Base, "a_directory"), + ?line ok = ?FILE_MODULE:write_file(Afile, "hello\n"), + ?line {error, E1} = + expect({error, enotdir}, {error, enoent}, + ?FILE_MODULE:del_dir( + filename:join(Afile, "another_directory"))), + ?line io:format("Result: ~p", [E1]), + + %% Delete a non-empty directory. + ?line {error, E2} = + expect({error, enotempty}, {error, eexist}, {error, eacces}, + ?FILE_MODULE:del_dir(Base)), + ?line io:format("Result: ~p", [E2]), + + %% Remove the current directory. + ?line {error, E3} = + expect({error, einval}, + {error, eperm}, % Linux and DUX + {error, eacces}, + {error, ebusy}, + ?FILE_MODULE:del_dir(".")), + ?line io:format("Result: ~p", [E3]), + + %% No permission. + case os:type() of + {unix, _} -> + ?line ADirectory = filename:join(Base, "no_perm"), + ?line ok = ?FILE_MODULE:make_dir(ADirectory), + ?line ?FILE_MODULE:write_file_info( + Base, #file_info {mode=0}), + ?line {error, eacces} = ?FILE_MODULE:del_dir(ADirectory), + ?line ?FILE_MODULE:write_file_info( + Base, #file_info {mode=8#600}); + {win32, _} -> + ok; + vxworks -> + ok + end, + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +compression(suite) -> + [read_compressed_cooked, read_compressed_cooked_binary, + read_cooked_tar_problem, + read_not_really_compressed, + write_compressed, compress_errors, + catenated_gzips]. + +%% Trying reading and positioning from a compressed file. + +read_compressed_cooked(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line Real = filename:join(Data, "realmen.html.gz"), + ?line {ok, Fd} = ?FILE_MODULE:open(Real, [read,compressed]), + ?line try_read_file_list(Fd). + +read_compressed_cooked_binary(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line Real = filename:join(Data, "realmen.html.gz"), + ?line {ok, Fd} = ?FILE_MODULE:open(Real, [read,compressed,binary]), + ?line try_read_file_binary(Fd). + +%% Trying reading and positioning from an uncompressed file, +%% but with the compressed flag given. + +read_not_really_compressed(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line Priv = ?config(priv_dir, Config), + + %% The file realmen.html might have got CRs added (by WinZip). + %% Remove them, or the file positions will not be correct. + + ?line Real = filename:join(Data, "realmen.html"), + ?line RealPriv = filename:join(Priv, + atom_to_list(?MODULE)++"_realmen.html"), + ?line {ok, RealDataBin} = ?FILE_MODULE:read_file(Real), + ?line RealData = remove_crs(binary_to_list(RealDataBin), []), + ?line ok = ?FILE_MODULE:write_file(RealPriv, RealData), + ?line {ok, Fd} = ?FILE_MODULE:open(RealPriv, [read, compressed]), + ?line try_read_file_list(Fd). + +remove_crs([$\r|Rest], Result) -> + remove_crs(Rest, Result); +remove_crs([C|Rest], Result) -> + remove_crs(Rest, [C|Result]); +remove_crs([], Result) -> + lists:reverse(Result). + +try_read_file_list(Fd) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + + %% Seek to the current position (nothing should happen). + + ?line {ok, 0} = ?FILE_MODULE:position(Fd, 0), + ?line {ok, 0} = ?FILE_MODULE:position(Fd, {cur, 0}), + + %% Read a few lines from a compressed file. + + ?line ShouldBe = "<TITLE>Real Programmers Don't Use PASCAL</TITLE>\n", + ?line ShouldBe = io:get_line(Fd, ''), + + %% Now seek forward. + + ?line {ok, 381} = ?FILE_MODULE:position(Fd, 381), + ?line Back = "Back in the good old days -- the \"Golden Era\" " ++ + "of computers, it was\n", + ?line Back = io:get_line(Fd, ''), + + %% Try to search forward relative to the current position. + + ?line {ok, CurPos} = ?FILE_MODULE:position(Fd, {cur, 0}), + ?line RealPos = 4273, + ?line {ok, RealPos} = ?FILE_MODULE:position(Fd, {cur, RealPos-CurPos}), + ?line RealProg = "<LI> Real Programmers aren't afraid to use GOTOs.\n", + ?line RealProg = io:get_line(Fd, ''), + + %% Seek backward. + + ?line AfterTitle = length("<TITLE>"), + ?line {ok, AfterTitle} = ?FILE_MODULE:position(Fd, AfterTitle), + ?line Title = "Real Programmers Don't Use PASCAL</TITLE>\n", + ?line Title = io:get_line(Fd, ''), + + %% Done. + + ?line ?FILE_MODULE:close(Fd), + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +try_read_file_binary(Fd) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + + %% Seek to the current position (nothing should happen). + + ?line {ok, 0} = ?FILE_MODULE:position(Fd, 0), + ?line {ok, 0} = ?FILE_MODULE:position(Fd, {cur, 0}), + + %% Read a few lines from a compressed file. + + ?line ShouldBe = <<"<TITLE>Real Programmers Don't Use PASCAL</TITLE>\n">>, + ?line ShouldBe = io:get_line(Fd, ''), + + %% Now seek forward. + + ?line {ok, 381} = ?FILE_MODULE:position(Fd, 381), + ?line Back = <<"Back in the good old days -- the \"Golden Era\" " + "of computers, it was\n">>, + ?line Back = io:get_line(Fd, ''), + + %% Try to search forward relative to the current position. + + ?line {ok, CurPos} = ?FILE_MODULE:position(Fd, {cur, 0}), + ?line RealPos = 4273, + ?line {ok, RealPos} = ?FILE_MODULE:position(Fd, {cur, RealPos-CurPos}), + ?line RealProg = <<"<LI> Real Programmers aren't afraid to use GOTOs.\n">>, + ?line RealProg = io:get_line(Fd, ''), + + %% Seek backward. + + ?line AfterTitle = length("<TITLE>"), + ?line {ok, AfterTitle} = ?FILE_MODULE:position(Fd, AfterTitle), + ?line Title = <<"Real Programmers Don't Use PASCAL</TITLE>\n">>, + ?line Title = io:get_line(Fd, ''), + + %% Done. + + ?line ?FILE_MODULE:close(Fd), + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +read_cooked_tar_problem(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + + ?line Data = ?config(data_dir, Config), + ?line ProblemFile = filename:join(Data, "cooked_tar_problem.tar.gz"), + ?line {ok,Fd} = ?FILE_MODULE:open(ProblemFile, [read,compressed,binary]), + + ?line {ok,34304} = file:position(Fd, 34304), + ?line {ok,Bin} = file:read(Fd, 512), + ?line 512 = byte_size(Bin), + + ?line {ok,34304+512+1024} = file:position(Fd, {cur,1024}), + + ?line ok = file:close(Fd), + + ?line test_server:timetrap_cancel(Dog), + ok. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +write_compressed(suite) -> []; +write_compressed(doc) -> []; +write_compressed(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Priv = ?config(priv_dir, Config), + ?line MyFile = filename:join(Priv, + atom_to_list(?MODULE)++"_test.gz"), + + %% Write a file. + + ?line {ok, Fd} = ?FILE_MODULE:open(MyFile, [write, compressed]), + ?line {ok, 0} = ?FILE_MODULE:position(Fd, 0), + ?line Prefix = "hello\n", + ?line End = "end\n", + ?line ok = io:put_chars(Fd, Prefix), + ?line {ok, 143} = ?FILE_MODULE:position(Fd, 143), + ?line ok = io:put_chars(Fd, End), + ?line ok = ?FILE_MODULE:close(Fd), + + %% Read the file and verify the contents. + + ?line {ok, Fd1} = ?FILE_MODULE:open(MyFile, [read, compressed]), + ?line Prefix = io:get_line(Fd1, ''), + ?line Second = lists:duplicate(143-length(Prefix), 0) ++ End, + ?line Second = io:get_line(Fd1, ''), + ?line ok = ?FILE_MODULE:close(Fd1), + + %% Verify succesful compression by uncompressing the file + %% using zlib:gunzip/1. + + ?line {ok,Contents} = file:read_file(MyFile), + ?line <<"hello\n",0:137/unit:8,"end\n">> = zlib:gunzip(Contents), + + %% Ensure that the file is compressed. + + TotalSize = 143 + length(End), + case ?FILE_MODULE:read_file_info(MyFile) of + {ok, #file_info{size=Size}} when Size < TotalSize -> + ok; + {ok, #file_info{size=Size}} when Size == TotalSize -> + test_server:fail(file_not_compressed) + end, + + %% Write again to ensure that the file is truncated. + + ?line {ok, Fd2} = ?FILE_MODULE:open(MyFile, [write, compressed]), + ?line NewString = "aaaaaaaaaaa", + ?line ok = io:put_chars(Fd2, NewString), + ?line ok = ?FILE_MODULE:close(Fd2), + ?line {ok, Fd3} = ?FILE_MODULE:open(MyFile, [read, compressed]), + ?line {ok, NewString} = ?FILE_MODULE:read(Fd3, 1024), + ?line ok = ?FILE_MODULE:close(Fd3), + + %% Done. + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +catenated_gzips(Config) when is_list(Config) -> + ?line Priv = ?config(priv_dir, Config), + ?line MyFile = filename:join(Priv, ?MODULE_STRING++"_test.gz"), + + First = "Hello, all good men going to search parties. ", + Second = "Now I really need your help.", + All = iolist_to_binary([First|Second]), + ?line Cat = [zlib:gzip(First),zlib:gzip(Second)], + + ?line ok = file:write_file(MyFile, Cat), + + ?line {ok,Fd} = file:open(MyFile, [read,compressed,binary]), + ?line {ok,All} = file:read(Fd, 100000), + ?line ok = file:close(Fd), + + ok. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +compress_errors(suite) -> []; +compress_errors(doc) -> []; +compress_errors(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line DataDir = + filename:dirname( + filename:join(?config(data_dir, Config), "x")), + ?line DataDirSlash = DataDir++"/", + ?line {error, enoent} = ?FILE_MODULE:open("non_existing__", + [compressed, read]), + ?line {error, einval} = ?FILE_MODULE:open("non_existing__", + [compressed, read, write]), + ?line {error, einval} = ?FILE_MODULE:open("non_existing__", + [compressed, read, append]), + ?line {error, einval} = ?FILE_MODULE:open("non_existing__", + [compressed, write, append]), + ?line {error, E1} = ?FILE_MODULE:open(DataDir, [compressed, read]), + ?line {error, E2} = ?FILE_MODULE:open(DataDirSlash, [compressed, read]), + ?line {error, E3} = ?FILE_MODULE:open(DataDir, [compressed, write]), + ?line {error, E4} = ?FILE_MODULE:open(DataDirSlash, [compressed, write]), + ?line {eisdir,eisdir,eisdir,eisdir} = {E1,E2,E3,E4}, + + %% Read a corrupted .gz file. + + ?line Corrupted = filename:join(DataDir, "corrupted.gz"), + ?line {ok, Fd} = ?FILE_MODULE:open(Corrupted, [read, compressed]), + ?line {error, eio} = ?FILE_MODULE:read(Fd, 100), + ?line ?FILE_MODULE:close(Fd), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +altname(doc) -> + "Test the file:altname/1 function"; +altname(suite) -> + []; +altname(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + "long alternative path name with spaces"), + ?line ok = ?FILE_MODULE:make_dir(NewDir), + ?line Name = filename:join(NewDir, "a_file_with_long_name"), + ?line ShortName = filename:join(NewDir, "short"), + ?line NonexName = filename:join(NewDir, "nonexistent"), + ?line ok = ?FILE_MODULE:write_file(Name, "some contents\n"), + ?line ok = ?FILE_MODULE:write_file(ShortName, "some contents\n"), + ?line Result = + case ?FILE_MODULE:altname(NewDir) of + {error, enotsup} -> + {skipped, "Altname not supported on this platform"}; + {ok, "LONGAL~1"} -> + ?line {ok, "A_FILE~1"} = ?FILE_MODULE:altname(Name), + ?line {ok, "C:/"} = ?FILE_MODULE:altname("C:/"), + ?line {ok, "C:\\"} = ?FILE_MODULE:altname("C:\\"), + ?line {error,enoent} = ?FILE_MODULE:altname(NonexName), + ?line {ok, "short"} = ?FILE_MODULE:altname(ShortName), + ok + end, + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + Result. + +links(doc) -> "Test the link functions."; +links(suite) -> [make_link, read_link_info_for_non_link, symlinks]. + +make_link(doc) -> "Test creating a hard link."; +make_link(suite) -> []; +make_link(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_make_link"), + ?line ok = ?FILE_MODULE:make_dir(NewDir), + + ?line Name = filename:join(NewDir, "a_file"), + ?line ok = ?FILE_MODULE:write_file(Name, "some contents\n"), + + ?line Alias = filename:join(NewDir, "an_alias"), + ?line Result = + case ?FILE_MODULE:make_link(Name, Alias) of + {error, enotsup} -> + {skipped, "Links not supported on this platform"}; + ok -> + %% Note: We take the opportunity to test + %% ?FILE_MODULE:read_link_info/1, + %% which should in behave exactly as + %% ?FILE_MODULE:read_file_info/1 + %% since they are not used on symbolic links. + + ?line {ok, Info} = ?FILE_MODULE:read_link_info(Name), + ?line {ok, Info} = ?FILE_MODULE:read_link_info(Alias), + ?line #file_info{links = 2, type = regular} = Info, + ?line {error, eexist} = + ?FILE_MODULE:make_link(Name, Alias), + ok + end, + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + Result. + +read_link_info_for_non_link(doc) -> + "Test that reading link info for an ordinary file or directory works " + "(on all platforms)."; +read_link_info_for_non_link(suite) -> []; +read_link_info_for_non_link(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + + ?line {ok, #file_info{type=directory}} = + ?FILE_MODULE:read_link_info("."), + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + +symlinks(doc) -> "Test operations on symbolic links (for Unix)."; +symlinks(suite) -> []; +symlinks(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_symlinks"), + ?line ok = ?FILE_MODULE:make_dir(NewDir), + + ?line Name = filename:join(NewDir, "a_plain_file"), + ?line ok = ?FILE_MODULE:write_file(Name, "some stupid content\n"), + + ?line Alias = filename:join(NewDir, "a_symlink_alias"), + ?line Result = + case ?FILE_MODULE:make_symlink(Name, Alias) of + {error, enotsup} -> + {skipped, "Links not supported on this platform"}; + ok -> + ?line {ok, Info1} = ?FILE_MODULE:read_file_info(Name), + ?line {ok, Info1} = ?FILE_MODULE:read_file_info(Alias), + ?line {ok, Info1} = ?FILE_MODULE:read_link_info(Name), + ?line #file_info{links = 1, type = regular} = Info1, + + ?line {ok, Info2} = ?FILE_MODULE:read_link_info(Alias), + ?line #file_info{links=1, type=symlink} = Info2, + ?line {ok, Name} = ?FILE_MODULE:read_link(Alias), + ok + end, + + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + Result. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +copy(doc) -> []; +copy(suite) -> []; +copy(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + %% Create a text file. + ?line Name1 = filename:join(RootDir, atom_to_list(?MODULE)++"_copy_1.txt"), + ?line Line = "The quick brown fox jumps over a lazy dog. 0123456789\n", + ?line Len = length(Line), + ?line {ok, Handle1} = ?FILE_MODULE:open(Name1, [write]), + ?line {_, Size1} = + iterate({0, 0}, + done, + fun({_, S}) when S >= 128*1024 -> + done; + ({N, S}) -> + H = integer_to_list(N), + ok = ?FILE_MODULE:write(Handle1, [H, " ", Line]), + {N + 1, S + length(H) + 1 + Len} + end), + ?line ?FILE_MODULE:close(Handle1), + %% Make a copy + ?line Name2 = filename:join(RootDir, atom_to_list(?MODULE)++"_copy_2.txt"), + ?line {ok, Size1} = ?FILE_MODULE:copy(Name1, Name2), + %% Concatenate 1 + ?line Name3 = filename:join(RootDir, atom_to_list(?MODULE)++"_copy_3.txt"), + ?line {ok, Handle3} = ?FILE_MODULE:open(Name3, [raw, write, binary]), + ?line {ok, Size1} = ?FILE_MODULE:copy(Name1, Handle3), + ?line {ok, Handle2} = ?FILE_MODULE:open(Name2, [read, binary]), + ?line {ok, Size1} = ?FILE_MODULE:copy(Handle2, Handle3), + ?line ok = ?FILE_MODULE:close(Handle3), + ?line ok = ?FILE_MODULE:close(Handle2), + %% Concatenate 2 + ?line Name4 = filename:join(RootDir, atom_to_list(?MODULE)++"_copy_4.txt"), + ?line {ok, Handle4} = ?FILE_MODULE:open(Name4, [write, binary]), + ?line {ok, Size1} = ?FILE_MODULE:copy(Name1, Handle4), + ?line {ok, Handle5} = ?FILE_MODULE:open(Name2, [raw, read, binary]), + ?line {ok, Size1} = ?FILE_MODULE:copy(Handle5, Handle4), + ?line ok = ?FILE_MODULE:close(Handle5), + ?line ok = ?FILE_MODULE:close(Handle4), + %% %% Just for test of the test + %% ?line {ok, Handle2q} = ?FILE_MODULE:open(Name2, [write, append]), + %% ?line ok = ?FILE_MODULE:write(Handle2q, "q"), + %% ?line ok = ?FILE_MODULE:close(Handle2q), + %% Compare the files + ?line {ok, Handle1a} = ?FILE_MODULE:open(Name1, [raw, read]), + ?line {ok, Handle2a} = ?FILE_MODULE:open(Name2, [raw, read]), + ?line true = stream_cmp(fd_stream_factory([Handle1a]), + fd_stream_factory([Handle2a])), + ?line {ok, 0} = ?FILE_MODULE:position(Handle1a, 0), + ?line {ok, 0} = ?FILE_MODULE:position(Handle2a, 0), + ?line {ok, Handle3a} = ?FILE_MODULE:open(Name3, [raw, read]), + ?line true = stream_cmp(fd_stream_factory([Handle1a, Handle2a]), + fd_stream_factory([Handle2a])), + ?line ok = ?FILE_MODULE:close(Handle1a), + ?line ok = ?FILE_MODULE:close(Handle2a), + ?line ok = ?FILE_MODULE:close(Handle3a), + ?line [] = flush(), + ?line test_server:timetrap_cancel(Dog), + ok. + + + +fd_stream_factory([]) -> + []; +fd_stream_factory([Fd | T] = L) -> + fun() -> + case ?FILE_MODULE:read(Fd, 8192) of + {ok, Data} when is_binary(Data) -> + binary_to_list(Data) ++ fd_stream_factory(L); + {ok, Data} when is_list(Data) -> + Data ++ fd_stream_factory(L); + eof -> + fd_stream_factory(T); + {error, _} = Error -> + Error + end + end. + + + +stream_cmp(F1, F2) when is_function(F1), is_function(F2) -> + stream_cmp(F1(), F2()); +stream_cmp(F, X) when is_function(F) -> + stream_cmp(F(), X); +stream_cmp(X, F) when is_function(F) -> + stream_cmp(X, F()); +stream_cmp({error, _} = Error, _) -> + Error; +stream_cmp(_, {error, _} = Error) -> + Error; +stream_cmp([], []) -> + true; +stream_cmp([], [_|_]) -> + false; +stream_cmp([_|_], []) -> + false; +stream_cmp([H | T1], [H | T2]) -> + stream_cmp(T1, T2). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Test the get_cwd(), open(), and copy() file server calls. +new_slave(_RootDir, Cwd) -> + ?line L = "qwertyuiopasdfghjklzxcvbnm", + ?line N = length(L), + ?line {ok, Cwd} = ?FILE_MODULE:get_cwd(), + ?line {error, enotsup} = ?FILE_MODULE:get_cwd("C:"), % Unix only testcase + ?line {ok, FD1} = ?FILE_MODULE:open("file1.txt", write), + ?line ok = ?FILE_MODULE:close(FD1), + ?line {ok, FD2} = ?FILE_MODULE:open("file1.txt", + [write, append, + binary, compressed, + delayed_write, + {delayed_write, 0, 0}, + read_ahead, + {read_ahead, 0}]), + ?line ok = ?FILE_MODULE:write(FD2, L), + ?line ok = ?FILE_MODULE:close(FD2), + ?line {ok, N2} = ?FILE_MODULE:copy("file1.txt", "file2.txt"), + ?line io:format("Size ~p, compressed ~p.~n", [N, N2]), + ?line {ok, FD3} = ?FILE_MODULE:open("file2.txt", + [binary, compressed]), + %% The file_io_server will translate the binary into a list + ?line {ok, L} = ?FILE_MODULE:read(FD3, N+1), + ?line ok = ?FILE_MODULE:close(FD3), + %% + ?line ok = ?FILE_MODULE:delete("file1.txt"), + ?line ok = ?FILE_MODULE:delete("file2.txt"), + ?line [] = flush(), + ok. + + +%% Test the get_cwd() and open() file server calls. +old_slave(_RootDir, Cwd) -> + ?line L = "qwertyuiopasdfghjklzxcvbnm", + ?line N = length(L), + ?line {ok, Cwd} = ?FILE_MODULE:get_cwd(), + ?line {error, enotsup} = ?FILE_MODULE:get_cwd("C:"), % Unix only testcase + ?line {ok, FD1} = ?FILE_MODULE:open("file1.txt", write), + ?line ok = ?FILE_MODULE:close(FD1), + ?line {ok, FD2} = ?FILE_MODULE:open("file1.txt", + [write, binary, compressed]), + ?line ok = ?FILE_MODULE:write(FD2, L), + ?line ok = ?FILE_MODULE:close(FD2), + ?line {ok, FD3} = ?FILE_MODULE:open("file1.txt", [write, append]), + ?line ok = ?FILE_MODULE:close(FD3), + ?line {ok, FD4} = ?FILE_MODULE:open("file1.txt", + [binary, compressed]), + %% The file_io_server will translate the binary into a list + ?line {ok, L} = ?FILE_MODULE:read(FD4, N+1), + ?line ok = ?FILE_MODULE:close(FD4), + %% + ?line ok = ?FILE_MODULE:delete("file1.txt"), + ?line [] = flush(), + ok. + +run_test(Test, Args) -> + ?line case (catch apply(?MODULE, Test, Args)) of + {'EXIT', _} = Exit -> + {done, Exit, get(test_server_loc)}; + Result -> + {done, Result} + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +delayed_write(suite) -> + []; +delayed_write(doc) -> + ["Tests the file open option {delayed_write, Size, Delay}"]; + +delayed_write(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(20)), + %% + ?line RootDir = ?config(priv_dir, Config), + ?line File = filename:join(RootDir, + atom_to_list(?MODULE)++"_delayed_write.txt"), + ?line Data1 = "asdfghjkl", + ?line Data2 = "qwertyuio", + ?line Data3 = "zxcvbnm,.", + ?line Size = length(Data1), + ?line Size = length(Data2), + ?line Size = length(Data3), + ?line Data1Data1 = Data1++Data1, + ?line Data1Data1Data1 = Data1Data1++Data1, + ?line Data1Data1Data1Data1 = Data1Data1++Data1Data1, + %% + %% Test caching and normal close of non-raw file + ?line {ok, Fd1} = + ?FILE_MODULE:open(File, [write, {delayed_write, Size+1, 2000}]), + ?line ok = ?FILE_MODULE:write(Fd1, Data1), + ?line ?t:sleep(1000), % Just in case the file system is slow + ?line {ok, Fd2} = ?FILE_MODULE:open(File, [read]), + ?line case os:type() of + vxworks -> + io:format("Line ~p skipped on vxworks", [?LINE]); + _ -> + ?line eof = ?FILE_MODULE:read(Fd2, 1) + end, + ?line ok = ?FILE_MODULE:write(Fd1, Data1), % Data flush on size + ?line ?t:sleep(1000), % Just in case the file system is slow + ?line {ok, Data1Data1} = ?FILE_MODULE:pread(Fd2, bof, 2*Size+1), + ?line ok = ?FILE_MODULE:write(Fd1, Data1), + ?line ?t:sleep(3000), % Wait until data flush on timeout + ?line {ok, Data1Data1Data1} = ?FILE_MODULE:pread(Fd2, bof, 3*Size+1), + ?line ok = ?FILE_MODULE:write(Fd1, Data1), + ?line ok = ?FILE_MODULE:close(Fd1), % Data flush on close + ?line ?t:sleep(1000), % Just in case the file system is slow + ?line {ok, Data1Data1Data1Data1} = ?FILE_MODULE:pread(Fd2, bof, 4*Size+1), + ?line ok = ?FILE_MODULE:close(Fd2), + %% + %% Test implicit close through exit by file owning process, + %% raw file, default parameters. + ?line Parent = self(), + ?line Fun = + fun () -> + Child = self(), + Test = + fun () -> + ?line {ok, Fd} = + ?FILE_MODULE:open(File, + [raw, write, + delayed_write]), + ?line ok = ?FILE_MODULE:write(Fd, Data1), + ?line Parent ! {Child, wrote}, + ?line receive + {Parent, continue, Reason} -> + {ok, Reason} + end + end, + case (catch Test()) of + {ok, Reason} -> + exit(Reason); + Unknown -> + exit({Unknown, get(test_server_loc)}) + end + end, + ?line Child1 = spawn(Fun), + ?line Mref1 = erlang:monitor(process, Child1), + ?line receive + {Child1, wrote} -> + ok; + {'DOWN', Mref1, _, _, _} = Down1a -> + ?t:fail(Down1a) + end, + ?line ?t:sleep(1000), % Just in case the file system is slow + ?line {ok, Fd3} = ?FILE_MODULE:open(File, [read]), + ?line case os:type() of + vxworks -> + io:format("Line ~p skipped on vxworks", [?LINE]); + _ -> + ?line eof = ?FILE_MODULE:read(Fd3, 1) + end, + ?line Child1 ! {Parent, continue, normal}, + ?line receive + {'DOWN', Mref1, process, Child1, normal} -> + ok; + {'DOWN', Mref1, _, _, _} = Down1b -> + ?t:fail(Down1b) + end, + ?line ?t:sleep(1000), % Just in case the file system is slow + ?line {ok, Data1} = ?FILE_MODULE:pread(Fd3, bof, Size+1), + ?line ok = ?FILE_MODULE:close(Fd3), + %% + %% The same again, but this time with reason 'kill'. + ?line Child2 = spawn(Fun), + ?line Mref2 = erlang:monitor(process, Child2), + ?line receive + {Child2, wrote} -> + ok; + {'DOWN', Mref2, _, _, _} = Down2a -> + ?t:fail(Down2a) + end, + ?line ?t:sleep(1000), % Just in case the file system is slow + ?line {ok, Fd4} = ?FILE_MODULE:open(File, [read]), + ?line case os:type() of + vxworks -> + io:format("Line ~p skipped on vxworks", [?LINE]); + _ -> + ?line eof = ?FILE_MODULE:read(Fd4, 1) + end, + ?line Child2 ! {Parent, continue, kill}, + ?line receive + {'DOWN', Mref2, process, Child2, kill} -> + ok; + {'DOWN', Mref2, _, _, _} = Down2b -> + ?t:fail(Down2b) + end, + ?line ?t:sleep(1000), % Just in case the file system is slow + ?line eof = ?FILE_MODULE:pread(Fd4, bof, 1), + ?line ok = ?FILE_MODULE:close(Fd4), + %% + %% Test if file position works with delayed_write + ?line {ok, Fd5} = ?FILE_MODULE:open(File, [raw, read, write, + delayed_write]), + ?line ok = ?FILE_MODULE:truncate(Fd5), + ?line ok = ?FILE_MODULE:write(Fd5, [Data1|Data2]), + ?line {ok, 0} = ?FILE_MODULE:position(Fd5, bof), + ?line ok = ?FILE_MODULE:write(Fd5, [Data3]), + ?line {ok, Data2} = ?FILE_MODULE:read(Fd5, Size+1), + ?line {ok, 0} = ?FILE_MODULE:position(Fd5, bof), + ?line Data3Data2 = Data3++Data2, + ?line {ok, Data3Data2} = ?FILE_MODULE:read(Fd5, 2*Size+1), + ?line ok = ?FILE_MODULE:close(Fd5), + %% + ?line [] = flush(), + ?line ?t:timetrap_cancel(Dog), + ?line case os:type() of + vxworks -> + {comment, "Some lines skipped on vxworks"}; + _ -> + ok + end. + + +pid2name(doc) -> "Tests file:pid2name/1."; +pid2name(suite) -> []; +pid2name(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line Base = test_server:temp_name( + filename:join(RootDir, "pid2name_")), + ?line Name1 = [Base, '.txt'], + ?line Name2 = Base ++ ".txt", + %% + ?line {ok, Pid} = file:open(Name1, [write]), + ?line {ok, Name2} = file:pid2name(Pid), + ?line undefined = file:pid2name(self()), + ?line ok = file:close(Pid), + ?line test_server:sleep(1000), + ?line false = is_process_alive(Pid), + ?line undefined = file:pid2name(Pid), + %% + ?line test_server:timetrap_cancel(Dog), + ok. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +read_ahead(suite) -> + []; +read_ahead(doc) -> + ["Tests the file open option {read_ahead, Size}"]; + +read_ahead(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(20)), + %% + ?line RootDir = ?config(priv_dir, Config), + ?line File = filename:join(RootDir, + atom_to_list(?MODULE)++"_read_ahead.txt"), + ?line Data1 = "asdfghjkl", % Must be + ?line Data2 = "qwertyuio", % same + ?line Data3 = "zxcvbnm,.", % length + ?line Size = length(Data1), + ?line Size = length(Data2), + ?line Size = length(Data3), + %% + %% Test caching of normal non-raw file + ?line {ok, Fd1} = ?FILE_MODULE:open(File, [write]), + ?line ok = ?FILE_MODULE:write(Fd1, [Data1|Data1]), + ?line ?t:sleep(1000), % Just in case the file system is slow + ?line {ok, Fd2} = ?FILE_MODULE:open(File, [read, {read_ahead, 2*Size}]), + ?line {ok, Data1} = ?FILE_MODULE:read(Fd2, Size), + ?line ok = ?FILE_MODULE:pwrite(Fd1, Size, Data2), + ?line ?t:sleep(1000), % Just in case the file system is slow + ?line {ok, Data1} = ?FILE_MODULE:read(Fd2, Size), % Will read cached data + ?line Data2Data2Data2 = Data2++Data2++Data2, + ?line ok = ?FILE_MODULE:pwrite(Fd1, eof, Data2Data2Data2), + ?line ?t:sleep(1000), % Just in case the file system is slow + ?line {ok, Data2Data2Data2} = + ?FILE_MODULE:read(Fd2, 3*Size), % Read more than cache buffer + ?line ok = ?FILE_MODULE:close(Fd1), + ?line ok = ?FILE_MODULE:close(Fd2), + %% Test caching of raw file and default parameters + ?line {ok, Fd3} = ?FILE_MODULE:open(File, [raw, write]), + ?line ok = ?FILE_MODULE:write(Fd3, [Data1|Data1]), + ?line ?t:sleep(1000), % Just in case the file system is slow + ?line {ok, Fd4} = ?FILE_MODULE:open(File, [raw, read, read_ahead]), + ?line {ok, Data1} = ?FILE_MODULE:read(Fd4, Size), + ?line ok = ?FILE_MODULE:pwrite(Fd3, Size, Data2), + ?line ?t:sleep(1000), % Just in case the file system is slow + ?line {ok, Data1} = ?FILE_MODULE:read(Fd4, Size), % Will read cached data + ?line ok = ?FILE_MODULE:close(Fd3), + ?line ok = ?FILE_MODULE:close(Fd4), + %% Test if the file position works in combination with read_ahead + ?line {ok, Fd5} = ?FILE_MODULE:open(File, [raw, read, write, read_ahead]), + ?line ok = ?FILE_MODULE:truncate(Fd5), + ?line ok = ?FILE_MODULE:write(Fd5, [Data1,Data1|Data3]), + ?line {ok, 0} = ?FILE_MODULE:position(Fd5, bof), + ?line {ok, Data1} = ?FILE_MODULE:read(Fd5, Size), + ?line ok = ?FILE_MODULE:write(Fd5, Data2), + ?line {ok, 0} = ?FILE_MODULE:position(Fd5, bof), + ?line Data1Data2Data3 = Data1++Data2++Data3, + ?line {ok, Data1Data2Data3} = ?FILE_MODULE:read(Fd5, 3*Size+1), + ?line ok = ?FILE_MODULE:close(Fd5), + %% + ?line [] = flush(), + ?line ?t:timetrap_cancel(Dog), + ok. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +segment_read(suite) -> + []; +segment_read(doc) -> + ["Tests the segmenting of large reads"]; +segment_read(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(60)), + %% + ?line Name = filename:join(?config(priv_dir, Config), + ?MODULE_STRING ++ "_segment_read"), + ?line SegSize = 256*1024, + ?line SegCnt = SegSize div 4, + ?line Cnt = 4 * SegCnt, + ?line ok = create_file(Name, Cnt), + %% + %% read_file/1 + %% + ?line {ok, Bin} = ?FILE_MODULE:read_file(Name), + ?line true = verify_bin(Bin, 0, Cnt), + %% + %% read/2 + %% + %% Not segmented + ?line {ok, FD1} = ?FILE_MODULE:open(Name, [read, raw, binary]), + ?line {ok, B1a} = ?FILE_MODULE:read(FD1, SegSize), + ?line {ok, B1b} = ?FILE_MODULE:read(FD1, SegSize), + ?line {ok, B1c} = ?FILE_MODULE:read(FD1, SegSize), + ?line {ok, B1d} = ?FILE_MODULE:read(FD1, SegSize), + ?line ok = ?FILE_MODULE:close(FD1), + ?line true = verify_bin(B1a, 0*SegCnt, SegCnt), + ?line true = verify_bin(B1b, 1*SegCnt, SegCnt), + ?line true = verify_bin(B1c, 2*SegCnt, SegCnt), + ?line true = verify_bin(B1d, 3*SegCnt, SegCnt), + %% + %% Segmented + ?line {ok, FD2} = ?FILE_MODULE:open(Name, [read, raw, binary]), + ?line {ok, B2a} = ?FILE_MODULE:read(FD2, 1*SegSize), + ?line {ok, B2b} = ?FILE_MODULE:read(FD2, 2*SegSize), + ?line {ok, B2c} = ?FILE_MODULE:read(FD2, 2*SegSize), + ?line ok = ?FILE_MODULE:close(FD2), + ?line true = verify_bin(B2a, 0*SegCnt, 1*SegCnt), + ?line true = verify_bin(B2b, 1*SegCnt, 2*SegCnt), + ?line true = verify_bin(B2c, 3*SegCnt, 1*SegCnt), + %% + %% pread/3 + %% + ?line {ok, FD3} = ?FILE_MODULE:open(Name, [read, raw, binary]), + %% + %% Not segmented + ?line {ok, B3d} = ?FILE_MODULE:pread(FD3, 3*SegSize, SegSize), + ?line {ok, B3c} = ?FILE_MODULE:pread(FD3, 2*SegSize, SegSize), + ?line {ok, B3b} = ?FILE_MODULE:pread(FD3, 1*SegSize, SegSize), + ?line {ok, B3a} = ?FILE_MODULE:pread(FD3, 0*SegSize, SegSize), + ?line true = verify_bin(B3a, 0*SegCnt, SegCnt), + ?line true = verify_bin(B3b, 1*SegCnt, SegCnt), + ?line true = verify_bin(B3c, 2*SegCnt, SegCnt), + ?line true = verify_bin(B3d, 3*SegCnt, SegCnt), + %% + %% Segmented + ?line {ok, B3g} = ?FILE_MODULE:pread(FD3, 3*SegSize, 2*SegSize), + ?line {ok, B3f} = ?FILE_MODULE:pread(FD3, 1*SegSize, 2*SegSize), + ?line {ok, B3e} = ?FILE_MODULE:pread(FD3, 0*SegSize, 1*SegSize), + ?line true = verify_bin(B3e, 0*SegCnt, 1*SegCnt), + ?line true = verify_bin(B3f, 1*SegCnt, 2*SegCnt), + ?line true = verify_bin(B3g, 3*SegCnt, 1*SegCnt), + %% + ?line ok = ?FILE_MODULE:close(FD3), + %% + %% pread/2 + %% + ?line {ok, FD5} = ?FILE_MODULE:open(Name, [read, raw, binary]), + %% + %% +---+---+---+---+ + %% | 4 | 3 | 2 | 1 | + %% +---+---+---+---+ + %% < ^ > + ?line {ok, [B5d, B5c, B5b, B5a]} = + ?FILE_MODULE:pread(FD5, [{3*SegSize, SegSize}, + {2*SegSize, SegSize}, + {1*SegSize, SegSize}, + {0*SegSize, SegSize}]), + ?line true = verify_bin(B5a, 0*SegCnt, SegCnt), + ?line true = verify_bin(B5b, 1*SegCnt, SegCnt), + ?line true = verify_bin(B5c, 2*SegCnt, SegCnt), + ?line true = verify_bin(B5d, 3*SegCnt, SegCnt), + %% + %% +---+-------+-------+ + %% | 3 | 2 | 1 | + %% +---+-------+-------+ + %% < ^ ^ > + ?line {ok, [B5g, B5f, B5e]} = + ?FILE_MODULE:pread(FD5, [{3*SegSize, 2*SegSize}, + {1*SegSize, 2*SegSize}, + {0*SegSize, 1*SegSize}]), + ?line true = verify_bin(B5e, 0*SegCnt, 1*SegCnt), + ?line true = verify_bin(B5f, 1*SegCnt, 2*SegCnt), + ?line true = verify_bin(B5g, 3*SegCnt, 1*SegCnt), + %% + %% + %% +-------+-----------+ + %% | 2 | 1 | + %% +-------+-----------+ + %% < ^ ^ > + ?line {ok, [B5i, B5h]} = + ?FILE_MODULE:pread(FD5, [{2*SegSize, 3*SegSize}, + {0*SegSize, 2*SegSize}]), + ?line true = verify_bin(B5h, 0*SegCnt, 2*SegCnt), + ?line true = verify_bin(B5i, 2*SegCnt, 2*SegCnt), + %% + %% +-------+---+---+ + %% | 3 | 2 | 1 | + %% +-------+---+---+ + %% < ^ ^ > + ?line {ok, [B5l, B5k, B5j]} = + ?FILE_MODULE:pread(FD5, [{3*SegSize, 1*SegSize}, + {2*SegSize, 1*SegSize}, + {0*SegSize, 2*SegSize}]), + ?line true = verify_bin(B5j, 0*SegCnt, 2*SegCnt), + ?line true = verify_bin(B5k, 2*SegCnt, 1*SegCnt), + ?line true = verify_bin(B5l, 3*SegCnt, 1*SegCnt), + %% + %% Real time response time test. + %% + Req = lists:flatten(lists:duplicate(17, + [{2*SegSize, 2*SegSize}, + {0*SegSize, 2*SegSize}])), + ?line {{ok, _}, Comment} = + response_analysis(?FILE_MODULE, pread, [FD5, Req]), + ?line ok = ?FILE_MODULE:close(FD5), + %% + ?line [] = flush(), + ?line ?t:timetrap_cancel(Dog), + {comment, Comment}. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +segment_write(suite) -> + []; +segment_write(doc) -> + ["Tests the segmenting of large writes"]; +segment_write(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(60)), + %% + ?line Name = filename:join(?config(priv_dir, Config), + ?MODULE_STRING ++ "_segment_write"), + ?line SegSize = 256*1024, + ?line SegCnt = SegSize div 4, + ?line Cnt = 4 * SegCnt, + ?line Bin = create_bin(0, Cnt), + %% + %% write/2 + %% + %% Not segmented + ?line {ok, FD1} = ?FILE_MODULE:open(Name, [write, raw, binary]), + ?line ok = ?FILE_MODULE:write(FD1, subbin(Bin, 0*SegSize, 1*SegSize)), + ?line ok = ?FILE_MODULE:write(FD1, subbin(Bin, 1*SegSize, 1*SegSize)), + ?line ok = ?FILE_MODULE:write(FD1, subbin(Bin, 2*SegSize, 1*SegSize)), + ?line ok = ?FILE_MODULE:write(FD1, subbin(Bin, 3*SegSize, 1*SegSize)), + ?line ok = ?FILE_MODULE:close(FD1), + ?line true = verify_file(Name, Cnt), + %% + %% Segmented + ?line {ok, FD2} = ?FILE_MODULE:open(Name, [write, raw, binary]), + ?line ok = ?FILE_MODULE:write(FD2, subbin(Bin, 0*SegSize, 1*SegSize)), + ?line ok = ?FILE_MODULE:write(FD2, subbin(Bin, 1*SegSize, 2*SegSize)), + ?line ok = ?FILE_MODULE:write(FD2, subbin(Bin, 3*SegSize, 1*SegSize)), + ?line ok = ?FILE_MODULE:close(FD2), + ?line true = verify_file(Name, Cnt), + %% + %% +---+---+---+---+ + %% | | | | | + %% +---+---+---+---+ + %% < ^ > + ?line ok = write_file(Name, [subbin(Bin, 0*SegSize, 1*SegSize), + subbin(Bin, 1*SegSize, 1*SegSize), + subbin(Bin, 2*SegSize, 1*SegSize), + subbin(Bin, 3*SegSize, 1*SegSize)]), + ?line true = verify_file(Name, Cnt), + %% + %% +---+-------+---+ + %% | | | | + %% +---+-------+---+ + %% < ^ ^ > + ?line ok = write_file(Name, [subbin(Bin, 0*SegSize, 1*SegSize), + subbin(Bin, 1*SegSize, 2*SegSize), + subbin(Bin, 3*SegSize, 1*SegSize)]), + ?line true = verify_file(Name, Cnt), + %% + %% +-------+-------+ + %% | | | + %% +-------+-------+ + %% < ^ ^ > + ?line ok = write_file(Name, [subbin(Bin, 0*SegSize, 2*SegSize), + subbin(Bin, 2*SegSize, 2*SegSize)]), + ?line true = verify_file(Name, Cnt), + %% + %% +-------+---+---+ + %% | | | | + %% +-------+---+---+ + %% < ^ ^ > + ?line ok = write_file(Name, [subbin(Bin, 0*SegSize, 2*SegSize), + subbin(Bin, 2*SegSize, 1*SegSize), + subbin(Bin, 3*SegSize, 1*SegSize)]), + ?line true = verify_file(Name, Cnt), + %% + %% pwrite/3 + %% + %% Not segmented + ?line {ok, FD3} = ?FILE_MODULE:open(Name, [write, raw, binary]), + ?line ok = ?FILE_MODULE:pwrite(FD3, 3*SegSize, + subbin(Bin, 3*SegSize, 1*SegSize)), + ?line ok = ?FILE_MODULE:pwrite(FD3, 2*SegSize, + subbin(Bin, 2*SegSize, 1*SegSize)), + ?line ok = ?FILE_MODULE:pwrite(FD3, 1*SegSize, + subbin(Bin, 1*SegSize, 1*SegSize)), + ?line ok = ?FILE_MODULE:pwrite(FD3, 0*SegSize, + subbin(Bin, 0*SegSize, 1*SegSize)), + ?line ok = ?FILE_MODULE:close(FD3), + ?line true = verify_file(Name, Cnt), + %% + %% Segmented + ?line {ok, FD4} = ?FILE_MODULE:open(Name, [write, raw, binary]), + ?line ok = ?FILE_MODULE:pwrite(FD4, 3*SegSize, + subbin(Bin, 3*SegSize, 1*SegSize)), + ?line ok = ?FILE_MODULE:pwrite(FD4, 1*SegSize, + subbin(Bin, 1*SegSize, 2*SegSize)), + ?line ok = ?FILE_MODULE:pwrite(FD4, 0*SegSize, + subbin(Bin, 0*SegSize, 1*SegSize)), + ?line ok = ?FILE_MODULE:close(FD4), + ?line true = verify_file(Name, Cnt), + + + + %% + %% pwrite/2 + %% + %% Not segmented + ?line {ok, FD5} = ?FILE_MODULE:open(Name, [write, raw, binary]), + ?line ok = ?FILE_MODULE:pwrite(FD5, [{3*SegSize, + subbin(Bin, 3*SegSize, 1*SegSize)}]), + ?line ok = ?FILE_MODULE:pwrite(FD5, [{2*SegSize, + subbin(Bin, 2*SegSize, 1*SegSize)}]), + ?line ok = ?FILE_MODULE:pwrite(FD5, [{1*SegSize, + subbin(Bin, 1*SegSize, 1*SegSize)}]), + ?line ok = ?FILE_MODULE:pwrite(FD5, [{0*SegSize, + subbin(Bin, 0*SegSize, 1*SegSize)}]), + ?line ok = ?FILE_MODULE:close(FD5), + ?line true = verify_file(Name, Cnt), + %% + %% Segmented + ?line {ok, FD6} = ?FILE_MODULE:open(Name, [write, raw, binary]), + ?line ok = ?FILE_MODULE:pwrite(FD6, [{3*SegSize, + subbin(Bin, 3*SegSize, 1*SegSize)}]), + ?line ok = ?FILE_MODULE:pwrite(FD6, [{1*SegSize, + subbin(Bin, 1*SegSize, 2*SegSize)}]), + ?line ok = ?FILE_MODULE:pwrite(FD6, [{0*SegSize, + subbin(Bin, 0*SegSize, 1*SegSize)}]), + ?line ok = ?FILE_MODULE:close(FD6), + ?line true = verify_file(Name, Cnt), + %% + %% +---+---+---+---+ + %% | 4 | 3 | 2 | 1 | + %% +---+---+---+---+ + %% < ^ > + ?line ok = pwrite_file(Name, [{3*SegSize, + subbin(Bin, 3*SegSize, 1*SegSize)}, + {2*SegSize, + subbin(Bin, 2*SegSize, 1*SegSize)}, + {1*SegSize, + subbin(Bin, 1*SegSize, 1*SegSize)}, + {0*SegSize, + subbin(Bin, 0*SegSize, 1*SegSize)}]), + ?line true = verify_file(Name, Cnt), + %% + %% +---+-------+---+ + %% | 3 | 2 | 1 | + %% +---+-------+---+ + %% < ^ ^ > + ?line ok = pwrite_file(Name, [{3*SegSize, + subbin(Bin, 3*SegSize, 1*SegSize)}, + {1*SegSize, + subbin(Bin, 1*SegSize, 2*SegSize)}, + {0*SegSize, + subbin(Bin, 0*SegSize, 1*SegSize)}]), + ?line true = verify_file(Name, Cnt), + %% + %% +-------+-------+ + %% | 2 | 1 | + %% +-------+-------+ + %% < ^ ^ > + ?line ok = pwrite_file(Name, [{2*SegSize, + subbin(Bin, 2*SegSize, 2*SegSize)}, + {0*SegSize, + subbin(Bin, 0*SegSize, 2*SegSize)}]), + ?line true = verify_file(Name, Cnt), + %% + %% +-------+---+---+ + %% | 3 | 2 | 1 | + %% +-------+---+---+ + %% < ^ ^ > + ?line ok = pwrite_file(Name, [{3*SegSize, + subbin(Bin, 3*SegSize, 1*SegSize)}, + {2*SegSize, + subbin(Bin, 2*SegSize, 1*SegSize)}, + {0*SegSize, + subbin(Bin, 0*SegSize, 2*SegSize)}]), + ?line true = verify_file(Name, Cnt), + %% + %% Real time response time test. + %% + ?line {ok, FD7} = ?FILE_MODULE:open(Name, [write, raw, binary]), + Req = lists:flatten(lists:duplicate(17, + [{2*SegSize, + subbin(Bin, 2*SegSize, 2*SegSize)}, + {0*SegSize, + subbin(Bin, 0*SegSize, 2*SegSize)}])), + ?line {ok, Comment} = + response_analysis(?FILE_MODULE, pwrite, [FD7, Req]), + ?line ok = ?FILE_MODULE:close(FD7), + %% + ?line [] = flush(), + ?line ?t:timetrap_cancel(Dog), + {comment, Comment}. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +ipread(suite) -> + []; +ipread(doc) -> + ["Test Dets special indirect pread"]; +ipread(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(30)), + %% + ?line Dir = ?config(priv_dir, Config), + ?line ok = ipread_int(Dir, [raw, binary]), + ?line ok = ipread_int(Dir, [raw]), + ?line ok = ipread_int(Dir, [binary]), + ?line ok = ipread_int(Dir, []), + ?line ok = ipread_int(Dir, [ram, binary]), + ?line ok = ipread_int(Dir, [ram]), + %% + ?line [] = flush(), + ?line ?t:timetrap_cancel(Dog), + ok. + +ipread_int(Dir, ModeList) -> + ?line Name = + filename:join(Dir, + lists:flatten([?MODULE_STRING, "_ipread", + lists:map(fun (X) -> + ["_", atom_to_list(X)] + end, + ModeList)])), + ?line io:format("ipread_int<~p, ~p>~n", [Name, ModeList]), + ?line {Conv, Sizeof} = + case lists:member(binary, ModeList) of + true -> + {fun (Bin) when is_binary(Bin) -> Bin; + (List) when is_list(List) -> list_to_binary(List) + end, + {erlang, size}}; + false -> + {fun (Bin) when is_binary(Bin) -> binary_to_list(Bin); + (List) when is_list(List) -> List + end, + {erlang, length}} + end, + ?line Pos = 4711, + ?line Data = Conv("THE QUICK BROWN FOX JUMPS OVER A LAZY DOG"), + ?line Size = Sizeof(Data), + ?line Init = Conv(" "), + ?line SizeInit = Sizeof(Init), + ?line Head = Conv(<<Size:32/big-unsigned, Pos:32/big-unsigned>>), + ?line Filler = Conv(bytes($ , Pos-SizeInit-Sizeof(Head))), + ?line Size1 = Size+1, + ?line SizePos = Size+Pos, + %% + ?line {ok, FD} = ?FILE_MODULE:open(Name, [write, read | ModeList]), + ?line ok = ?FILE_MODULE:truncate(FD), + ?line ok = ?FILE_MODULE:write(FD, Init), + ?line ok = ?FILE_MODULE:write(FD, Head), + ?line ok = ?FILE_MODULE:write(FD, Filler), + ?line ok = ?FILE_MODULE:write(FD, Data), + %% Correct read + ?line {ok, {Size, Pos, Data}} = + ?FILE_MODULE:ipread_s32bu_p32bu(FD, SizeInit, infinity), + %% Invalid header - size > max + ?line eof = + ?FILE_MODULE:ipread_s32bu_p32bu(FD, SizeInit, Size-1), + %% Data block protudes over eof + ?line ok = + ?FILE_MODULE:pwrite(FD, SizeInit, + <<Size1:32/big-unsigned, + Pos:32/big-unsigned>>), + ?line {ok, {Size1, Pos, Data}} = + ?FILE_MODULE:ipread_s32bu_p32bu(FD, SizeInit, Size1), + %% Data block outside file + ?line ok = + ?FILE_MODULE:pwrite(FD, SizeInit, + <<Size:32/big-unsigned, + SizePos:32/big-unsigned>>), + ?line {ok, {Size, SizePos, eof}} = + ?FILE_MODULE:ipread_s32bu_p32bu(FD, SizeInit, Size), + %% Zero size + ?line ok = + ?FILE_MODULE:pwrite(FD, SizeInit, + <<0:32/big-unsigned, + Pos:32/big-unsigned>>), + ?line {ok, {0, Pos, eof}} = + ?FILE_MODULE:ipread_s32bu_p32bu(FD, SizeInit, Size), + %% Invalid header - protudes over eof + ?line eof = + ?FILE_MODULE:ipread_s32bu_p32bu(FD, + Pos+Size-(Sizeof(Head)-1), + infinity), + %% Header not even in file + ?line eof = + ?FILE_MODULE:ipread_s32bu_p32bu(FD, Pos+Size, infinity), + %% + ?line ok = ?FILE_MODULE:close(FD), + ok. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +interleaved_read_write(suite) -> + []; +interleaved_read_write(doc) -> + ["Tests interleaved read and writes"]; +interleaved_read_write(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(30)), + %% + ?line Dir = ?config(priv_dir, Config), + ?line File = + filename:join(Dir, ?MODULE_STRING++"interleaved_read_write.txt"), + ?line {ok,F1} = ?FILE_MODULE:open(File, [write]), + ?line ok = ?FILE_MODULE:write(F1, "data---r1."), % 10 chars each + ?line ok = ?FILE_MODULE:write(F1, "data---r2."), + ?line ok = ?FILE_MODULE:write(F1, "data---r3."), + ?line ok = ?FILE_MODULE:close(F1), + ?line {ok,F2} = ?FILE_MODULE:open(File, [read, write]), + ?line {ok, "data---r1."} = ?FILE_MODULE:read(F2, 10), + ?line ok = ?FILE_MODULE:write(F2, "data---w2."), + ?line ok = ?FILE_MODULE:close(F2), + ?line {ok,F3} = ?FILE_MODULE:open(File, [read]), + ?line {ok, "data---r1."} = ?FILE_MODULE:read(F3, 10), + ?line {ok, "data---w2."} = ?FILE_MODULE:read(F3, 10), + ?line {ok, "data---r3."} = ?FILE_MODULE:read(F3, 10), + ?line eof = ?FILE_MODULE:read(F3, 1), + ?line ok = ?FILE_MODULE:close(F2), + %% + ?line [] = flush(), + ?line ?t:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +otp_5814(suite) -> + []; +otp_5814(doc) -> + ["OTP-5814. eval/consult/script return correct line numbers"]; +otp_5814(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(10)), + PrivDir = ?config(priv_dir, Config), + File = filename:join(PrivDir, "otp_5814"), + Path = [PrivDir], + ?line ok = file:write_file(File, <<"{a,b,c}. + a. + b. + c. + {d,e, + [}.">>), + ?line {error, {6,erl_parse,_}} = file:eval(File), + ?line {error, {6,erl_parse,_}} = file:consult(File), + ?line {error, {6,erl_parse,_}} = file:path_consult(Path, File), + ?line {error, {6,erl_parse,_}} = file:path_eval(Path, File), + ?line {error, {6,erl_parse,_}} = file:script(File), + ?line {error, {6,erl_parse,_}} = file:path_script(Path, File), + + ?line ok = file:write_file(File, <<>>), + ?line {error, {1,file,undefined_script}} = file:path_script(Path, File), + + %% The error is not propagated... + ?line ok = file:write_file(File, <<"a. + b. + 1/0.">>), + ?line {error, {3, file, {error, badarith, _}}} = file:eval(File), + + ?line ok = file:write_file(File, <<"erlang:raise(throw, apa, []).">>), + ?line {error, {1, file, {throw, apa, _}}} = file:eval(File), + + file:delete(File), + ?line ?t:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +large_file(suite) -> + []; +large_file(doc) -> + ["Tests positioning in large files (> 4G)"]; +large_file(Config) when is_list(Config) -> + case {os:type(),os:version()} of + {{win32,nt},_} -> + do_large_file(Config); + {{unix,sunos},{A,B,C}} + when A == 5, B == 5, C >= 1; A == 5, B >= 6; A >= 6 -> + do_large_file(Config); + {{unix,Unix},_} when Unix =:= linux; Unix =:= darwin -> + N = unix_free(Config), + io:format("Free: ~w KByte~n", [N]), + if N < 5 * (1 bsl 20) -> + %% Less than 5 GByte free + {skipped,"Less than 5 GByte free"}; + true -> + do_large_file(Config) + end; + _ -> + {skipped,"Only supported on Win32, Linux, or SunOS >= 5.5.1"} + end. + +unix_free(Config) -> + Cmd = ["df -k '",?config(priv_dir, Config),"'"], + DF0 = os:cmd(Cmd), + io:format("$ ~s~n~s", [Cmd,DF0]), + [$\n|DF1] = lists:dropwhile(fun ($\n) -> false; (_) -> true end, DF0), + {ok,[N],_} = io_lib:fread(" ~*s ~d", DF1), + N. + +do_large_file(Config) -> + ?line Watchdog = ?t:timetrap(?t:minutes(4)), + %% + ?line Name = filename:join(?config(priv_dir, Config), + ?MODULE_STRING ++ "_large_file"), + ?line Tester = self(), + Deleter = + spawn( + fun() -> + Mref = erlang:monitor(process, Tester), + receive + {'DOWN',Mref,_,_,_} -> ok; + {Tester,done} -> ok + end, + ?FILE_MODULE:delete(Name) + end), + %% + ?line S = "1234567890", + L = length(S), + R = lists:reverse(S), + P = 1 bsl 32, + Ss = lists:sort(S), + Rs = lists:reverse(Ss), + ?line {ok,F} = ?FILE_MODULE:open(Name, [raw,read,write]), + ?line ok = ?FILE_MODULE:write(F, S), + ?line {ok,P} = ?FILE_MODULE:position(F, P), + ?line ok = ?FILE_MODULE:write(F, R), + ?line {ok,0} = ?FILE_MODULE:position(F, bof), + ?line {ok,S} = ?FILE_MODULE:read(F, L), + ?line {ok,P} = ?FILE_MODULE:position(F, {eof,-L}), + ?line {ok,R} = ?FILE_MODULE:read(F, L+1), + ?line {ok,S} = ?FILE_MODULE:pread(F, 0, L), + ?line {ok,R} = ?FILE_MODULE:pread(F, P, L+1), + ?line ok = ?FILE_MODULE:pwrite(F, 0, Ss), + ?line ok = ?FILE_MODULE:pwrite(F, P, Rs), + ?line {ok,0} = ?FILE_MODULE:position(F, bof), + ?line {ok,Ss} = ?FILE_MODULE:read(F, L), + ?line {ok,P} = ?FILE_MODULE:position(F, {eof,-L}), + ?line {ok,Rs} = ?FILE_MODULE:read(F, L+1), + ?line ok = ?FILE_MODULE:close(F), + %% + ?line Mref = erlang:monitor(process, Deleter), + ?line Deleter ! {Tester,done}, + ?line receive {'DOWN',Mref,_,_,_} -> ok end, + %% + ?line ?t:timetrap_cancel(Watchdog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +response_analysis(Module, Function, Arguments) -> + Parent = self(), + ?line erlang:yield(), % Schedule out before test + ?line Child = + spawn_link( + fun () -> + receive {Parent, start, Ts} -> ok end, + Stat = + iterate(response_stat(response_stat(init, Ts), + erlang:now()), + done, + fun (S) -> + erlang:yield(), + receive + {Parent, stop} -> + done + after 0 -> + response_stat(S, erlang:now()) + end + end), + Parent ! {self(), stopped, response_stat(Stat, erlang:now())} + end), + ?line Child ! {Parent, start, erlang:now()}, + ?line Result = apply(Module, Function, Arguments), + ?line Child ! {Parent, stop}, + ?line {N, Sum, _, M, Max} = receive {Child, stopped, X} -> X end, + ?line Mean_ms = (0.001*Sum) / (N-1), + ?line Max_ms = 0.001 * Max, + ?line Comment = + lists:flatten( + io_lib:format( + "Scheduling interval: Mean = ~.3f ms, " + ++"Max = ~.3f ms for no ~p of ~p.~n", + [Mean_ms, Max_ms, M, (N-1)])), + ?line {Result, Comment}. + + + +response_stat(init, Ts) -> + {0, 0, Ts, 0, 0}; +response_stat({N, Sum, {A1, B1, C1}, M, Max}, {A2, B2, C2} = Ts) -> + D = C2-C1 + 1000000*((B2-B1) + 1000000*(A2-A1)), + if D > Max -> + {N+1, Sum+D, Ts, N, D}; + true -> + {N+1, Sum+D, Ts, M, Max} + end. + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + + +%% This function is kept just for benchmarking reasons. +%% create_file/2 below is some 44 times faster. + +create_file_slow(Name, N) when is_integer(N), N >= 0 -> + ?line {ok, FD} = + ?FILE_MODULE:open(Name, [raw, write, delayed_write, binary]), + ?line ok = create_file_slow(FD, 0, N), + ?line ok = ?FILE_MODULE:close(FD), + ok. + +create_file_slow(_FD, M, M) -> + ok; +create_file_slow(FD, M, N) -> + ok = ?FILE_MODULE:write(FD, <<M:32/unsigned>>), + create_file_slow(FD, M+1, N). + + + +%% Creates a file 'Name' containing 'N' unsigned 32 bit integers +%% from 0 to N-1. + +create_file(Name, N) when is_integer(N), N >= 0 -> + ?line {ok, FD} = + ?FILE_MODULE:open(Name, [raw, write, delayed_write, binary]), + ?line ok = create_file(FD, 0, N), + ?line ok = ?FILE_MODULE:close(FD), + ok. + +create_file(_FD, M, M) -> + ok; +create_file(FD, M, N) when M + 1024 =< N -> + create_file(FD, M, M + 1024, []), + create_file(FD, M + 1024, N); +create_file(FD, M, N) -> + create_file(FD, M, N, []). + +create_file(FD, M, M, R) -> + ok = ?FILE_MODULE:write(FD, R); +create_file(FD, M, N0, R) when M + 8 =< N0 -> + N1 = N0-1, N2 = N0-2, N3 = N0-3, N4 = N0-4, + N5 = N0-5, N6 = N0-6, N7 = N0-7, N8 = N0-8, + create_file(FD, M, N8, + [<<N8:32/unsigned, N7:32/unsigned, + N6:32/unsigned, N5:32/unsigned, + N4:32/unsigned, N3:32/unsigned, + N2:32/unsigned, N1:32/unsigned>> | R]); +create_file(FD, M, N0, R) -> + N1 = N0-1, + create_file(FD, M, N1, [<<N1:32/unsigned>> | R]). + + + +create_bin(M, N) when is_integer(M), is_integer(N), N >= 0, M >= 0 -> + create_bin(M, M+N, []). + +create_bin(N, N, R) -> + list_to_binary(R); +create_bin(M, N0, R) when M+8 =< N0 -> + N1 = N0-1, N2 = N0-2, N3 = N0-3, N4 = N0-4, + N5 = N0-5, N6 = N0-6, N7 = N0-7, N8 = N0-8, + create_bin(M, N8, + [<<N8:32/unsigned, N7:32/unsigned, + N6:32/unsigned, N5:32/unsigned, + N4:32/unsigned, N3:32/unsigned, + N2:32/unsigned, N1:32/unsigned>> | R]); +create_bin(M, N0, R) -> + N1 = N0-1, + create_bin(M, N1, [<<N1:32/unsigned>> | R]). + + + + +verify_bin(<<>>, _, 0) -> + true; +verify_bin(<<>>, _, _) -> + false; +verify_bin(Bin, N, Cnt) -> + N0 = N + 0, N1 = N + 1, N2 = N + 2, N3 = N + 3, + N4 = N + 4, N5 = N + 5, N6 = N + 6, N7 = N + 7, + case Bin of + <<N0:32/unsigned, N1:32/unsigned, N2:32/unsigned, N3:32/unsigned, + N4:32/unsigned, N5:32/unsigned, N6:32/unsigned, N7:32/unsigned, + B/binary>> -> + verify_bin(B, N+8, Cnt-8); + <<N:32/unsigned, B/binary>> -> + verify_bin(B, N+1, Cnt-1); + _ -> + false + end. + + + +verify_file(Name, N) when is_integer(N), N >= 0 -> + case ?FILE_MODULE:open(Name, [raw, read, binary]) of + {ok, FD} -> + Result = verify_file(FD, 0, 64*1024, N), + ok = ?FILE_MODULE:close(FD), + Result; + Error -> + Error + end. + +verify_file(FD, N, _, N) -> + case ?FILE_MODULE:read(FD, 1) of + eof -> + true; + {ok, _} -> + false + end; +verify_file(FD, M, Cnt, N) when M+Cnt =< N -> + case ?FILE_MODULE:read(FD, 4*Cnt) of + {ok, Bin} -> + case verify_bin(Bin, M, Cnt) of + true -> + verify_file(FD, M+Cnt, Cnt, N); + false -> + false + end; + _ -> + false + end; +verify_file(FD, M, _Cnt, N) -> + verify_file(FD, M, N-M, N). + + + +subbin(Bin, M, N) -> + <<_:M/binary, B:N/binary, _/binary>> = Bin, + B. + + + +write_file(Name, Data) -> + case ?FILE_MODULE:open(Name, [raw, write, binary]) of + {ok, FD} -> + Result = ?FILE_MODULE:write(FD, Data), + case {Result, ?FILE_MODULE:close(FD)} of + {ok, R} -> R; + _ -> Result + end; + Error -> + Error + end. + +pwrite_file(Name, Data) -> + case ?FILE_MODULE:open(Name, [raw, write, binary]) of + {ok, FD} -> + Result = ?FILE_MODULE:pwrite(FD, Data), + case {Result, ?FILE_MODULE:close(FD)} of + {ok, R} -> R; + _ -> Result + end; + Error -> + Error + end. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Read_line tests +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + + +read_line_testdata(PrivDir) -> + All0 = [{fun read_line_create0/1,"Testdata1.txt",5,10}, + {fun read_line_create1/1,"Testdata2.txt",401,802}, + {fun read_line_create2/1,"Testdata3.txt",1,2}, + {fun read_line_create3/1,"Testdata4.txt",601,fail}, + {fun read_line_create4/1,"Testdata5.txt",601,1002}, + {fun read_line_create5/1,"Testdata6.txt",601,1202}, + {fun read_line_create6/1,"Testdata7.txt",601,1202}, + {fun read_line_create7/1,"Testdata8.txt",4001,8002}], + [ {A,filename:join([PrivDir,B]),C,D} || {A,B,C,D} <- All0 ]. + +read_line_create_files(TestData) -> + [ Function(File) || {Function,File,_,_} <- TestData ]. + +read_line_remove_files(TestData) -> + [ file:delete(File) || {Function,File,_,_} <- TestData ]. + +read_line_1(suite) -> + []; +read_line_1(doc) -> + ["read_line with prim_file"]; +read_line_1(Config) when is_list(Config) -> + ?line PrivDir = ?config(priv_dir, Config), + ?line All = read_line_testdata(PrivDir), + ?line read_line_create_files(All), + ?line [ begin + io:format("read_line_all: ~s~n",[File]), + {X,_} = read_line_all(File), + true + end || {_,File,X,_} <- All ], + ?line [ begin + io:format("read_line_all_alternating: ~s~n",[File]), + {Y,_} = read_line_all_alternating(File), + true + end || {_,File,_,Y} <- All , Y =/= fail], + ?line [ begin + io:format("read_line_all_alternating (failing as should): ~s~n",[File]), + {'EXIT',_} = (catch read_line_all_alternating(File)), + true + end || {_,File,_,Y} <- All , Y =:= fail], + ?line read_line_remove_files(All), + ok. +read_line_2(suite) -> + []; +read_line_2(doc) -> + ["read_line with file"]; +read_line_2(Config) when is_list(Config) -> + ?line PrivDir = ?config(priv_dir, Config), + ?line All = read_line_testdata(PrivDir), + ?line read_line_create_files(All), + ?line [ begin + io:format("read_line_all: ~s~n",[File]), + {X,_} = read_line_all2(File), + true + end || {_,File,X,_} <- All ], + ?line [ begin + io:format("read_line_all_alternating: ~s~n",[File]), + {Y,_} = read_line_all_alternating2(File), + true + end || {_,File,_,Y} <- All , Y =/= fail], + ?line [ begin + io:format("read_line_all_alternating (failing as should): ~s~n",[File]), + {'EXIT',_} = (catch read_line_all_alternating2(File)), + true + end || {_,File,_,Y} <- All , Y =:= fail], + ?line read_line_remove_files(All), + ok. +read_line_3(suite) -> + []; +read_line_3(doc) -> + ["read_line with raw file"]; +read_line_3(Config) when is_list(Config) -> + ?line PrivDir = ?config(priv_dir, Config), + ?line All = read_line_testdata(PrivDir), + ?line read_line_create_files(All), + ?line [ begin + io:format("read_line_all: ~s~n",[File]), + {X,_} = read_line_all3(File), + true + end || {_,File,X,_} <- All ], + ?line [ begin + io:format("read_line_all_alternating: ~s~n",[File]), + {Y,_} = read_line_all_alternating3(File), + true + end || {_,File,_,Y} <- All , Y =/= fail], + ?line [ begin + io:format("read_line_all_alternating (failing as should): ~s~n",[File]), + {'EXIT',_} = (catch read_line_all_alternating3(File)), + true + end || {_,File,_,Y} <- All , Y =:= fail], + ?line read_line_remove_files(All), + ok. +read_line_4(suite) -> + []; +read_line_4(doc) -> + ["read_line with raw buffered file"]; +read_line_4(Config) when is_list(Config) -> + ?line PrivDir = ?config(priv_dir, Config), + ?line All = read_line_testdata(PrivDir), + ?line read_line_create_files(All), + ?line [ begin + io:format("read_line_all: ~s~n",[File]), + {X,_} = read_line_all4(File), + true + end || {_,File,X,_} <- All ], + ?line [ begin + io:format("read_line_all_alternating: ~s~n",[File]), + {Y,_} = read_line_all_alternating4(File), + true + end || {_,File,_,Y} <- All , Y =/= fail], + ?line [ begin + io:format("read_line_all_alternating (failing as should): ~s~n",[File]), + {'EXIT',_} = (catch read_line_all_alternating4(File)), + true + end || {_,File,_,Y} <- All , Y =:= fail], + ?line read_line_remove_files(All), + ok. + +rl_lines() -> + [ <<"hej">>,<<"hopp">>,<<"i">>,<<"lingon\rskogen">>]. + +read_line_create0(Filename) -> + {ok,F} = file:open(Filename,[write]), + L = rl_lines(), + [ file:write(F,[R,<<"\r\n">>]) || R <- L ], + file:write(F,<<"Inget radslut\r">>), + file:close(F). +read_line_create1(Filename) -> + {ok,F} = file:open(Filename,[write]), + L = rl_lines(), + [ begin + [ file:write(F,[R,<<"\r\n">>]) || R <- L ], + file:write(F,<<"Inget radslut\r">>) + end || _ <- lists:seq(1,100)], + file:close(F). +read_line_create2(Filename) -> + {ok,F} = file:open(Filename,[write]), + L = rl_lines(), + [ begin + [ file:write(F,[R]) || R <- L ], + file:write(F,<<"Inget radslut\r">>) + end || _ <- lists:seq(1,200)], + file:write(F,<<"\r\n">>), + file:close(F). + +read_line_create3(Filename) -> + {ok,F} = file:open(Filename,[write]), + L = rl_lines(), + [ begin + file:write(F,<<"\r\n">>), + file:write(F,<<"\r\n">>), + [ file:write(F,[R,<<"\r\n">>]) || R <- L ], + file:write(F,<<"Inget radslut\r">>) + end || _ <- lists:seq(1,100)], + file:close(F). + +read_line_create4(Filename) -> + {ok,F} = file:open(Filename,[write]), + L = rl_lines(), + [ begin + file:write(F,<<"\n">>), + file:write(F,<<"\n">>), + [ file:write(F,[R,<<"\r\n">>]) || R <- L ], + file:write(F,<<"Inget radslut\r">>) + end || _ <- lists:seq(1,100)], + file:close(F). + +read_line_create5(Filename) -> + {ok,F} = file:open(Filename,[write]), + L = rl_lines(), + [ begin + file:write(F,<<"i\n">>), + file:write(F,<<"i\n">>), + [ file:write(F,[R,<<"\r\n">>]) || R <- L ], + file:write(F,<<"Inget radslut\r">>) + end || _ <- lists:seq(1,100)], + file:close(F). + +read_line_create6(Filename) -> + {ok,F} = file:open(Filename,[write]), + L = rl_lines(), + [ begin + file:write(F,<<"i\r\n">>), + file:write(F,<<"i\r\n">>), + [ file:write(F,[R,<<"\r\n">>]) || R <- L ], + file:write(F,<<"Inget radslut\r">>) + end || _ <- lists:seq(1,100)], + file:close(F). +read_line_create7(Filename) -> + {ok,F} = file:open(Filename,[write]), + L = rl_lines(), + [ begin + [ file:write(F,[R,<<"\r\n">>]) || R <- L ], + file:write(F,<<"Inget radslut\r">>) + end || _ <- lists:seq(1,1000)], + file:close(F). + +read_line_all(Filename) -> + {ok,F} = prim_file:open(Filename,[read,binary]), + X=read_rl_lines(F), + prim_file:close(F), + Bin = list_to_binary([B || {ok,B} <- X]), + Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]), + "\r\n","\n",[global,{return,binary}]), + {length(X),Bin}. + +read_line_all2(Filename) -> + {ok,F} = file:open(Filename,[read,binary]), + X=read_rl_lines2(F), + file:close(F), + Bin = list_to_binary([B || {ok,B} <- X]), + Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]), + "\r\n","\n",[global,{return,binary}]), + {length(X),Bin}. + +read_line_all3(Filename) -> + {ok,F} = file:open(Filename,[read,binary,raw]), + X=read_rl_lines2(F), + file:close(F), + Bin = list_to_binary([B || {ok,B} <- X]), + Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]), + "\r\n","\n",[global,{return,binary}]), + {length(X),Bin}. +read_line_all4(Filename) -> + {ok,F} = file:open(Filename,[read,binary,raw,{read_ahead,8192}]), + X=read_rl_lines2(F), + file:close(F), + Bin = list_to_binary([B || {ok,B} <- X]), + Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]), + "\r\n","\n",[global,{return,binary}]), + {length(X),Bin}. + +read_rl_lines(F) -> + case prim_file:read_line(F) of + eof -> + []; + {error,X} -> + {error,X}; + List -> + [List | read_rl_lines(F)] + end. + +read_rl_lines2(F) -> + case file:read_line(F) of + eof -> + []; + {error,X} -> + {error,X}; + List -> + [List | read_rl_lines2(F)] + end. + +read_line_all_alternating(Filename) -> + {ok,F} = prim_file:open(Filename,[read,binary]), + X=read_rl_lines(F,true), + prim_file:close(F), + Bin = list_to_binary([B || {ok,B} <- X]), + Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]), + "\r\n","\n",[global,{return,binary}]), + {length(X),Bin}. + +read_line_all_alternating2(Filename) -> + {ok,F} = file:open(Filename,[read,binary]), + X=read_rl_lines2(F,true), + file:close(F), + Bin = list_to_binary([B || {ok,B} <- X]), + Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]), + "\r\n","\n",[global,{return,binary}]), + {length(X),Bin}. +read_line_all_alternating3(Filename) -> + {ok,F} = file:open(Filename,[read,binary,raw]), + X=read_rl_lines2(F,true), + file:close(F), + Bin = list_to_binary([B || {ok,B} <- X]), + Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]), + "\r\n","\n",[global,{return,binary}]), + {length(X),Bin}. +read_line_all_alternating4(Filename) -> + {ok,F} = file:open(Filename,[read,binary,raw,{read_ahead,8192}]), + X=read_rl_lines2(F,true), + file:close(F), + Bin = list_to_binary([B || {ok,B} <- X]), + Bin = re:replace(list_to_binary([element(2,file:read_file(Filename))]), + "\r\n","\n",[global,{return,binary}]), + {length(X),Bin}. + +read_rl_lines(F,Alternate) -> + case begin + case Alternate of + true -> prim_file:read(F,1); + false -> prim_file:read_line(F) + end + end of + eof -> + []; + {error,X} -> + {error,X}; + List -> + [List | read_rl_lines(F,not Alternate)] + end. +read_rl_lines2(F,Alternate) -> + case begin + case Alternate of + true -> file:read(F,1); + false -> file:read_line(F) + end + end of + eof -> + []; + {error,X} -> + {error,X}; + List -> + [List | read_rl_lines2(F,not Alternate)] + end. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +bytes(B, N) + when is_integer(B), 0 =< B, B =< 255, is_integer(N), N > 2, N band 1 == 0 -> + [bytes(B, N bsr 1), bytes(B, N bsr 1)]; +bytes(B, 0) + when is_integer(B), 0 =< B, B =< 255 -> + []; +bytes(B, 2) + when is_integer(B), 0 =< B, B =< 255 -> + [B, B]; +bytes(B, N) + when is_integer(B), 0 =< B, B =< 255, is_integer(N), N > 0 -> + [B, bytes(B, N-1)]. + + +%% A simple loop construct. +%% +%% Calls 'Fun' with argument 'Start' first and then repeatedly with +%% its returned value (state) until 'Fun' returns 'Stop'. Then +%% the last state value that was not 'Stop' is returned. + +iterate(Start, Done, Fun) when is_function(Fun) -> + iterate(Start, Done, Fun, Start). + +iterate(Done, Done, _Fun, I) -> + I; +iterate(I, Done, Fun, _) -> + iterate(Fun(I), Done, Fun, I). + + + +flush() -> + flush([]). + +flush(Msgs) -> + receive + Msg -> + flush([Msg | Msgs]) + after 0 -> + lists:reverse(Msgs) + end. diff --git a/lib/kernel/test/file_SUITE_data/cooked_tar_problem.tar.gz b/lib/kernel/test/file_SUITE_data/cooked_tar_problem.tar.gz Binary files differnew file mode 100644 index 0000000000..be2490581a --- /dev/null +++ b/lib/kernel/test/file_SUITE_data/cooked_tar_problem.tar.gz diff --git a/lib/kernel/test/file_SUITE_data/corrupted.gz b/lib/kernel/test/file_SUITE_data/corrupted.gz new file mode 100644 index 0000000000..16331b350c --- /dev/null +++ b/lib/kernel/test/file_SUITE_data/corrupted.gz @@ -0,0 +1,5 @@ + � +========================================== +This file has a correct GZIP magic ID, but the rest of the +header is corrupt. Reading this file should result in an +error. diff --git a/lib/kernel/test/file_SUITE_data/realmen.html b/lib/kernel/test/file_SUITE_data/realmen.html new file mode 100644 index 0000000000..c810a5d088 --- /dev/null +++ b/lib/kernel/test/file_SUITE_data/realmen.html @@ -0,0 +1,520 @@ +<TITLE>Real Programmers Don't Use PASCAL</TITLE> + +<H2 align=center>Real Programmers Don't Use PASCAL</H2> + +<H4 align=center><em>Ed Post<br> +Graphic Software Systems<br> + +P.O. Box 673<br> +25117 S.W. Parkway<br> +Wilsonville, OR 97070<br> +Copyright (c) 1982<br> +</H4></EM> + + +<H4 align=center><KBD> (decvax | ucbvax | cbosg | pur-ee | lbl-unix)!teklabs!ogcvax!gss1144!evp</KBD></H4> + + +Back in the good old days -- the "Golden Era" of computers, it was +easy to separate the men from the boys (sometimes called "Real Men" +and "Quiche Eaters" in the literature). During this period, the Real +Men were the ones that understood computer programming, and the Quiche +Eaters were the ones that didn't. A real computer programmer said +things like <KBD>"DO 10 I=1,10"</KBD> and <KBD>"ABEND"</KBD> (they +actually talked in capital letters, you understand), and the rest of +the world said things like <EM>"computers are too complicated for +me"</EM> and <EM>"I can't relate to computers -- they're so +impersonal"</EM>. (A previous work [1] points out that Real Men don't +"relate" to anything, and aren't afraid of being impersonal.) <P> + +But, as usual, times change. We are faced today with a world in which +little old ladies can get computerized microwave ovens, 12 year old +kids can blow Real Men out of the water playing Asteroids and Pac-Man, +and anyone can buy and even understand their very own Personal +Computer. The Real Programmer is in danger of becoming extinct, of +being replaced by high-school students with TRASH-80s! <P> + +There is a clear need to point out the differences between the typical +high-school junior Pac-Man player and a Real Programmer. Understanding +these differences will give these kids something to aspire to -- a +role model, a Father Figure. It will also help employers of Real +Programmers to realize why it would be a mistake to replace the Real +Programmers on their staff with 12 year old Pac-Man players (at a +considerable salary savings). <P> + + +<H3>LANGUAGES</H3> + +The easiest way to tell a Real Programmer from the crowd is by the +programming language he (or she) uses. Real Programmers use FORTRAN. +Quiche Eaters use PASCAL. Nicklaus Wirth, the designer of PASCAL, was +once asked, <EM>"How do you pronounce your name?"</EM>. He replied +<EM>"You can either call me by name, pronouncing it 'Veert', or call +me by value, 'Worth'."</EM> One can tell immediately from this comment +that Nicklaus Wirth is a Quiche Eater. The only parameter passing +mechanism endorsed by Real Programmers is call-by-value-return, as +implemented in the IBM/370 FORTRAN G and H compilers. Real +programmers don't need abstract concepts to get their jobs done: they +are perfectly happy with a keypunch, a FORTRAN IV compiler, and a +beer. <P> + +<UL> +<LI> Real Programmers do List Processing in FORTRAN. + +<LI> Real Programmers do String Manipulation in FORTRAN. + +<LI> Real Programmers do Accounting (if they do it at all) in FORTRAN. + +<LI> Real Programmers do Artificial Intelligence programs in FORTRAN. +</UL> <P> + +If you can't do it in FORTRAN, do it in assembly language. If you can't do +it in assembly language, it isn't worth doing. <P> + + +<H3> STRUCTURED PROGRAMMING</H3> + +Computer science academicians have gotten into the "structured pro- +gramming" rut over the past several years. They claim that programs +are more easily understood if the programmer uses some special +language constructs and techniques. They don't all agree on exactly +which constructs, of course, and the examples they use to show their +particular point of view invariably fit on a single page of some +obscure journal or another -- clearly not enough of an example to +convince anyone. When I got out of school, I thought I was the best +programmer in the world. I could write an unbeatable tic-tac-toe +program, use five different computer languages, and create 1000 line +programs that WORKED. (Really!) Then I got out into the Real +World. My first task in the Real World was to read and understand a +200,000 line FORTRAN program, then speed it up by a factor of two. Any +Real Programmer will tell you that all the Structured Coding in the +world won't help you solve a problem like that -- it takes actual +talent. Some quick observations on Real Programmers and Structured +Programming: <P> + +<UL> +<LI> Real Programmers aren't afraid to use GOTOs. + +<LI> Real Programmers can write five page long DO loops without +getting confused. + +<LI> Real Programmers enjoy Arithmetic IF statements because they make +the code more interesting. + +<LI> Real Programmers write self-modifying code, especially if it +saves them 20 nanoseconds in the middle of a tight loop. + +<LI> Programmers don't need comments: the code is obvious. + +<LI> Since FORTRAN doesn't have a structured <KBD>IF, REPEAT +... UNTIL</KBD>, or <KBD>CASE</KBD> statement, Real Programmers don't +have to worry about not using them. Besides, they can be simulated +when necessary using assigned <KBD>GOTO</KBD>s. + +</UL> <P> + +Data structures have also gotten a lot of press lately. Abstract Data +Types, Structures, Pointers, Lists, and Strings have become popular in +certain circles. Wirth (the above-mentioned Quiche Eater) actually +wrote an entire book [2] contending that you could write a program +based on data structures, instead of the other way around. As all Real +Programmers know, the only useful data structure is the +array. Strings, lists, structures, sets -- these are all special cases +of arrays and and can be treated that way just as easily without +messing up your programing language with all sorts of +complications. The worst thing about fancy data types is that you have +to declare them, and Real Programming Languages, as we all know, have +implicit typing based on the first letter of the (six character) +variable name. <P> + + +<H3> OPERATING SYSTEMS</H3> + +What kind of operating system is used by a Real Programmer? CP/M? God +forbid -- CP/M, after all, is basically a toy operating system. Even +little old ladies and grade school students can understand and use +CP/M. <P> + +Unix is a lot more complicated of course -- the typical Unix hacker +never can remember what the <KBD>PRINT</KBD> command is called this +week -- but when it gets right down to it, Unix is a glorified video +game. People don't do Serious Work on Unix systems: they send jokes +around the world on USENET and write adventure games and research +papers. <P> + +No, your Real Programmer uses OS/370. A good programmer can find and +understand the description of the IJK305I error he just got in his JCL +manual. A great programmer can write JCL without referring to the +manual at all. A truly outstanding programmer can find bugs buried in +a 6 megabyte core dump without using a hex calculator. (I have +actually seen this done.) <P> + +OS/370 is a truly remarkable operating system. It's possible to des- +troy days of work with a single misplaced space, so alertness in the +programming staff is encouraged. The best way to approach the system +is through a keypunch. Some people claim there is a Time Sharing +system that runs on OS/370, but after careful study I have come to the +conclusion that they are mistaken. <P> + + +<H3> PROGRAMMING TOOLS</H3> + +What kind of tools does a Real Programmer use? In theory, a Real +Programmer could run his programs by keying them into the front panel +of the computer. Back in the days when computers had front panels, +this was actually done occasionally. Your typical Real Programmer +knew the entire bootstrap loader by memory in hex, and toggled it in +whenever it got destroyed by his program. (Back then, memory was +memory -- it didn't go away when the power went off. Today, memory +either forgets things when you don't want it to, or remembers things +long after they're better forgotten.) Legend has it that Seymour +Cray, inventor of the Cray I supercomputer and most of Control Data's +computers, actually toggled the first operating system for the CDC7600 +in on the front panel from memory when it was first powered +on. Seymour, needless to say, is a Real Programmer. <P> + +One of my favorite Real Programmers was a systems programmer for Texas +Instruments. One day, he got a long distance call from a user whose +system had crashed in the middle of some important work. Jim was able +to repair the damage over the phone, getting the user to toggle in +disk I/O instructions at the front panel, repairing system tables in +hex, reading register contents back over the phone. The moral of this +story: while a Real Programmer usually includes a keypunch and +lineprinter in his toolkit, he can get along with just a front panel +and a telephone in emergencies. <P> + +In some companies, text editing no longer consists of ten engineers +standing in line to use an 029 keypunch. In fact, the building I work +in doesn't contain a single keypunch. The Real Programmer in this +situation has to do his work with a text editor program. Most systems +supply several text editors to select from, and the Real Programmer +must be careful to pick one that reflects his personal style. Many +people believe that the best text editors in the world were written at +Xerox Palo Alto Research Center for use on their Alto and Dorado +computers [3]. Unfortunately, no Real Programmer would ever use a +computer whose operating system is called SmallTalk, and would +certainly not talk to the computer with a mouse. <P> + +Some of the concepts in these Xerox editors have been incorporated +into editors running on more reasonably named operating systems. EMACS +and VI are probably the most well known of this class of editors. The +problem with these editors is that Real Programmers consider "what you +see is what you get" to be just as bad a concept in text editors as it +is in women. No, the Real Programmer wants a "you asked for it, you +got it" text editor -- complicated, cryptic, powerful, unforgiving, +dangerous. TECO, to be precise. <P> + +It has been observed that a TECO command sequence more closely resem- +bles transmission line noise than readable text [4]. One of the more +entertaining games to play with TECO is to type your name in as a +command line and try to guess what it does. Just about any possible +typing error while talking with TECO will probably destroy your +program, or even worse -- introduce subtle and mysterious bugs in a +once working subroutine. <P> + +For this reason, Real Programmers are reluctant to actually edit a +program that is close to working. They find it much easier to just +patch the binary object code directly, using a wonderful program +called SUPERZAP (or its equivalent on non-IBM machines). This works so +well that many working programs on IBM systems bear no relation to +the original FORTRAN code. In many cases, the original source code is +no longer available. When it comes time to fix a program like this, no +manager would even think of sending anything less than a Real +Programmer to do the job -- no Quiche Eating structured programmer +would even know where to start. This is called "job security". <P> + +Some programming tools NOT used by Real Programmers: <P> +<UL> + +<LI> FORTRAN preprocessors like MORTRAN and RATFOR. The Cuisinarts of +programming -- great for making Quiche. See comments above on +structured programming. + +<LI> Source language debuggers. Real Programmers can read core dumps. + +<LI> Compilers with array bounds checking. They stifle creativity, +destroy most of the interesting uses for EQUIVALENCE, and make it +impossible to modify the operating system code with negative +subscripts. Worst of all, bounds checking is inefficient. + +<LI> Source code maintainance systems. A Real Programmer keeps his +code locked up in a card file, because it implies that its owner +cannot leave his important programs unguarded [5]. + +</UL> <P> + + +<H3> THE REAL PROGRAMMER AT WORK</H3> + +Where does the typical Real Programmer work? What kind of programs are +worthy of the efforts of so talented an individual? You can be sure +that no real Programmer would be caught dead writing +accounts-receivable programs in COBOL, or sorting mailing lists for +People magazine. A Real Programmer wants tasks of earth-shaking +importance (literally!): <P> + +<UL> + +<LI> Real Programmers work for Los Alamos National Laboratory, writing +atomic bomb simulations to run on Cray I supercomputers. + +<LI> Real Programmers work for the National Security Agency, decoding +Russian transmissions. + +<LI> It was largely due to the efforts of thousands of Real +Programmers working for NASA that our boys got to the moon and back +before the cosmonauts. + +<LI> The computers in the Space Shuttle were programmed by Real +Programmers. + +<LI> Programmers are at work for Boeing designing the operating +systems for cruise missiles. + +</UL> <P> + +Some of the most awesome Real Programmers of all work at the Jet Pro- +pulsion Laboratory in California. Many of them know the entire +operating system of the Pioneer and Voyager spacecraft by heart. With +a combination of large ground-based FORTRAN programs and small +spacecraft-based assembly language programs, they can to do incredible +feats of navigation and improvisation, such as hitting ten-kilometer +wide windows at Saturn after six years in space, and repairing or +bypassing damaged sensor platforms, radios, and batteries. Allegedly, +one Real Programmer managed to tuck a pattern-matching program into a +few hundred bytes of unused memory in a Voyager spacecraft that +searched for, located, and photographed a new moon of Jupiter. <P> + +One plan for the upcoming Galileo spacecraft mission is to use a grav- +ity assist trajectory past Mars on the way to Jupiter. This trajectory +passes within 80 +/- 3 kilometers of the surface of Mars. Nobody is +going to trust a PASCAL program (or PASCAL programmer) for navigation +to these tolerances. <P> + +As you can tell, many of the world's Real Programmers work for the +U.S. Government, mainly the Defense Department. This is as it should +be. Recently, however, a black cloud has formed on the Real +Programmer horizon. <P> + +It seems that some highly placed Quiche Eaters at the Defense +Department decided that all Defense programs should be written in some +grand unified language called "ADA" (registered trademark, DoD). For +a while, it seemed that ADA was destined to become a language that +went against all the precepts of Real Programming -- a language with +structure, a language with data types, strong typing, and +semicolons. In short, a language designed to cripple the creativity of +the typical Real Programmer. Fortunately, the language adopted by DoD +has enough interesting features to make it approachable: it's +incredibly complex, includes methods for messing with the operating +system and rearranging memory, and Edsgar Dijkstra doesn't like it +[6]. (Dijkstra, as I'm sure you know, was the author of <EM>"GoTos +Considered Harmful"</EM> -- a landmark work in programming +methodology, applauded by Pascal Programmers and Quiche Eaters alike.) +Besides, the determined Real Programmer can write FORTRAN programs in +any language. <P> + +The real programmer might compromise his principles and work on some- +thing slightly more trivial than the destruction of life as we know +it, providing there's enough money in it. There are several Real +Programmers building video games at Atari, for example. (But not +playing them. A Real Programmer knows how to beat the machine every +time: no challange in that.) Everyone working at LucasFilm is a Real +Programmer. (It would be crazy to turn down the money of 50 million +Star Wars fans.) The proportion of Real Programmers in Computer +Graphics is somewhat lower than the norm, mostly because nobody has +found a use for Computer Graphics yet. On the other hand, all +Computer Graphics is done in FORTRAN, so there are a fair number +people doing Graphics in order to avoid having to write COBOL +programs. <P> + + +<H3> THE REAL PROGRAMMER AT PLAY</H3> + +Generally, the Real Programmer plays the same way he works -- with +computers. He is constantly amazed that his employer actually pays +him to do what he would be doing for fun anyway, although he is +careful not to express this opinion out loud. Occasionally, the Real +Programmer does step out of the office for a breath of fresh air and a +beer or two. Some tips on recognizing real programmers away from the +computer room: <P> +<UL> + +<LI> At a party, the Real Programmers are the ones in the corner +talking about operating system security and how to get around it. + +<LI> At a football game, the Real Programmer is the one comparing the +plays against his simulations printed on 11 by 14 fanfold paper. + +<LI> At the beach, the Real Programmer is the one drawing flowcharts +in the sand. + +<LI> A Real Programmer goes to a disco to watch the light show. + +<LI> At a funeral, the Real Programmer is the one saying <EM>"Poor +George. And he almost had the sort routine working before the +coronary."</EM> + +<LI> In a grocery store, the Real Programmer is the one who insists on +running the cans past the laser checkout scanner himself, because he +never could trust keypunch operators to get it right the first time. + +</UL> <P> + + +<H3> THE REAL PROGRAMMER'S NATURAL HABITAT</H3> + +What sort of environment does the Real Programmer function best in? +This is an important question for the managers of Real +Programmers. Considering the amount of money it costs to keep one on +the staff, it's best to put him (or her) in an environment where he +can get his work done. <P> + +The typical Real Programmer lives in front of a computer terminal. +Surrounding this terminal are: <P> +<UL> + +<LI> Listings of all programs the Real Programmer has ever worked on, +piled in roughly chronological order on every flat surface in the office. + +<LI> Some half-dozen or so partly filled cups of cold +coffee. Occasionally, there will be cigarette butts floating in the +coffee. In some cases, the cups will contain Orange Crush. + +<LI> Unless he is very good, there will be copies of the OS JCL manual +and the Principles of Operation open to some particularly interesting +pages. + +<LI> Taped to the wall is a line-printer Snoopy calender for the year +1969. + +<LI> Strewn about the floor are several wrappers for peanut butter +filled cheese bars (the type that are made stale at the bakery so they +can't get any worse while waiting in the vending machine). + +<LI> Hiding in the top left-hand drawer of the desk is a stash of +double stuff Oreos for special occasions. + +<LI> Underneath the Oreos is a flow-charting template, left there by +the previous occupant of the office. (Real Programmers write programs, +not documentation. Leave that to the maintainence people.) + +</UL> <P> + +The Real Programmer is capable of working 30, 40, even 50 hours at a +stretch, under intense pressure. In fact, he prefers it that way. Bad +response time doesn't bother the Real Programmer -- it gives him a +chance to catch a little sleep between compiles. If there is not +enough schedule pressure on the Real Programmer, he tends to make +things more challenging by working on some small but interesting part +of the problem for the first nine weeks, then finishing the rest in +the last week, in two or three 50-hour marathons. This not only +inpresses his manager, who was despairing of ever getting the project +done on time, but creates a convenient excuse for not doing the +documentation. In general: <P> + +<UL> + +<LI> No Real Programmer works 9 to 5. (Unless it's 9 in the evening to +5 in the morning.) + +<LI> Real Programmers don't wear neckties. + +<LI> Real Programmers don't wear high heeled shoes. + +<LI> Real Programmers arrive at work in time for lunch. [9] + +<LI> A Real Programmer might or might not know his wife's name. He +does, however, know the entire ASCII (or EBCDIC) code table. + +<LI> Real Programmers don't know how to cook. Grocery stores aren't +often open at 3 a.m., so they survive on Twinkies and coffee. + +</UL> <P> + +<H3> THE FUTURE</H3> + +What of the future? It is a matter of some concern to Real Programmers +that the latest generation of computer programmers are not being +brought up with the same outlook on life as their elders. Many of them +have never seen a computer with a front panel. Hardly anyone +graduating from school these days can do hex arithmetic without a +calculator. College graduates these days are soft -- protected from +the realities of programming by source level debuggers, text editors +that count parentheses, and user friendly operating systems. Worst of +all, some of these alleged computer scientists manage to get degrees +without ever learning FORTRAN! Are we destined to become an industry +of Unix hackers and Pascal programmers? <P> + +On the contrary. From my experience, I can only report that the +future is bright for Real Programmers everywhere. Neither OS/370 nor +FORTRAN show any signs of dying out, despite all the efforts of +Pascal programmers the world over. Even more subtle tricks, like +adding structured coding constructs to FORTRAN have failed. Oh sure, +some computer vendors have come out with FORTRAN 77 compilers, but +every one of them has a way of converting itself back into a FORTRAN +66 compiler at the drop of an option card -- to compile DO loops like +God meant them to be. <P> + +Even Unix might not be as bad on Real Programmers as it once was. The +latest release of Unix has the potential of an operating system worthy +of any Real Programmer. It has two different and subtly incompatible +user interfaces, an arcane and complicated terminal driver, virtual +memory. If you ignore the fact that it's structured, even C +programming can be appreciated by the Real Programmer: after all, +there's no type checking, variable names are seven (ten? eight?) +characters long, and the added bonus of the Pointer data type is +thrown in. It's like having the best parts of FORTRAN and assembly +language in one place. (Not to mention some of the more creative uses +for <KBD>#define</KBD>.) <P> + +No, the future isn't all that bad. Why, in the past few years, the +popular press has even commented on the bright new crop of computer +nerds and hackers ([7] and [8]) leaving places like Stanford and +M.I.T. for the Real World. From all evidence, the spirit of Real +Programming lives on in these young men and women. As long as there +are ill-defined goals, bizarre bugs, and unrealistic schedules, there +will be Real Programmers willing to jump in and Solve The Problem, +saving the documentation for later. Long live FORTRAN! <P> + +<H3>ACKNOWLEGEMENT</H3> + +I would like to thank Jan E., Dave S., Rich G., Rich E. for their help +in characterizing the Real Programmer, Heather B. for the +illustration, Kathy E. for putting up with it, and <kbd>atd!avsdS:mark</kbd> for +the initial inspriration. <P> + +<H3>REFERENCES</H3> + +[1] Feirstein, B., <em>Real Men Don't Eat Quiche</em>, New York, + Pocket Books, 1982. <P> + +[2] Wirth, N., <em>Algorithms + Datastructures = Programs</em>, + Prentice Hall, 1976. <P> + +[3] Xerox PARC editors . . . <P> + +[4] Finseth, C., <em>Theory and Practice of Text Editors - + or - a Cookbook for an EMACS</em>, B.S. Thesis, + MIT/LCS/TM-165, Massachusetts Institute of Technology, + May 1980. <P> + +[5] Weinberg, G., <em>The Psychology of Computer Programming</em>, + New York, Van Nostrabd Reinhold, 1971, page 110. <P> + +[6] Dijkstra, E., <em>On the GREEN Language Submitted to the DoD</em>, + Sigplan notices, Volume 3, Number 10, October 1978. <P> + +[7] Rose, Frank, <em>Joy of Hacking</em>, Science 82, Volume 3, Number 9, + November 1982, pages 58 - 66. <P> + +[8] The Hacker Papers, <em>Psychology Today</em>, August 1980. <P> + +[9] <em>Datamation</em>, July, 1983, pp. 263-265. <P> + +<hr> + +<ADDRESS> <a href="index.html">Hacker's Wisdom</a>/ Real Programmers +Don't Use PASCAL </ADDRESS> + +<!-- hhmts start --> +Last modified: Wed Mar 27 17:48:50 EST 1996 diff --git a/lib/kernel/test/file_SUITE_data/realmen.html.gz b/lib/kernel/test/file_SUITE_data/realmen.html.gz Binary files differnew file mode 100644 index 0000000000..9c662ff3c0 --- /dev/null +++ b/lib/kernel/test/file_SUITE_data/realmen.html.gz diff --git a/lib/kernel/test/gen_sctp_SUITE.erl b/lib/kernel/test/gen_sctp_SUITE.erl new file mode 100644 index 0000000000..dd7d5f111a --- /dev/null +++ b/lib/kernel/test/gen_sctp_SUITE.erl @@ -0,0 +1,338 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2009. 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(gen_sctp_SUITE). + +-include("test_server.hrl"). +-include_lib("kernel/include/inet_sctp.hrl"). + +%%-compile(export_all). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2, + basic/1,xfer_min/1,xfer_active/1,api_open_close/1,api_listen/1]). + +all(suite) -> + [basic,xfer_min,xfer_active,api_open_close,api_listen]. + +init_per_testcase(_Func, Config) -> + Dog = test_server:timetrap(test_server:seconds(15)), + [{watchdog, Dog}|Config]. +fin_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog). + + + +basic(doc) -> + "Hello world"; +basic(suite) -> + []; +basic(Config) when is_list(Config) -> + ?line {ok,S} = gen_sctp:open(), + ?line ok = gen_sctp:close(S), + ok. + +xfer_min(doc) -> + "Minimal data transfer"; +xfer_min(suite) -> + []; +xfer_min(Config) when is_list(Config) -> + ?line Stream = 0, + ?line Data = <<"The quick brown fox jumps over a lazy dog 0123456789">>, + ?line Loopback = {127,0,0,1}, + ?line {ok,Sb} = gen_sctp:open(), + ?line {ok,Pb} = inet:port(Sb), + ?line ok = gen_sctp:listen(Sb, true), + + ?line {ok,Sa} = gen_sctp:open(), + ?line {ok,Pa} = inet:port(Sa), + ?line {ok,#sctp_assoc_change{state=comm_up, + error=0, + outbound_streams=SaOutboundStreams, + inbound_streams=SaInboundStreams, + assoc_id=SaAssocId}=SaAssocChange} = + gen_sctp:connect(Sa, Loopback, Pb, []), + ?line {ok,{Loopback, + Pa,[], + #sctp_assoc_change{state=comm_up, + error=0, + outbound_streams=SbOutboundStreams, + inbound_streams=SbInboundStreams, + assoc_id=SbAssocId}}} = + gen_sctp:recv(Sb, infinity), + ?line SaOutboundStreams = SbInboundStreams, + ?line SbOutboundStreams = SaInboundStreams, + ?line ok = gen_sctp:send(Sa, SaAssocId, 0, Data), + ?line case gen_sctp:recv(Sb, infinity) of + {ok,{Loopback, + Pa, + [#sctp_sndrcvinfo{stream=Stream, + assoc_id=SbAssocId}], + Data}} -> ok; + {ok,{Loopback, + Pa,[], + #sctp_paddr_change{addr = {Loopback,_}, + state = addr_available, + error = 0, + assoc_id = SbAssocId}}} -> + {ok,{Loopback, + Pa, + [#sctp_sndrcvinfo{stream=Stream, + assoc_id=SbAssocId}], + Data}} = gen_sctp:recv(Sb, infinity) + end, + ?line ok = gen_sctp:send(Sb, SbAssocId, 0, Data), + ?line {ok,{Loopback, + Pb, + [#sctp_sndrcvinfo{stream=Stream, + assoc_id=SaAssocId}], + Data}} = + gen_sctp:recv(Sa, infinity), + %% + ?line ok = gen_sctp:eof(Sa, SaAssocChange), + ?line {ok,{Loopback, + Pa,[], + #sctp_shutdown_event{assoc_id=SbAssocId}}} = + gen_sctp:recv(Sb, infinity), + ?line {ok,{Loopback, + Pb,[], + #sctp_assoc_change{state=shutdown_comp, + error=0, + assoc_id=SaAssocId}}} = + gen_sctp:recv(Sa, infinity), + ?line {ok,{Loopback, + Pa,[], + #sctp_assoc_change{state=shutdown_comp, + error=0, + assoc_id=SbAssocId}}} = + gen_sctp:recv(Sb, infinity), + ?line ok = gen_sctp:close(Sa), + ?line ok = gen_sctp:close(Sb), + + ?line receive + Msg -> test_server:fail({received,Msg}) + after 17 -> ok + end, + ok. + +xfer_active(doc) -> + "Minimal data transfer in active mode"; +xfer_active(suite) -> + []; +xfer_active(Config) when is_list(Config) -> + ?line Timeout = 2000, + ?line Stream = 0, + ?line Data = <<"The quick brown fox jumps over a lazy dog 0123456789">>, + ?line Loopback = {127,0,0,1}, + ?line {ok,Sb} = gen_sctp:open([{active,true}]), + ?line {ok,Pb} = inet:port(Sb), + ?line ok = gen_sctp:listen(Sb, true), + + ?line {ok,Sa} = gen_sctp:open([{active,true}]), + ?line {ok,Pa} = inet:port(Sa), + ?line {ok,#sctp_assoc_change{state=comm_up, + error=0, + outbound_streams=SaOutboundStreams, + inbound_streams=SaInboundStreams, + assoc_id=SaAssocId}=SaAssocChange} = + gen_sctp:connect(Sa, Loopback, Pb, []), + ?line io:format("Sa=~p, Pa=~p, Sb=~p, Pb=~p, SaAssocId=~p, " + "SaOutboundStreams=~p, SaInboundStreams=~p~n", + [Sa,Pa,Sb,Pb,SaAssocId, + SaOutboundStreams,SaInboundStreams]), + ?line SbAssocId = + receive + {sctp,Sb,Loopback,Pa, + {[], + #sctp_assoc_change{state=comm_up, + error=0, + outbound_streams=SbOutboundStreams, + inbound_streams=SbInboundStreams, + assoc_id=SBAI}}} -> + ?line SaOutboundStreams = SbInboundStreams, + ?line SaInboundStreams = SbOutboundStreams, + SBAI + after Timeout -> + ?line test_server:fail({unexpected,flush()}) + end, + ?line io:format("SbAssocId=~p~n", [SbAssocId]), + ?line ok = gen_sctp:send(Sa, SaAssocId, 0, Data), + ?line receive + {sctp,Sb,Loopback,Pa, + {[#sctp_sndrcvinfo{stream=Stream, + assoc_id=SbAssocId}], + Data}} -> ok; + {sctp,Sb,Loopback,Pa, + {[], + #sctp_paddr_change{addr = {Loopback,_}, + state = addr_available, + error = 0, + assoc_id = SbAssocId}}} -> + ?line receive + {sctp,Sb,Loopback,Pa, + {[#sctp_sndrcvinfo{stream=Stream, + assoc_id=SbAssocId}], + Data}} -> ok + end + after Timeout -> + ?line test_server:fail({unexpected,flush()}) + end, + ?line ok = gen_sctp:send(Sb, SbAssocId, 0, Data), + ?line receive + {sctp,Sa,Loopback,Pb, + {[#sctp_sndrcvinfo{stream=Stream, + assoc_id=SaAssocId}], + Data}} -> ok + after Timeout -> + ?line test_server:fail({unexpected,flush()}) + end, + %% + ?line ok = gen_sctp:abort(Sa, SaAssocChange), + ?line receive + {sctp,Sb,Loopback,Pa, + {[], + #sctp_assoc_change{state=comm_lost, + assoc_id=SbAssocId}}} -> ok + after Timeout -> + ?line test_server:fail({unexpected,flush()}) + end, + ?line ok = gen_sctp:close(Sb), + ?line receive + {sctp,Sa,Loopback,Pb, + {[], + #sctp_assoc_change{state=comm_lost, + assoc_id=SaAssocId}}} -> ok + after 17 -> ok %% On Solaris this does not arrive + end, + ?line ok = gen_sctp:close(Sa), + %% + ?line receive + Msg -> test_server:fail({unexpected,[Msg]++flush()}) + after 17 -> ok + end, + ok. + +flush() -> + receive + Msg -> + [Msg|flush()] + after 17 -> + [] + end. + +api_open_close(doc) -> + "Test the API function open/1,2 and close/1"; +api_open_close(suite) -> + []; +api_open_close(Config) when is_list(Config) -> + ?line {ok,S1} = gen_sctp:open(0), + ?line {ok,P} = inet:port(S1), + ?line ok = gen_sctp:close(S1), + + ?line {ok,S2} = gen_sctp:open(P), + ?line {ok,P} = inet:port(S2), + ?line ok = gen_sctp:close(S2), + + ?line {ok,S3} = gen_sctp:open([{port,P}]), + ?line {ok,P} = inet:port(S3), + ?line ok = gen_sctp:close(S3), + + ?line {ok,S4} = gen_sctp:open(P, []), + ?line {ok,P} = inet:port(S4), + ?line ok = gen_sctp:close(S4), + + ?line {ok,S5} = gen_sctp:open(P, [{ifaddr,any}]), + ?line {ok,P} = inet:port(S5), + ?line ok = gen_sctp:close(S5), + + ?line ok = gen_sctp:close(S5), + + ?line try gen_sctp:close(0) + catch error:badarg -> ok + end, + + ?line try gen_sctp:open({}) + catch error:badarg -> ok + end, + + ?line try gen_sctp:open(-1) + catch error:badarg -> ok + end, + + ?line try gen_sctp:open(65536) + catch error:badarg -> ok + end, + + ?line try gen_sctp:open(make_ref(), []) + catch error:badarg -> ok + end, + + ?line try gen_sctp:open(0, {}) + catch error:badarg -> ok + end, + + ?line try gen_sctp:open(0, [make_ref()]) + catch error:badarg -> ok + end, + + ?line try gen_sctp:open([{invalid_option,0}]) + catch error:badarg -> ok + end, + + ?line try gen_sctp:open(0, [{mode,invalid_mode}]) + catch error:badarg -> ok + end, + ok. + +api_listen(doc) -> + "Test the API function listen/2"; +api_listen(suite) -> + []; +api_listen(Config) when is_list(Config) -> + ?line Localhost = {127,0,0,1}, + + ?line try gen_sctp:listen(0, true) + catch error:badarg -> ok + end, + + ?line {ok,S} = gen_sctp:open(), + ?line {ok,Pb} = inet:port(S), + ?line try gen_sctp:listen(S, not_allowed_for_listen) + catch error:badarg -> ok + end, + ?line ok = gen_sctp:close(S), + ?line {error,closed} = gen_sctp:listen(S, true), + + ?line {ok,Sb} = gen_sctp:open(Pb), + ?line {ok,Sa} = gen_sctp:open(), + ?line case gen_sctp:connect(Sa, localhost, Pb, []) of + {error,econnrefused} -> + ?line {ok,{Localhost, + Pb,[], + #sctp_assoc_change{ + state = comm_lost}}} = + gen_sctp:recv(Sa, infinity); + {error,#sctp_assoc_change{state=cant_assoc}} -> ok + end, + ?line ok = gen_sctp:listen(Sb, true), + ?line {ok,#sctp_assoc_change{state=comm_up, + error=0}} = + gen_sctp:connect(Sa, localhost, Pb, []), + ?line ok = gen_sctp:close(Sa), + ?line ok = gen_sctp:close(Sb), + ok. diff --git a/lib/kernel/test/gen_tcp_api_SUITE.erl b/lib/kernel/test/gen_tcp_api_SUITE.erl new file mode 100644 index 0000000000..11d19aaa82 --- /dev/null +++ b/lib/kernel/test/gen_tcp_api_SUITE.erl @@ -0,0 +1,219 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(gen_tcp_api_SUITE). + +%% Tests the documented API for the gen_tcp functions. The "normal" cases +%% are not tested here, because they are tested indirectly in this and +%% and other test suites. + +-include("test_server.hrl"). +-include_lib("kernel/include/inet.hrl"). + +-export([all/1, init_per_testcase/2, fin_per_testcase/2, + t_accept/1, t_connect_timeout/1, t_accept_timeout/1, + t_connect/1, t_connect_bad/1, + t_recv/1, t_recv_timeout/1, t_recv_eof/1, + t_shutdown_write/1, t_shutdown_both/1, t_shutdown_error/1, + t_fdopen/1]). + +all(suite) -> [t_accept, t_connect, t_recv, t_shutdown_write, + t_shutdown_both, t_shutdown_error, t_fdopen]. + +init_per_testcase(_Func, Config) -> + Dog = test_server:timetrap(test_server:seconds(60)), + [{watchdog, Dog}|Config]. +fin_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog). + +%%% gen_tcp:accept/1,2 + +t_accept(suite) -> [t_accept_timeout]. + +t_accept_timeout(doc) -> "Test that gen_tcp:accept/2 (with timeout) works."; +t_accept_timeout(suite) -> []; +t_accept_timeout(Config) when is_list(Config) -> + ?line {ok, L} = gen_tcp:listen(0, []), + ?line timeout({gen_tcp, accept, [L, 200]}, 0.2, 1.0). + +%%% gen_tcp:connect/X + +t_connect(suite) -> [t_connect_timeout, t_connect_bad]. + +t_connect_timeout(doc) -> "Test that gen_tcp:connect/4 (with timeout) works."; +t_connect_timeout(Config) when is_list(Config) -> + %%?line BadAddr = {134,138,177,16}, + %%?line TcpPort = 80, + ?line {ok, BadAddr} = unused_ip(), + ?line TcpPort = 45638, + ?line ok = io:format("Connecting to ~p, port ~p", [BadAddr, TcpPort]), + ?line connect_timeout({gen_tcp,connect,[BadAddr,TcpPort,[],200]}, 0.2, 5.0). + +t_connect_bad(doc) -> + ["Test that gen_tcp:connect/3 handles non-existings hosts, and other ", + "invalid things."]; +t_connect_bad(suite) -> []; +t_connect_bad(Config) when is_list(Config) -> + ?line NonExistingPort = 45638, % Not in use, I hope. + ?line {error, Reason1} = gen_tcp:connect(localhost, NonExistingPort, []), + ?line io:format("Error for connection attempt to port not in use: ~p", + [Reason1]), + + ?line {error, Reason2} = gen_tcp:connect("non-existing-host-xxx", 7, []), + ?line io:format("Error for connection attempt to non-existing host: ~p", + [Reason2]), + ok. + + +%%% gen_tcp:recv/X + +t_recv(suite) -> [t_recv_timeout, t_recv_eof]. + +t_recv_timeout(doc) -> "Test that gen_tcp:recv/3 (with timeout works)."; +t_recv_timeout(suite) -> []; +t_recv_timeout(Config) when is_list(Config) -> + ?line {ok, L} = gen_tcp:listen(0, []), + ?line {ok, Port} = inet:port(L), + ?line {ok, Client} = gen_tcp:connect(localhost, Port, [{active, false}]), + ?line {ok, _A} = gen_tcp:accept(L), + ?line timeout({gen_tcp, recv, [Client, 0, 200]}, 0.2, 5.0). + +t_recv_eof(doc) -> "Test that end of file on a socket is reported correctly."; +t_recv_eof(suite) -> []; +t_recv_eof(Config) when is_list(Config) -> + ?line {ok, L} = gen_tcp:listen(0, []), + ?line {ok, Port} = inet:port(L), + ?line {ok, Client} = gen_tcp:connect(localhost, Port, [{active, false}]), + ?line {ok, A} = gen_tcp:accept(L), + ?line ok = gen_tcp:close(A), + ?line {error, closed} = gen_tcp:recv(Client, 0), + ok. + +%%% gen_tcp:shutdown/2 + +t_shutdown_write(Config) when is_list(Config) -> + ?line {ok, L} = gen_tcp:listen(0, []), + ?line {ok, Port} = inet:port(L), + ?line {ok, Client} = gen_tcp:connect(localhost, Port, [{active, false}]), + ?line {ok, A} = gen_tcp:accept(L), + ?line ok = gen_tcp:shutdown(A, write), + ?line {error, closed} = gen_tcp:recv(Client, 0), + ok. + +t_shutdown_both(Config) when is_list(Config) -> + ?line {ok, L} = gen_tcp:listen(0, []), + ?line {ok, Port} = inet:port(L), + ?line {ok, Client} = gen_tcp:connect(localhost, Port, [{active, false}]), + ?line {ok, A} = gen_tcp:accept(L), + ?line ok = gen_tcp:shutdown(A, read_write), + ?line {error, closed} = gen_tcp:recv(Client, 0), + ok. + +t_shutdown_error(Config) when is_list(Config) -> + ?line {ok, L} = gen_tcp:listen(0, []), + ?line {error, enotconn} = gen_tcp:shutdown(L, read_write), + ?line ok = gen_tcp:close(L), + ?line {error, closed} = gen_tcp:shutdown(L, read_write), + ok. + + +%%% gen_tcp:fdopen/2 + +t_fdopen(Config) when is_list(Config) -> + ?line Question = "Aaaa... Long time ago in a small town in Germany,", + ?line Answer = "there was a shoemaker, Schumacher was his name.", + ?line {ok, L} = gen_tcp:listen(0, [{active, false}]), + ?line {ok, Port} = inet:port(L), + ?line {ok, Client} = gen_tcp:connect(localhost, Port, [{active, false}]), + ?line {ok, A} = gen_tcp:accept(L), + ?line {ok, FD} = prim_inet:getfd(A), + ?line {ok, Server} = gen_tcp:fdopen(FD, []), + ?line ok = gen_tcp:send(Client, Question), + ?line {ok, Question} = gen_tcp:recv(Server, length(Question), 2000), + ?line ok = gen_tcp:send(Server, Answer), + ?line {ok, Answer} = gen_tcp:recv(Client, length(Answer), 2000), + ?line ok = gen_tcp:close(Client), + ?line {error,closed} = gen_tcp:recv(A, 1, 2000), + ?line ok = gen_tcp:close(Server), + ?line ok = gen_tcp:close(A), + ?line ok = gen_tcp:close(L), + ok. + + + +%%% Utilities + +%% Calls M:F/length(A), which should return a timeout error, and complete +%% within the given time. + +timeout({M,F,A}, Lower, Upper) -> + case test_server:timecall(M, F, A) of + {Time, Result} when Time < Lower -> + test_server:fail({too_short_time, Time, Result}); + {Time, Result} when Time > Upper -> + test_server:fail({too_long_time, Time, Result}); + {_, {error, timeout}} -> + ok; + {_, Result} -> + test_server:fail({unexpected_result, Result}) + end. + +connect_timeout({M,F,A}, Lower, Upper) -> + case test_server:timecall(M, F, A) of + {Time, Result} when Time < Lower -> + case Result of + {error,econnrefused=E} -> + {comment,"Not tested -- got error "++atom_to_list(E)}; + {error,enetunreach=E} -> + {comment,"Not tested -- got error "++atom_to_list(E)}; + {ok,Socket} -> % What the... + Pinfo = erlang:port_info(Socket), + Db = inet_db:lookup_socket(Socket), + Peer = inet:peername(Socket), + test_server:fail({too_short_time, Time, + [Result,Pinfo,Db,Peer]}); + _ -> + test_server:fail({too_short_time, Time, Result}) + end; + {Time, Result} when Time > Upper -> + test_server:fail({too_long_time, Time, Result}); + {_, {error, timeout}} -> + ok; + {_, Result} -> + test_server:fail({unexpected_result, Result}) + end. + +%% Try to obtain an unused IP address in the local network. + +unused_ip() -> + ?line {ok, Host} = inet:gethostname(), + ?line {ok, Hent} = inet:gethostbyname(Host), + ?line #hostent{h_addr_list=[{A, B, C, _D}|_]} = Hent, + %% Note: In our net, addresses below 16 are reserved for routers and + %% other strange creatures. + ?line IP = unused_ip(A, B, C, 16), + io:format("we = ~p, unused_ip = ~p~n", [Hent, IP]), + IP. + +unused_ip(_, _, _, 255) -> error; +unused_ip(A, B, C, D) -> + case inet:gethostbyaddr({A, B, C, D}) of + {ok, _} -> unused_ip(A, B, C, D+1); + {error, _} -> {ok, {A, B, C, D}} + end. diff --git a/lib/kernel/test/gen_tcp_echo_SUITE.erl b/lib/kernel/test/gen_tcp_echo_SUITE.erl new file mode 100644 index 0000000000..a2e09877af --- /dev/null +++ b/lib/kernel/test/gen_tcp_echo_SUITE.erl @@ -0,0 +1,585 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. 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(gen_tcp_echo_SUITE). + +-include("test_server.hrl"). + +%%-compile(export_all). + +-export([all/1, init_per_testcase/2, fin_per_testcase/2, + active_echo/1, passive_echo/1, active_once_echo/1, + slow_active_echo/1, slow_passive_echo/1, + limit_active_echo/1, limit_passive_echo/1, + large_limit_active_echo/1, large_limit_passive_echo/1]). + +-define(TPKT_VRSN, 3). +-define(LINE_LENGTH, 1023). % (default value of gen_tcp option 'recbuf') - 1 + +all(suite) -> + [active_echo, passive_echo, active_once_echo, + slow_active_echo, slow_passive_echo, + limit_active_echo, limit_passive_echo, + large_limit_active_echo, large_limit_passive_echo]. + +init_per_testcase(_Func, Config) -> + Dog = test_server:timetrap(test_server:minutes(5)), + [{watchdog, Dog}|Config]. +fin_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog). + +active_echo(doc) -> + ["Test sending packets of various sizes and various packet types ", + "to the echo port and receiving them again (socket in active mode)."]; +active_echo(suite) -> []; +active_echo(Config) when is_list(Config) -> + ?line echo_test([], fun active_echo/4, [{echo, fun echo_server/0}]). + +passive_echo(doc) -> + ["Test sending packets of various sizes and various packet types ", + "to the echo port and receiving them again (socket in passive mode)."]; +passive_echo(suite) -> []; +passive_echo(Config) when is_list(Config) -> + ?line echo_test([{active, false}], fun passive_echo/4, + [{echo, fun echo_server/0}]). + +active_once_echo(doc) -> + ["Test sending packets of various sizes and various packet types ", + "to the echo port and receiving them again (socket in active once mode)."]; +active_once_echo(suite) -> []; +active_once_echo(Config) when is_list(Config) -> + ?line echo_test([{active, once}], fun active_once_echo/4, + [{echo, fun echo_server/0}]). + +slow_active_echo(doc) -> + ["Test sending packets of various sizes and various packet types ", + "to the echo port and receiving them again (socket in active mode). ", + "The echo server is a special one that delays between every character."]; +slow_active_echo(suite) -> []; +slow_active_echo(Config) when is_list(Config) -> + ?line echo_test([], fun active_echo/4, + [slow_echo, {echo, fun slow_echo_server/0}]). + +slow_passive_echo(doc) -> + ["Test sending packets of various sizes and various packet types ", + "to an echo server and receiving them again (socket in passive mode).", + "The echo server is a special one that delays between every character."]; +slow_passive_echo(suite) -> []; +slow_passive_echo(Config) when is_list(Config) -> + ?line echo_test([{active, false}], fun passive_echo/4, + [slow_echo, {echo, fun slow_echo_server/0}]). + +limit_active_echo(doc) -> + ["Test sending packets of various sizes and various packet types ", + "to the echo port and receiving them again (socket in active mode) " + "with packet_size limitation."]; +limit_active_echo(suite) -> []; +limit_active_echo(Config) when is_list(Config) -> + ?line echo_test([{packet_size, 10}], + fun active_echo/4, + [{packet_size, 10}, {echo, fun echo_server/0}]). + +limit_passive_echo(doc) -> + ["Test sending packets of various sizes and various packet types ", + "to the echo port and receiving them again (socket in passive mode) ", + "with packet_size limitation."]; +limit_passive_echo(suite) -> []; +limit_passive_echo(Config) when is_list(Config) -> + ?line echo_test([{packet_size, 10},{active, false}], + fun passive_echo/4, + [{packet_size, 10}, {echo, fun echo_server/0}]). + +large_limit_active_echo(doc) -> + ["Test sending packets of various sizes and various packet types ", + "to the echo port and receiving them again (socket in active mode) " + "with large packet_size limitation."]; +large_limit_active_echo(suite) -> []; +large_limit_active_echo(Config) when is_list(Config) -> + ?line echo_test([{packet_size, 10}], + fun active_echo/4, + [{packet_size, (1 bsl 32)-1}, + {echo, fun echo_server/0}]). + +large_limit_passive_echo(doc) -> + ["Test sending packets of various sizes and various packet types ", + "to the echo port and receiving them again (socket in passive mode) ", + "with large packet_size limitation."]; +large_limit_passive_echo(suite) -> []; +large_limit_passive_echo(Config) when is_list(Config) -> + ?line echo_test([{packet_size, 10},{active, false}], + fun passive_echo/4, + [{packet_size, (1 bsl 32) -1}, + {echo, fun echo_server/0}]). + +echo_test(SockOpts, EchoFun, Config0) -> + echo_test_1(SockOpts, EchoFun, Config0), + io:format("\nrepeating test with {delay_send,true}"), + echo_test_1([{delay_send,true}|SockOpts], EchoFun, Config0). + +echo_test_1(SockOpts, EchoFun, Config0) -> + ?line EchoSrvFun = ?config(echo, Config0), + ?line {ok, EchoPort} = EchoSrvFun(), + ?line Config = [{echo_port, EchoPort}|Config0], + + ?line echo_packet([{packet, 1}|SockOpts], EchoFun, Config), + ?line echo_packet([{packet, 2}|SockOpts], EchoFun, Config), + ?line echo_packet([{packet, 4}|SockOpts], EchoFun, Config), + ?line echo_packet([{packet, sunrm}|SockOpts], EchoFun, Config), + ?line echo_packet([{packet, cdr}|SockOpts], EchoFun, + [{type, {cdr, big}}|Config]), + ?line echo_packet([{packet, cdr}|SockOpts], EchoFun, + [{type, {cdr, little}}|Config]), + ?line case lists:keymember(packet_size, 1, SockOpts) of + false -> + ?line echo_packet([{packet, line}|SockOpts], + EchoFun, Config); + true -> ok + end, + ?line echo_packet([{packet, tpkt}|SockOpts], EchoFun, Config), + + ?line ShortTag = [16#E0], + ?line LongTag = [16#1F, 16#83, 16#27], + ?line echo_packet([{packet, asn1}|SockOpts], EchoFun, + [{type, {asn1, short, ShortTag}}|Config]), + ?line echo_packet([{packet, asn1}|SockOpts], EchoFun, + [{type, {asn1, long, ShortTag}}|Config]), + ?line echo_packet([{packet, asn1}|SockOpts], EchoFun, + [{type, {asn1, short, LongTag}}|Config]), + ?line echo_packet([{packet, asn1}|SockOpts], EchoFun, + [{type, {asn1, long, LongTag}}|Config]), + + ?line echo_packet([{packet, http}|SockOpts], EchoFun, Config), + ?line echo_packet([{packet, http_bin}|SockOpts], EchoFun, Config), + ok. + +echo_packet(SockOpts, EchoFun, Opts) -> + ?line Type = + case lists:keysearch(type, 1, Opts) of + {value, {type, T}} -> + T; + _ -> + {value, {packet, T}} = lists:keysearch(packet, 1, SockOpts), + T + end, + + %% Connect to the echo server. + ?line EchoPort = ?config(echo_port, Opts), + ?line {ok, Echo} = gen_tcp:connect(localhost, EchoPort, SockOpts), + + ?line SlowEcho = + case os:type() of + vxworks -> true; + _ -> lists:member(slow_echo, Opts) + end, + + case Type of + http -> + echo_packet_http(Echo, Type, EchoFun); + http_bin -> + echo_packet_http(Echo, Type, EchoFun); + _ -> + echo_packet0(Echo, Type, EchoFun, SlowEcho, Opts) + end. + +echo_packet_http(Echo, Type, EchoFun) -> + lists:foreach(fun(Uri)-> P1 = http_request(Uri), + EchoFun(Echo, Type, P1, http_reply(P1, Type)) + end, + http_uri_variants()), + P2 = http_response(), + EchoFun(Echo, Type, P2, http_reply(P2, Type)). + +echo_packet0(Echo, Type, EchoFun, SlowEcho, Opts) -> + ?line PacketSize = + case lists:keysearch(packet_size, 1, Opts) of + {value,{packet_size,Sz}} when Sz < 10 -> Sz; + {value,{packet_size,_}} -> 10; + false -> 0 + end, + %% Echo small packets first. + ?line echo_packet1(Echo, Type, EchoFun, 0), + ?line echo_packet1(Echo, Type, EchoFun, 1), + ?line echo_packet1(Echo, Type, EchoFun, 2), + ?line echo_packet1(Echo, Type, EchoFun, 3), + ?line echo_packet1(Echo, Type, EchoFun, 4), + ?line echo_packet1(Echo, Type, EchoFun, 7), + if PacketSize =/= 0 -> + ?line echo_packet1(Echo, Type, EchoFun, + {PacketSize-1, PacketSize}), + ?line echo_packet1(Echo, Type, EchoFun, + {PacketSize, PacketSize}), + ?line echo_packet1(Echo, Type, EchoFun, + {PacketSize+1, PacketSize}); + not SlowEcho -> % Go on with bigger packets if not slow echo server. + ?line echo_packet1(Echo, Type, EchoFun, 10), + ?line echo_packet1(Echo, Type, EchoFun, 13), + ?line echo_packet1(Echo, Type, EchoFun, 126), + ?line echo_packet1(Echo, Type, EchoFun, 127), + ?line echo_packet1(Echo, Type, EchoFun, 128), + ?line echo_packet1(Echo, Type, EchoFun, 255), + ?line echo_packet1(Echo, Type, EchoFun, 256), + ?line echo_packet1(Echo, Type, EchoFun, 1023), + ?line echo_packet1(Echo, Type, EchoFun, 3747), + ?line echo_packet1(Echo, Type, EchoFun, 32767), + ?line echo_packet1(Echo, Type, EchoFun, 32768), + ?line echo_packet1(Echo, Type, EchoFun, 65531), + ?line echo_packet1(Echo, Type, EchoFun, 65535), + ?line echo_packet1(Echo, Type, EchoFun, 65536), + ?line echo_packet1(Echo, Type, EchoFun, 70000), + ?line echo_packet1(Echo, Type, EchoFun, infinite); + true -> ok + end, + ?line gen_tcp:close(Echo), + ok. + +echo_packet1(EchoSock, Type, EchoFun, Size) -> + ?line case packet(Size, Type) of + false -> + ok; + Packet -> + ?line io:format("Type ~p, size ~p, time ~p", + [Type, Size, time()]), + ?line + case EchoFun(EchoSock, Type, Packet, [Packet]) of + ok -> + ?line + case Size of + {N, Max} when N > Max -> + ?line + test_server:fail( + {packet_through, {N, Max}}); + _ -> ok + end; + {error, emsgsize} -> + ?line + case Size of + {N, Max} when N > Max -> + io:format(" Blocked!"); + _ -> + ?line + test_server:fail( + {packet_blocked, Size}) + end; + Error -> + ?line test_server:fail(Error) + end + end. + +active_echo(Sock, Type, Packet, PacketEchos) -> + ?line ok = gen_tcp:send(Sock, Packet), + active_recv(Sock, Type, PacketEchos). + +active_recv(_, _, []) -> + ok; +active_recv(Sock, Type, [PacketEcho|Tail]) -> + Tag = case Type of + http -> http; + http_bin -> http; + _ -> tcp + end, + ?line receive Recv->Recv end, + %%io:format("Active received: ~p\n",[Recv]), + ?line case Recv of + {Tag, Sock, PacketEcho} -> + active_recv(Sock, Type, Tail); + {Tag, Sock, Bad} -> + ?line test_server:fail({wrong_data, Bad, expected, PacketEcho}); + {tcp_error, Sock, Reason} -> + {error, Reason}; + Other -> + ?line test_server:fail({unexpected_message, Other, Tag}) + end. + +passive_echo(Sock, _Type, Packet, PacketEchos) -> + ?line ok = gen_tcp:send(Sock, Packet), + passive_recv(Sock, PacketEchos). + +passive_recv(_, []) -> + ok; +passive_recv(Sock, [PacketEcho | Tail]) -> + Recv = gen_tcp:recv(Sock, 0), + %%io:format("Passive received: ~p\n",[Recv]), + ?line case Recv of + {ok, PacketEcho} -> + passive_recv(Sock, Tail); + {ok, Bad} -> + io:format("Expected: ~p\nGot: ~p\n",[PacketEcho,Bad]), + ?line test_server:fail({wrong_data, Bad}); + {error,PacketEcho} -> + passive_recv(Sock, Tail); % expected error + {error, _}=Error -> + Error; + Other -> + ?line test_server:fail({unexpected_message, Other}) + end. + +active_once_echo(Sock, Type, Packet, PacketEchos) -> + ?line ok = gen_tcp:send(Sock, Packet), + active_once_recv(Sock, Type, PacketEchos). + +active_once_recv(_, _, []) -> + ok; +active_once_recv(Sock, Type, [PacketEcho | Tail]) -> + Tag = case Type of + http -> http; + http_bin -> http; + _ -> tcp + end, + ?line receive + {Tag, Sock, PacketEcho} -> + inet:setopts(Sock, [{active, once}]), + active_once_recv(Sock, Type, Tail); + {Tag, Sock, Bad} -> + ?line test_server:fail({wrong_data, Bad}); + {tcp_error, Sock, Reason} -> + {error, Reason}; + Other -> + ?line test_server:fail({unexpected_message, Other, expected, {Tag, Sock, PacketEcho}}) + end. + +%%% Building of random packets. + +packet(infinite, {asn1, _, Tag}) -> + Tag++[16#80]; +packet(infinite, _) -> + false; +packet({Size, _RecvLimit}, Type) -> + packet(Size, Type); +packet(Size, 1) when Size > 255 -> + false; +packet(Size, 2) when Size > 65535 -> + false; +packet(Size, {asn1, _, Tag}) when Size < 128 -> + Tag++[Size|random_packet(Size)]; +packet(Size, {asn1, short, Tag}) when Size < 256 -> + Tag++[16#81, Size|random_packet(Size)]; +packet(Size, {asn1, short, Tag}) when Size < 65536 -> + Tag++[16#82|put_int16(Size, big, random_packet(Size))]; +packet(Size, {asn1, _, Tag}) -> + Tag++[16#84|put_int32(Size, big, random_packet(Size))]; +packet(Size, {cdr, Endian}) -> + [$G, $I, $O, $P, % magic + 1, 0, % major minor + if Endian == big -> 0; true -> 1 end, % flags: byte order + 0 | % message type + put_int32(Size, Endian, random_packet(Size))]; +packet(Size, sunrm) -> + put_int32(Size, big, random_packet(Size)); +packet(Size, line) when Size > ?LINE_LENGTH -> + false; +packet(Size, line) -> + random_packet(Size, "\n"); +packet(Size, tpkt) -> + HeaderSize = 4, + PacketSize = HeaderSize + Size, + if PacketSize < 65536 -> + Header = [?TPKT_VRSN, 0 | put_int16(PacketSize, big)], + HeaderSize = length(Header), % Just to assert cirkular dependency + Header ++ random_packet(Size); + true -> + false + end; +packet(Size, _Type) -> + random_packet(Size). + + + +random_packet(Size) -> + random_packet(Size, "", random_char()). + +random_packet(Size, Tail) -> + random_packet(Size, Tail, random_char()). + +random_packet(0, Result, _NextChar) -> + Result; +random_packet(Left, Result, NextChar0) -> + NextChar = + if + NextChar0 >= 126 -> + 33; + true -> + NextChar0+1 + end, + random_packet(Left-1, [NextChar0|Result], NextChar). + +random_char() -> + random_char("abcdefghijklmnopqrstuvxyzABCDEFGHIJKLMNOPQRSTUVXYZ0123456789"). + +random_char(Chars) -> + lists:nth(uniform(length(Chars)), Chars). + +uniform(N) -> + case get(random_seed) of + undefined -> + {X, Y, Z} = time(), + random:seed(X, Y, Z); + _ -> + ok + end, + random:uniform(N). + +put_int32(X, big, List) -> + [ (X bsr 24) band 16#ff, + (X bsr 16) band 16#ff, + (X bsr 8) band 16#ff, + (X) band 16#ff | List ]; +put_int32(X, little, List) -> + [ (X) band 16#ff, + (X bsr 8) band 16#ff, + (X bsr 16) band 16#ff, + (X bsr 24) band 16#ff | List]. + +put_int16(X, ByteOrder) -> + put_int16(X, ByteOrder, []). + +put_int16(X, big, List) -> + [ (X bsr 8) band 16#ff, + (X) band 16#ff | List ]; +put_int16(X, little, List) -> + [ (X) band 16#ff, + (X bsr 8) band 16#ff | List ]. + +%%% A normal echo server, for systems that don't have one. + +echo_server() -> + Self = self(), + ?line spawn_link(fun() -> echo_server(Self) end), + ?line receive + {echo_port, Port} -> + {ok, Port} + end. + +echo_server(ReplyTo) -> + {ok, S} = gen_tcp:listen(0, [{active, false}, binary]), + {ok, {_, Port}} = inet:sockname(S), + ReplyTo ! {echo_port, Port}, + echo_server_loop(S). + +echo_server_loop(Sock) -> + {ok, E} = gen_tcp:accept(Sock), + Self = self(), + spawn_link(fun() -> echoer(E, Self) end), + echo_server_loop(Sock). + +echoer(Sock, Parent) -> + unlink(Parent), + echoer_loop(Sock). + +echoer_loop(Sock) -> + case gen_tcp:recv(Sock, 0) of + {ok, Data} -> + ok = gen_tcp:send(Sock, Data), + echoer_loop(Sock); + {error, closed} -> + ok + end. + +%%% A "slow" echo server, which will echo data with a short delay +%%% between each character. + +slow_echo_server() -> + Self = self(), + ?line spawn_link(fun() -> slow_echo_server(Self) end), + ?line receive + {echo_port, Port} -> + {ok, Port} + end. + +slow_echo_server(ReplyTo) -> + {ok, S} = gen_tcp:listen(0, [{active, false}, {nodelay, true}]), + {ok, {_, Port}} = inet:sockname(S), + ReplyTo ! {echo_port, Port}, + slow_echo_server_loop(S). + +slow_echo_server_loop(Sock) -> + {ok, E} = gen_tcp:accept(Sock), + spawn_link(fun() -> slow_echoer(E, self()) end), + slow_echo_server_loop(Sock). + +slow_echoer(Sock, Parent) -> + unlink(Parent), + slow_echoer_loop(Sock). + +slow_echoer_loop(Sock) -> + case gen_tcp:recv(Sock, 0) of + {ok, Data} -> + slow_send(Sock, Data), + slow_echoer_loop(Sock); + {error, closed} -> + ok + end. + +slow_send(Sock, [C|Rest]) -> + ok = gen_tcp:send(Sock, [C]), + receive after 1 -> + slow_send(Sock, Rest) + end; +slow_send(_, []) -> + ok. + +http_request(Uri) -> + list_to_binary(["POST ", Uri, <<" HTTP/1.1\r\n" + "Connection: close\r\n" + "Host: localhost:8000\r\n" + "User-Agent: perl post\r\n" + "Content-Length: 4\r\n" + "Content-Type: text/xml; charset=utf-8\r\n" + "Other-Field: with some text\r\n" + "Multi-Line: Once upon a time in a land far far away,\r\n" + " there lived a princess imprisoned in the highest tower\r\n" + " of the most haunted castle.\r\n" + "Invalid line without a colon\r\n" + "\r\n">>]). + +http_uri_variants() -> + ["*", + "http://tools.ietf.org/html/rfcX3986", + "http://otp.ericsson.se:8000/product/internal/", + "https://example.com:8042/over/there?name=ferret#nose", + "ftp://cnn.example.com&[email protected]/top_story.htm", + "/some/absolute/path", + "something_else", "something_else"]. + +http_response() -> + <<"HTTP/1.0 404 Object Not Found\r\n" + "Server: inets/4.7.16\r\n" + "Date: Fri, 04 Jul 2008 17:16:22 GMT\r\n" + "Content-Type: text/html\r\n" + "Content-Length: 207\r\n" + "\r\n">>. + +http_reply(Bin, Type) -> + {ok, Line, Rest} = erlang:decode_packet(Type,Bin,[]), + HType = case Type of + http -> httph; + http_bin -> httph_bin + end, + Ret = lists:reverse(http_reply(Rest,[Line],HType)), + io:format("HTTP: ~p\n",[Ret]), + Ret. + +http_reply(<<>>, Acc, _) -> + Acc; +http_reply(Bin, Acc, HType) -> + {ok, Line, Rest} = erlang:decode_packet(HType,Bin,[]), + http_reply(Rest, [Line | Acc], HType). + + + + diff --git a/lib/kernel/test/gen_tcp_misc_SUITE.erl b/lib/kernel/test/gen_tcp_misc_SUITE.erl new file mode 100644 index 0000000000..5d726a3b1b --- /dev/null +++ b/lib/kernel/test/gen_tcp_misc_SUITE.erl @@ -0,0 +1,2362 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(gen_tcp_misc_SUITE). + +-include("test_server.hrl"). + +%-compile(export_all). + +-export([all/1, controlling_process/1, no_accept/1, close_with_pending_output/1, + data_before_close/1, iter_max_socks/1, get_status/1, + passive_sockets/1, accept_closed_by_other_process/1, + init_per_testcase/2, fin_per_testcase/2, + otp_3924/1, otp_3924_sender/4, closed_socket/1, + shutdown_active/1, shutdown_passive/1, shutdown_pending/1, + default_options/1, http_bad_packet/1, + busy_send/1, busy_disconnect_passive/1, busy_disconnect_active/1, + fill_sendq/1, partial_recv_and_close/1, + partial_recv_and_close_2/1,partial_recv_and_close_3/1,so_priority/1, + % Accept tests + primitive_accept/1,multi_accept_close_listen/1,accept_timeout/1, + accept_timeouts_in_order/1,accept_timeouts_in_order2/1,accept_timeouts_in_order3/1, + accept_timeouts_mixed/1, + killing_acceptor/1,killing_multi_acceptors/1,killing_multi_acceptors2/1, + several_accepts_in_one_go/1,active_once_closed/1, send_timeout/1, otp_7731/1, + zombie_sockets/1, otp_7816/1, otp_8102/1]). + +%% Internal exports. +-export([sender/3, not_owner/1, passive_sockets_server/2, priority_server/1, otp_7731_server/1, zombie_server/2]). + +init_per_testcase(_Func, Config) when is_list(Config) -> + Dog = test_server:timetrap(test_server:seconds(240)), + [{watchdog, Dog}|Config]. +fin_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog). + +all(suite) -> + [controlling_process, no_accept, + close_with_pending_output, + data_before_close, iter_max_socks, passive_sockets, + accept_closed_by_other_process, otp_3924, closed_socket, + shutdown_active, shutdown_passive, shutdown_pending, + default_options, http_bad_packet, + busy_send, busy_disconnect_passive, busy_disconnect_active, + fill_sendq, partial_recv_and_close, + partial_recv_and_close_2, partial_recv_and_close_3, so_priority, + primitive_accept,multi_accept_close_listen,accept_timeout, + accept_timeouts_in_order,accept_timeouts_in_order2,accept_timeouts_in_order3, + accept_timeouts_mixed, + killing_acceptor,killing_multi_acceptors,killing_multi_acceptors2, + several_accepts_in_one_go, active_once_closed, send_timeout, otp_7731, + zombie_sockets, otp_7816, otp_8102]. + + +default_options(doc) -> + ["Tests kernel application variables inet_default_listen_options and " + "inet_default_connect_options"]; +default_options(suite) -> + []; +default_options(Config) when is_list(Config) -> + %% First check the delay_send option + ?line {true,true,true}=do_delay_send_1(), + ?line {false,false,false}=do_delay_send_2(), + ?line {true,false,false}=do_delay_send_3(), + ?line {false,false,false}=do_delay_send_4(), + ?line {false,false,false}=do_delay_send_5(), + ?line {false,true,true}=do_delay_send_6(), + %% Now lets start some nodes with different combinations of options: + ?line {true,true,true} = do_delay_on_other_node("", + fun do_delay_send_1/0), + ?line {true,false,false} = + do_delay_on_other_node("-kernel inet_default_connect_options " + "\"[{delay_send,true}]\"", + fun do_delay_send_2/0), + + ?line {false,true,true} = + do_delay_on_other_node("-kernel inet_default_listen_options " + "\"[{delay_send,true}]\"", + fun do_delay_send_2/0), + + ?line {true,true,true} = + do_delay_on_other_node("-kernel inet_default_listen_options " + "\"[{delay_send,true}]\"", + fun do_delay_send_3/0), + ?line {true,true,true} = + do_delay_on_other_node("-kernel inet_default_connect_options " + "\"[{delay_send,true}]\"", + fun do_delay_send_6/0), + ?line {false,false,false} = + do_delay_on_other_node("-kernel inet_default_connect_options " + "\"[{delay_send,true}]\"", + fun do_delay_send_5/0), + ?line {false,true,true} = + do_delay_on_other_node("-kernel inet_default_connect_options " + "\"[{delay_send,true}]\" " + "-kernel inet_default_listen_options " + "\"[{delay_send,true}]\"", + fun do_delay_send_5/0), + ?line {true,false,false} = + do_delay_on_other_node("-kernel inet_default_connect_options " + "\"[{delay_send,true}]\" " + "-kernel inet_default_listen_options " + "\"[{delay_send,true}]\"", + fun do_delay_send_4/0), + ?line {true,true,true} = + do_delay_on_other_node("-kernel inet_default_connect_options " + "\"{delay_send,true}\" " + "-kernel inet_default_listen_options " + "\"{delay_send,true}\"", + fun do_delay_send_2/0), + %% Active is to dangerous and is supressed + ?line {true,true,true} = + do_delay_on_other_node("-kernel inet_default_connect_options " + "\"{active,false}\" " + "-kernel inet_default_listen_options " + "\"{active,false}\"", + fun do_delay_send_7/0), + ?line {true,true,true} = + do_delay_on_other_node("-kernel inet_default_connect_options " + "\"[{active,false},{delay_send,true}]\" " + "-kernel inet_default_listen_options " + "\"[{active,false},{delay_send,true}]\"", + fun do_delay_send_7/0), + ?line {true,true,true} = + do_delay_on_other_node("-kernel inet_default_connect_options " + "\"[{active,false},{delay_send,true}]\" " + "-kernel inet_default_listen_options " + "\"[{active,false},{delay_send,true}]\"", + fun do_delay_send_2/0), + ok. + + +do_delay_on_other_node(XArgs, Function) -> + Dir = filename:dirname(code:which(?MODULE)), + {ok,Node} = test_server:start_node(test_default_options_slave,slave, + [{args,"-pa " ++ Dir ++ " " ++ + XArgs}]), + Res = rpc:call(Node,erlang,apply,[Function,[]]), + test_server:stop_node(Node), + Res. + + +do_delay_send_1() -> + {ok,LS}=gen_tcp:listen(0,[{delay_send,true}]), + {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS), + {ok,S}=gen_tcp:connect("localhost",PortNum,[{delay_send,true}]), + {ok,S2}= gen_tcp:accept(LS), + {ok,[{delay_send,B1}]}=inet:getopts(S,[delay_send]), + {ok,[{delay_send,B2}]}=inet:getopts(LS,[delay_send]), + {ok,[{delay_send,B3}]}=inet:getopts(S2,[delay_send]), + gen_tcp:close(S2), + gen_tcp:close(S), + gen_tcp:close(LS), + {B1,B2,B3}. + +do_delay_send_2() -> + {ok,LS}=gen_tcp:listen(0,[]), + {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS), + {ok,S}=gen_tcp:connect("localhost",PortNum,[]), + {ok,S2}= gen_tcp:accept(LS), + {ok,[{delay_send,B1}]}=inet:getopts(S,[delay_send]), + {ok,[{delay_send,B2}]}=inet:getopts(LS,[delay_send]), + {ok,[{delay_send,B3}]}=inet:getopts(S2,[delay_send]), + gen_tcp:close(S2), + gen_tcp:close(S), + gen_tcp:close(LS), + {B1,B2,B3}. + +do_delay_send_3() -> + {ok,LS}=gen_tcp:listen(0,[]), + {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS), + {ok,S}=gen_tcp:connect("localhost",PortNum,[{delay_send,true}]), + {ok,S2}= gen_tcp:accept(LS), + {ok,[{delay_send,B1}]}=inet:getopts(S,[delay_send]), + {ok,[{delay_send,B2}]}=inet:getopts(LS,[delay_send]), + {ok,[{delay_send,B3}]}=inet:getopts(S2,[delay_send]), + gen_tcp:close(S2), + gen_tcp:close(S), + gen_tcp:close(LS), + {B1,B2,B3}. + +do_delay_send_4() -> + {ok,LS}=gen_tcp:listen(0,[{delay_send,false}]), + {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS), + {ok,S}=gen_tcp:connect("localhost",PortNum,[]), + {ok,S2}= gen_tcp:accept(LS), + {ok,[{delay_send,B1}]}=inet:getopts(S,[delay_send]), + {ok,[{delay_send,B2}]}=inet:getopts(LS,[delay_send]), + {ok,[{delay_send,B3}]}=inet:getopts(S2,[delay_send]), + gen_tcp:close(S2), + gen_tcp:close(S), + gen_tcp:close(LS), + {B1,B2,B3}. + +do_delay_send_5() -> + {ok,LS}=gen_tcp:listen(0,[]), + {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS), + {ok,S}=gen_tcp:connect("localhost",PortNum,[{delay_send,false}]), + {ok,S2}= gen_tcp:accept(LS), + {ok,[{delay_send,B1}]}=inet:getopts(S,[delay_send]), + {ok,[{delay_send,B2}]}=inet:getopts(LS,[delay_send]), + {ok,[{delay_send,B3}]}=inet:getopts(S2,[delay_send]), + gen_tcp:close(S2), + gen_tcp:close(S), + gen_tcp:close(LS), + {B1,B2,B3}. + +do_delay_send_6() -> + {ok,LS}=gen_tcp:listen(0,[{delay_send,true}]), + {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS), + {ok,S}=gen_tcp:connect("localhost",PortNum,[]), + {ok,S2}= gen_tcp:accept(LS), + {ok,[{delay_send,B1}]}=inet:getopts(S,[delay_send]), + {ok,[{delay_send,B2}]}=inet:getopts(LS,[delay_send]), + {ok,[{delay_send,B3}]}=inet:getopts(S2,[delay_send]), + gen_tcp:close(S2), + gen_tcp:close(S), + gen_tcp:close(LS), + {B1,B2,B3}. + +do_delay_send_7() -> + {ok,LS}=gen_tcp:listen(0,[]), + {ok,{{0,0,0,0},PortNum}}=inet:sockname(LS), + {ok,S}=gen_tcp:connect("localhost",PortNum,[]), + {ok,S2}= gen_tcp:accept(LS), + {ok,[{active,B1}]}=inet:getopts(S,[active]), + {ok,[{active,B2}]}=inet:getopts(LS,[active]), + {ok,[{active,B3}]}=inet:getopts(S2,[active]), + gen_tcp:close(S2), + gen_tcp:close(S), + gen_tcp:close(LS), + {B1,B2,B3}. + + + +controlling_process(doc) -> + ["Open a listen port and change controlling_process for it", + "The result should be ok of done by the owner process," + "Otherwise is should return {error,not_owner} or similar"]; +controlling_process(suite) -> []; +controlling_process(Config) when is_list(Config) -> + {ok,S} = gen_tcp:listen(0,[]), + Pid2 = spawn(?MODULE,not_owner,[S]), + Pid2 ! {self(),2,control}, + ?line {error, E} = receive {2,_E} -> + _E + after 10000 -> timeout + end, + io:format("received ~p~n",[E]), + Pid = spawn(?MODULE,not_owner,[S]), + ?line ok = gen_tcp:controlling_process(S,Pid), + Pid ! {self(),1,control}, + ?line ok = receive {1,ok} -> + ok + after 1000 -> timeout + end, + Pid ! close. + +not_owner(S) -> + receive + {From,Tag,control} -> + From ! {Tag,gen_tcp:controlling_process(S,self())}; + close -> + gen_tcp:close(S) + after 1000 -> + ok + end. + +no_accept(doc) -> + ["Open a listen port and connect to it, then close the listen port ", + "without doing any accept. The connected socket should receive ", + "a tcp_closed message."]; +no_accept(suite) -> []; +no_accept(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {skip,"Too tough for vxworks"}; + _ -> + no_accept2() + end. + +no_accept2() -> + ?line {ok, L} = gen_tcp:listen(0, []), + ?line {ok, {_, Port}} = inet:sockname(L), + ?line {ok, Client} = gen_tcp:connect(localhost, Port, []), + ?line ok = gen_tcp:close(L), + ?line receive + {tcp_closed, Client} -> + ok + after 5000 -> + ?line test_server:fail(never_closed) + + end. + +close_with_pending_output(doc) -> + ["Send several packets to a socket and close it. All packets should arrive ", + "to the other end."]; +close_with_pending_output(suite) -> []; +close_with_pending_output(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {skipped,"Too tough for vxworks"}; + _ -> + close_with_pending_output2() + end. + +close_with_pending_output2() -> + ?line {ok, L} = gen_tcp:listen(0, [binary, {active, false}]), + ?line {ok, {_, Port}} = inet:sockname(L), + ?line Packets = 16, + ?line Total = 2048*Packets, + case start_remote(close_pending) of + {ok, Node} -> + ?line {ok, Host} = inet:gethostname(), + ?line spawn_link(Node, ?MODULE, sender, [Port, Packets, Host]), + ?line {ok, A} = gen_tcp:accept(L), + ?line case gen_tcp:recv(A, Total) of + {ok, Bin} when byte_size(Bin) == Total -> + gen_tcp:close(A), + gen_tcp:close(L); + {ok, Bin} -> + ?line test_server:fail({small_packet, + byte_size(Bin)}); + Error -> + ?line test_server:fail({unexpected, Error}) + end, + ok; + {error, no_remote_hosts} -> + {skipped,"No remote hosts"}; + {error, Other} -> + ?line ?t:fail({failed_to_start_slave_node, Other}) + end. + +sender(Port, Packets, Host) -> + X256 = lists:seq(0, 255), + X512 = [X256|X256], + X1K = [X512|X512], + Bin = list_to_binary([X1K|X1K]), + {ok, Sock} = gen_tcp:connect(Host, Port, []), + send_loop(Sock, Bin, Packets), + ok = gen_tcp:close(Sock). + +send_loop(_Sock, _Data, 0) -> ok; +send_loop(Sock, Data, Left) -> + ok = gen_tcp:send(Sock, Data), + send_loop(Sock, Data, Left-1). + +-define(OTP_3924_MAX_DELAY, 100). +%% Taken out of the blue, but on intra host connections +%% I expect propagation of a close to be quite fast +%% so 100 ms seems reasonable. + +otp_3924(doc) -> + ["Tests that a socket can be closed fast enough."]; +otp_3924(suite) -> []; +otp_3924(Config) when is_list(Config) -> + MaxDelay = (case has_superfluous_schedulers() of + true -> 4; + false -> 1 + end + * case {erlang:system_info(debug_compiled), + erlang:system_info(lock_checking)} of + {true, _} -> 6; + {_, true} -> 2; + _ -> 1 + end * ?OTP_3924_MAX_DELAY), + case os:type() of + vxworks -> +%% {skip,"Too tough for vxworks"}; + otp_3924_1(MaxDelay); + _ -> + otp_3924_1(MaxDelay) + end. + +otp_3924_1(MaxDelay) -> + Dog = test_server:timetrap(test_server:seconds(240)), + ?line {ok, Node} = start_node(otp_3924), + ?line DataLen = 100*1024, + ?line Data = otp_3924_data(DataLen), + % Repeat the test a couple of times to prevent the test from passing + % by chance. + repeat(10, + fun (N) -> + ?line ok = otp_3924(MaxDelay, Node, Data, DataLen, N) + end), + ?line test_server:stop_node(Node), + test_server:timetrap_cancel(Dog), + ok. + +otp_3924(MaxDelay, Node, Data, DataLen, N) -> + ?line {ok, L} = gen_tcp:listen(0, [list, {active, false}]), + ?line {ok, {_, Port}} = inet:sockname(L), + ?line {ok, Host} = inet:gethostname(), + ?line Sender = spawn_link(Node, + ?MODULE, + otp_3924_sender, + [self(), Host, Port, Data]), + ?line Data = otp_3924_receive_data(L, Sender, MaxDelay, DataLen, N), + ?line ok = gen_tcp:close(L). + +otp_3924_receive_data(LSock, Sender, MaxDelay, Len, N) -> + ?line OP = process_flag(priority, max), + ?line OTE = process_flag(trap_exit, true), + ?line TimeoutRef = make_ref(), + ?line Data = (catch begin + ?line Sender ! start, + ?line {ok, Sock} = gen_tcp:accept(LSock), + ?line D = otp_3924_receive_data(Sock, + TimeoutRef, + MaxDelay, + Len, + [], + 0), + ?line ok = gen_tcp:close(Sock), + D + end), + ?line unlink(Sender), + ?line process_flag(trap_exit, OTE), + ?line process_flag(priority, OP), + receive + {'EXIT', _, TimeoutRef} -> + ?line test_server:fail({close_not_fast_enough,MaxDelay,N}); + {'EXIT', Sender, Reason} -> + ?line test_server:fail({sender_exited, Reason}); + {'EXIT', _Other, Reason} -> + ?line test_server:fail({linked_process_exited, Reason}) + after 0 -> + case Data of + {'EXIT', {A,B}} -> + ?line test_server:fail({A,B,N}); + {'EXIT', Failure} -> + ?line test_server:fail(Failure); + _ -> + ?line Data + end + end. + + +otp_3924_receive_data(Sock, TimeoutRef, MaxDelay, Len, Acc, AccLen) -> + case gen_tcp:recv(Sock, 0) of + {ok, Data} -> + NewAccLen = AccLen + length(Data), + if + NewAccLen == Len -> + ?line {ok, TRef} = timer:exit_after(MaxDelay, + self(), + TimeoutRef), + ?line {error, closed} = gen_tcp:recv(Sock, 0), + ?line timer:cancel(TRef), + ?line lists:flatten([Acc, Data]); + NewAccLen > Len -> + exit({received_too_much, NewAccLen}); + true -> + otp_3924_receive_data(Sock, + TimeoutRef, + MaxDelay, + Len, + [Acc, Data], + NewAccLen) + end; + {error, closed} -> + exit({premature_close, AccLen}); + Error -> + exit({unexpected_error, Error}) + end. + +otp_3924_data(Size) -> + Block = + "This is a sequence of characters that will be repeated " + "again and again and again and again and again and ... ", + L = length(Block), + otp_3924_data(Block, [], Size div L, Size rem L). + +otp_3924_data(_, Acc, 0, 0) -> + lists:flatten(Acc); +otp_3924_data(_, Acc, 0, SingleLeft) -> + otp_3924_data(false, ["."|Acc], 0, SingleLeft-1); +otp_3924_data(Block, Acc, BlockLeft, SingleLeft) -> + otp_3924_data(Block, [Block|Acc], BlockLeft-1, SingleLeft). + +otp_3924_sender(Receiver, Host, Port, Data) -> + receive + start -> + {ok, Sock} = gen_tcp:connect(Host, Port, [list]), + gen_tcp:send(Sock, Data), + ok = gen_tcp:close(Sock), + unlink(Receiver) + end. + + +data_before_close(doc) -> + ["Tests that a huge amount of data can be received before a close."]; +data_before_close(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {skip,"Too tough for vxworks"}; + _ -> + data_before_close2() + end. + +data_before_close2() -> + ?line {ok, L} = gen_tcp:listen(0, [binary]), + ?line {ok, {_, TcpPort}} = inet:sockname(L), + ?line Bytes = 256*1024, + ?line spawn_link(fun() -> huge_sender(TcpPort, Bytes) end), + ?line {ok, A} = gen_tcp:accept(L), + ?line case count_bytes_recv(A, 0) of + {Bytes, Result} -> + io:format("Result: ~p", [Result]); + {Wrong, Result} -> + io:format("Result: ~p", [Result]), + test_server:fail({wrong_count, Wrong}) + end, + ok. + +count_bytes_recv(Sock, Total) -> + receive + {tcp, Sock, Bin} -> + count_bytes_recv(Sock, Total+byte_size(Bin)); + Other -> + {Total, Other} + end. + +huge_sender(TcpPort, Bytes) -> + {ok, Client} = gen_tcp:connect(localhost, TcpPort, []), + receive after 500 -> ok end, + gen_tcp:send(Client, make_zero_packet(Bytes)), + gen_tcp:close(Client). + +make_zero_packet(0) -> []; +make_zero_packet(N) when N rem 2 == 0 -> + P = make_zero_packet(N div 2), + [P|P]; +make_zero_packet(N) -> + P = make_zero_packet(N div 2), + [0, P|P]. +get_status(doc) -> + ["OTP-2924", + "test that the socket process does not crash when sys:get_status(Pid)", + "is called."]; +get_status(suite) -> []; +get_status(Config) when is_list(Config) -> + ?line {ok,{socket,Pid,_,_}} = gen_tcp:listen(5678,[]), + ?line {status,Pid,_,_} = sys:get_status(Pid). + +iter_max_socks(doc) -> + ["Open as many sockets as possible. Do this several times and check ", + "that we get the same number of sockets every time."]; +iter_max_socks(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {skip,"Too tough for vxworks"}; + _ -> + iter_max_socks2() + end. + +-define(RECOVER_SLEEP, 60000). +-define(RETRY_SLEEP, 15000). + +iter_max_socks2() -> + ?line N = + case os:type() of + vxworks -> + 10; + _ -> + 20 + end, + L = do_iter_max_socks(N, initalize), + ?line io:format("Result: ~p",[L]), + ?line all_equal(L), + ?line {comment, "Max sockets: " ++ integer_to_list(hd(L))}. + +do_iter_max_socks(0, _) -> + []; +do_iter_max_socks(N, initalize) -> + MS = max_socks(), + [MS|do_iter_max_socks(N-1, MS)]; +do_iter_max_socks(N, failed) -> + MS = max_socks(), + [MS|do_iter_max_socks(N-1, failed)]; +do_iter_max_socks(N, First) when is_integer(First) -> + ?line MS = max_socks(), + if MS == First -> + ?line [MS|do_iter_max_socks(N-1, First)]; + true -> + ?line io:format("Sleeping for ~p seconds...~n", + [?RETRY_SLEEP/1000]), + ?line ?t:sleep(?RETRY_SLEEP), + ?line io:format("Trying again...~n", []), + ?line RetryMS = max_socks(), + ?line if RetryMS == First -> + ?line [RetryMS|do_iter_max_socks(N-1, First)]; + true -> + ?line [RetryMS|do_iter_max_socks(N-1, failed)] + end + end. + +all_equal([]) -> + ok; +all_equal([Rule | T]) -> + all_equal(Rule, T). + +all_equal(Rule, [Rule | T]) -> + all_equal(Rule, T); +all_equal(_, [_ | _]) -> + ?line ?t:sleep(?RECOVER_SLEEP), % Wait a while and *hope* that we'll + % recover so other tests won't be + % affected. + ?t:fail(max_socket_mismatch); +all_equal(_Rule, []) -> + ok. + +max_socks() -> + ?line Socks = open_socks(), + ?line N = length(Socks), + ?line lists:foreach(fun(S) -> ok = gen_tcp:close(S) end, Socks), + io:format("Got ~p sockets", [N]), + N. + +open_socks() -> + case gen_tcp:listen(0, []) of + {ok, L} -> + {ok, {_, Port}} = inet:sockname(L), + [L| connect_accept(L, Port)]; + _ -> + [] + end. + +connect_accept(L, Port) -> + case gen_tcp:connect(localhost, Port, []) of + {ok, C} -> + [C| do_accept(L, Port)]; + _ -> + [] + end. + +do_accept(L, Port) -> + case gen_tcp:accept(L) of + {ok, A} -> [A| connect_accept(L, Port)]; + _ -> [] + end. + +start_node(Name) -> + Pa = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, slave, [{args, "-pa " ++ Pa}]). + +start_remote(Name) -> + Pa = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, slave, [{remote, true}, {args, "-pa " ++ Pa}]). + +passive_sockets(doc) -> + ["Tests that when 'the other side' on a passive socket closes, the connecting", + "side still can read until the end of data."]; +passive_sockets(Config) when is_list(Config) -> + ?line spawn_link(?MODULE, passive_sockets_server, + [[{active,false}],self()]), + ?line receive + {socket,Port} -> ok + end, + ?t:sleep(500), + ?line case gen_tcp:connect("localhost", Port, [{active, false}]) of + {ok, Sock} -> + passive_sockets_read(Sock); + Error -> + ?t:fail({"Could not connect to server", Error}) + end. + +%% +%% Read until we get an {error, closed}. If we get another error, this test case +%% should fail. +%% +passive_sockets_read(Sock) -> + case gen_tcp:recv(Sock, 0, 2000) of + {ok, Data} -> + io:format("Received ~p bytes~n", [length(Data)]), + passive_sockets_read(Sock); + {error, closed} -> + gen_tcp:close(Sock); + Error -> + gen_tcp:close(Sock), + ?t:fail({"Did not get {error, closed} before other error", Error}) + end. + +passive_sockets_server(Opts, Parent) -> + ?line case gen_tcp:listen(0, Opts) of + {ok, LSock} -> + {ok,{_,Port}} = inet:sockname(LSock), + Parent ! {socket,Port}, + passive_sockets_server_accept(LSock); + Error -> + ?t:fail({"Could not create listen socket", Error}) + end. + +passive_sockets_server_accept(Sock) -> + ?line case gen_tcp:accept(Sock) of + {ok, Socket} -> + ?t:sleep(500), % Simulate latency + passive_sockets_server_send(Socket, 5), + passive_sockets_server_accept(Sock); + Error -> + ?t:fail({"Could not accept connection", Error}) + end. + +passive_sockets_server_send(Socket, 0) -> + io:format("Closing other end..~n", []), + gen_tcp:close(Socket); +passive_sockets_server_send(Socket, X) -> + ?line Data = lists:duplicate(1024*X, $a), + ?line case gen_tcp:send(Socket, Data) of + ok -> + ?t:sleep(50), % Simulate some processing. + passive_sockets_server_send(Socket, X-1); + {error, _Reason} -> + ?t:fail("Failed to send data") + end. + + +accept_closed_by_other_process(doc) -> + ["Tests the return value from gen_tcp:accept when ", + "the socket is closed from an other process. (OTP-3817)"]; +accept_closed_by_other_process(Config) when is_list(Config) -> + ?line Parent = self(), + ?line {ok, ListenSocket} = gen_tcp:listen(0, []), + ?line Child = + spawn_link( + fun() -> + Parent ! {self(), gen_tcp:accept(ListenSocket)} + end), + ?line receive after 1000 -> ok end, + ?line ok = gen_tcp:close(ListenSocket), + ?line receive + {Child, {error, closed}} -> + ok; + {Child, Other} -> + ?t:fail({"Wrong result of gen_tcp:accept", Other}) + end. + +repeat(N, Fun) -> + repeat(N, N, Fun). + +repeat(N, T, Fun) when is_integer(N), N > 0 -> + Fun(T-N), + repeat(N-1, T, Fun); +repeat(_, _, _) -> + ok. + + +closed_socket(suite) -> + []; +closed_socket(doc) -> + ["Tests the response when using a closed socket as argument"]; +closed_socket(Config) when is_list(Config) -> + ?line {ok, LS1} = gen_tcp:listen(0, []), + ?line erlang:yield(), + ?line ok = gen_tcp:close(LS1), + %% If the following delay is uncommented, the result error values + %% below will change from {error, einval} to {error, closed} since + %% inet_db then will have noticed that the socket is closed. + %% This is a scheduling issue, i.e when the gen_server in + %% in inet_db processes the 'EXIT' message from the port, + %% the socket is unregistered. + %% + %% ?line test_server:sleep(test_server:seconds(2)), + %% + ?line {error, R_send} = gen_tcp:send(LS1, "data"), + ?line {error, R_recv} = gen_tcp:recv(LS1, 17), + ?line {error, R_accept} = gen_tcp:accept(LS1), + ?line {error, R_controlling_process} = + gen_tcp:controlling_process(LS1, self()), + %% + ?line ok = io:format("R_send = ~p~n", [R_send]), + ?line ok = io:format("R_recv = ~p~n", [R_recv]), + ?line ok = io:format("R_accept = ~p~n", [R_accept]), + ?line ok = io:format("R_controlling_process = ~p~n", + [R_controlling_process]), + ok. + +%%% +%%% Test using the gen_tcp:shutdown/2 function using a sort server. +%%% + +shutdown_active(Config) when is_list(Config) -> + ?line shutdown_common(true). + +shutdown_passive(Config) when is_list(Config) -> + ?line shutdown_common(false). + +shutdown_common(Active) -> + ?line P = sort_server(Active), + io:format("Sort server port: ~p\n", [P]), + + ?line do_sort(P, []), + ?line do_sort(P, ["glurf"]), + ?line do_sort(P, ["abc","nisse","dum"]), + + ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 255)]), + ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(77, 999)]), + ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 55)]), + ?line do_sort(P, []), + ?line do_sort(P, ["apa"]), + ?line do_sort(P, ["kluns","gorilla"]), + ?line do_sort(P, [lists:reverse(integer_to_list(I)) || I <- lists:seq(25, 1233)]), + ?line do_sort(P, []), + + receive + Any -> + ?t:fail({unexpected_message,Any}) + after 0 -> ok + end. + +do_sort(P, List0) -> + List = [El++"\n" || El <- List0], + {ok,S} = gen_tcp:connect(localhost, P, [{packet,line}]), + send_lines(S, List), + gen_tcp:shutdown(S, write), + Lines = collect_lines(S, true), + io:format("~p\n", [Lines]), + Lines = lists:sort(List), + ok = gen_tcp:close(S). + +sort_server(Active) -> + Opts = [{exit_on_close,false},{packet,line},{active,Active}], + ?line {ok,L} = gen_tcp:listen(0, Opts), + Go = make_ref(), + ?line Pid = spawn_link(fun() -> + receive Go -> sort_server_1(L, Active) end + end), + ?line ok = gen_tcp:controlling_process(L, Pid), + ?line Pid ! Go, + ?line {ok,Port} = inet:port(L), + Port. + +sort_server_1(L, Active) -> + {ok,S} = gen_tcp:accept(L), + Go = make_ref(), + Sorter = spawn(fun() -> receive Go -> sorter(S, Active) end end), + ok = gen_tcp:controlling_process(S, Sorter), + Sorter ! Go, + sort_server_1(L, Active). + +sorter(S, Active) -> + Lines = collect_lines(S, Active), + send_lines(S, lists:sort(Lines)), + gen_tcp:shutdown(S, write), + gen_tcp:close(S). + +collect_lines(S, true) -> + collect_lines_1(S, []); +collect_lines(S, false) -> + passive_collect_lines_1(S, []). + +collect_lines_1(S, Acc) -> + receive + {tcp,S,Line} -> collect_lines_1(S, [Line|Acc]); + {tcp_closed,S} -> lists:reverse(Acc) + end. + +passive_collect_lines_1(S, Acc) -> + case gen_tcp:recv(S, 0) of + {ok,Line} -> passive_collect_lines_1(S, [Line|Acc]); + {error,closed} -> lists:reverse(Acc) + end. + + +send_lines(S, Lines) -> + lists:foreach(fun(Line) -> + gen_tcp:send(S, Line) + end, Lines). + +%%% +%%% Shutdown pending. +%%% + +shutdown_pending(Config) when is_list(Config) -> + N = 512*1024+17, + io:format("~p\n", [N]), + Data = [<<N:32>>,ones(N),42], + P = a_server(), + io:format("Server port: ~p\n", [P]), + ?line {ok,S} = gen_tcp:connect(localhost, P, []), + ?line gen_tcp:send(S, Data), + ?line gen_tcp:shutdown(S, write), + ?line receive + {tcp,S,Msg} -> + io:format("~p\n", [Msg]), + ?line N = list_to_integer(Msg) - 5; + Other -> + ?t:fail({unexpected,Other}) + end, + ok. + + ones(0) -> []; + ones(1) -> [1]; + ones(N) -> + Half = N div 2, + Ones = ones(Half), + case 2*Half of + N -> [Ones|Ones]; + _ -> [1,Ones|Ones] + end. + + a_server() -> + ?line {ok,L} = gen_tcp:listen(0, [{exit_on_close,false},{active,false}]), + ?line Pid = spawn_link(fun() -> a_server(L) end), + ?line ok = gen_tcp:controlling_process(L, Pid), + ?line {ok,Port} = inet:port(L), + Port. + + a_server(L) -> + {ok,S} = gen_tcp:accept(L), + do_recv(S, []). + + do_recv(S, Bs0) -> + case gen_tcp:recv(S, 0) of + {ok,B} -> + do_recv(S, [Bs0,B]); + {error,closed} -> + Bs = list_to_binary(Bs0), + gen_tcp:send(S, integer_to_list(byte_size(Bs))), + gen_tcp:close(S) + end. + + +%% Thanks to Luke Gorrie. Tests for a very specific problem with +%% corrupt data. The testcase will be killed by the timetrap timeout +%% if the bug is present. +http_bad_packet(Config) when is_list(Config) -> + ?line {ok,L} = gen_tcp:listen(0, + [{active, false}, + binary, + {reuseaddr, true}, + {packet, http}]), + ?line {ok,Port} = inet:port(L), + ?line spawn_link(fun() -> erlang:yield(), http_bad_client(Port) end), + ?line case gen_tcp:accept(L) of + {ok,S} -> + http_worker(S); + Err -> + exit({accept,Err}) + end. + +http_worker(S) -> + case gen_tcp:recv(S, 0, 30000) of + {ok,Data} -> + io:format("Data: ~p\n", [Data]), + http_worker(S); + {error,Rsn} -> + io:format("Error: ~p\n", [Rsn]), + ok + end. + +http_bad_client(Port) -> + {ok,S} = gen_tcp:connect("localhost", Port, [{active,false}, binary]), + ok = gen_tcp:send(S, "\r\n"), + ok = gen_tcp:close(S). + + +%% Fill send queue and then start receiving. +%% +busy_send(Config) when is_list(Config) -> + ?line Master = self(), + ?line Msg = <<"the quick brown fox jumps over a lazy dog~n">>, + ?line Server = + spawn_link(fun () -> + {ok,L} = gen_tcp:listen + (0, [{active,false},binary, + {reuseaddr,true},{packet,0}]), + {ok,Port} = inet:port(L), + Master ! {self(),client, + busy_send_client(Port, Master, Msg)}, + busy_send_srv(L, Master, Msg) + end), + ?line io:format("~p Server~n", [Server]), + ?line receive + {Server,client,Client} -> + ?line io:format("~p Client~n", [Client]), + ?line busy_send_loop(Server, Client, 0) + end. + +busy_send_loop(Server, Client, N) -> + %% Master + %% + ?line receive {Server,send} -> + busy_send_loop(Server, Client, N+1) + after 2000 -> + %% Send queue full, sender blocked + %% -> stop sender and release client + ?line io:format("Send timeout, time to receive...~n", []), + ?line Server ! {self(),close}, + ?line Client ! {self(),recv,N+1}, + ?line receive + {Server,send} -> + ?line busy_send_2(Server, Client, N+1) + after 10000 -> + ?t:fail({timeout,{server,not_send,flush([])}}) + end + end. + +busy_send_2(Server, Client, _N) -> + %% Master + %% + ?line receive + {Server,[closed]} -> + ?line receive + {Client,[0,{error,closed}]} -> + ok + end + after 10000 -> + ?t:fail({timeout,{server,not_closed,flush([])}}) + end. + +busy_send_srv(L, Master, Msg) -> + %% Server + %% + {ok,Socket} = gen_tcp:accept(L), + busy_send_srv_loop(Socket, Master, Msg). + +busy_send_srv_loop(Socket, Master, Msg) -> + %% Server + %% + receive + {Master,close} -> + ok = gen_tcp:close(Socket), + Master ! {self(),flush([closed])} + after 0 -> + ok = gen_tcp:send(Socket, Msg), + Master ! {self(),send}, + busy_send_srv_loop(Socket, Master, Msg) + end. + +busy_send_client(Port, Master, Msg) -> + %% Client + %% + spawn_link( + fun () -> + {ok,Socket} = gen_tcp:connect( + "localhost", Port, + [{active,false},binary,{packet,0}]), + receive + {Master,recv, N} -> + busy_send_client_loop(Socket, Master, Msg, N) + end + end). + +busy_send_client_loop(Socket, Master, Msg, N) -> + %% Client + %% + Size = byte_size(Msg), + case gen_tcp:recv(Socket, Size) of + {ok,Msg} -> + busy_send_client_loop(Socket, Master, Msg, N-1); + Other -> + Master ! {self(),flush([Other,N])} + end. + +%%% +%%% Send to a socket whose other end does not read until the port gets busy. +%%% Then close the other end. The writer should get an {error,closed} error. +%%% (Passive mode.) +%%% + +busy_disconnect_passive(Config) when is_list(Config) -> + MuchoData = list_to_binary(ones(64*1024)), + ?line [do_busy_disconnect_passive(MuchoData) || _ <- lists:seq(1, 10)], + ok. + +do_busy_disconnect_passive(MuchoData) -> + S = busy_disconnect_prepare_server([{active,false}]), + busy_disconnect_passive_send(S, MuchoData). + +busy_disconnect_passive_send(S, Data) -> + ?line case gen_tcp:send(S, Data) of + ok -> ?line busy_disconnect_passive_send(S, Data); + {error,closed} -> ok + end. + +%%% +%%% Send to a socket whose other end does not read until the port gets busy. +%%% Then close the other end. The writer should get an {error,closed} error and +%%% a {tcp_closed,Socket} message. (Active mode.) +%%% +busy_disconnect_active(Config) when is_list(Config) -> + MuchoData = list_to_binary(ones(64*1024)), + ?line [do_busy_disconnect_active(MuchoData) || _ <- lists:seq(1, 10)], + ok. + +do_busy_disconnect_active(MuchoData) -> + S = busy_disconnect_prepare_server([{active,true}]), + busy_disconnect_active_send(S, MuchoData). + +busy_disconnect_active_send(S, Data) -> + ?line case gen_tcp:send(S, Data) of + ok -> ?line busy_disconnect_active_send(S, Data); + {error,closed} -> + receive + {tcp_closed,S} -> ok; + _Other -> ?line ?t:fail() + end + end. + + +busy_disconnect_prepare_server(ConnectOpts) -> + ?line Sender = self(), + ?line Server = spawn_link(fun() -> busy_disconnect_server(Sender) end), + receive {port,Server,Port} -> ok end, + ?line {ok,S} = gen_tcp:connect(localhost, Port, ConnectOpts), + Server ! {Sender,sending}, + S. + +busy_disconnect_server(Sender) -> + {ok,L} = gen_tcp:listen(0, [{active,false},binary,{reuseaddr,true},{packet,0}]), + {ok,Port} = inet:port(L), + Sender ! {port,self(),Port}, + {ok,S} = gen_tcp:accept(L), + receive + {Sender,sending} -> + busy_disconnect_server_wait_for_busy(Sender, S) + end. + +%% Close the socket as soon as the Sender process can't send because of +%% a busy port. +busy_disconnect_server_wait_for_busy(Sender, S) -> + case process_info(Sender, status) of + {status,waiting} -> + %% We KNOW that the sender will be in state 'waiting' only + %% if the port has become busy. (Fallback solution if the + %% implementation changes: Watch Sender's reduction count; + %% when it stops changing, wait 2 seconds and then close.) + gen_tcp:close(S); + _Other -> + io:format("~p\n", [_Other]), + timer:sleep(100), + busy_disconnect_server_wait_for_busy(Sender, S) + end. + +%%% +%%% Fill send queue +%%% +fill_sendq(Config) when is_list(Config) -> + ?line Master = self(), + ?line Server = + spawn_link(fun () -> + {ok,L} = gen_tcp:listen + (0, [{active,false},binary, + {reuseaddr,true},{packet,0}]), + {ok,Port} = inet:port(L), + Master ! {self(),client, + fill_sendq_client(Port, Master)}, + fill_sendq_srv(L, Master) + end), + ?line io:format("~p Server~n", [Server]), + ?line receive {Server,client,Client} -> + ?line io:format("~p Client~n", [Client]), + ?line receive {Server,reader,Reader} -> + ?line io:format("~p Reader~n", [Reader]), + ?line fill_sendq_loop(Server, Client, Reader) + end + end. + +fill_sendq_loop(Server, Client, Reader) -> + %% Master + %% + receive {Server,send} -> + fill_sendq_loop(Server, Client, Reader) + after 2000 -> + %% Send queue full, sender blocked -> close client. + ?line io:format("Send timeout, closing Client...~n", []), + ?line Client ! {self(),close}, + ?line receive {Server,[{error,closed}]} -> + ?line io:format("Got server closed.~n"), + ?line receive {Reader,[{error,closed}]} -> + ?line io:format + ("Got reader closed.~n"), + ok + after 3000 -> + ?t:fail({timeout,{closed,reader}}) + end; + {Reader,[{error,closed}]} -> + ?line io:format("Got reader closed.~n"), + ?line receive {Server,[{error,closed}]} -> + ?line io:format("Got server closed~n"), + ok + after 3000 -> + ?t:fail({timeout,{closed,server}}) + end + after 3000 -> + ?t:fail({timeout,{closed,[server,reader]}}) + end + end. + +fill_sendq_srv(L, Master) -> + %% Server + %% + case gen_tcp:accept(L) of + {ok,S} -> + Master ! {self(),reader, + spawn_link(fun () -> fill_sendq_read(S, Master) end)}, + Msg = "the quick brown fox jumps over a lazy dog~n", + fill_sendq_write(S, Master, [Msg,Msg,Msg,Msg,Msg,Msg,Msg,Msg]); + Error -> + io:format("~p error: ~p.~n", [self(),Error]), + Master ! {self(),flush([Error])} + end. + +fill_sendq_write(S, Master, Msg) -> + %% Server + %% + %%io:format("~p sending...~n", [self()]), + Master ! {self(),send}, + case gen_tcp:send(S, Msg) of + ok -> + %%io:format("~p ok.~n", [self()]), + fill_sendq_write(S, Master, Msg); + E -> + Error = flush([E]), + io:format("~p error: ~p.~n", [self(),Error]), + Master ! {self(),Error} + end. + +fill_sendq_read(S, Master) -> + %% Reader + %% + io:format("~p read infinity...~n", [self()]), + case gen_tcp:recv(S, 0, infinity) of + {ok,Data} -> + io:format("~p got: ~p.~n", [self(),Data]), + fill_sendq_read(S, Master); + E -> + Error = flush([E]), + io:format("~p error: ~p.~n", [self(),Error]), + Master ! {self(),Error} + end. + +fill_sendq_client(Port, Master) -> + %% Client + %% + spawn_link(fun () -> + %% Just close on order + {ok,S} = gen_tcp:connect( + "localhost", Port, + [{active,false},binary,{packet,0}]), + receive + {Master,close} -> + ok = gen_tcp:close(S) + end + end). + +%%% Try to receive more than available number of bytes from +%%% a closed socket. +%%% +partial_recv_and_close(Config) when is_list(Config) -> + ?line Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", + ?line Len = length(Msg), + ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), + ?line {ok,P} = inet:port(L), + ?line {ok,S} = gen_tcp:connect("localhost", P, [{active,false}]), + ?line {ok,A} = gen_tcp:accept(L), + ?line ok = gen_tcp:send(S, Msg), + ?line ok = gen_tcp:close(S), + ?line {error,closed} = gen_tcp:recv(A, Len+1), + ok. + +%%% Try to receive more than available number of bytes from +%%% a closed socket, this time waiting in the recv before closing. +%%% +partial_recv_and_close_2(Config) when is_list(Config) -> + ?line Msg = "the quick brown fox jumps over a lazy dog 0123456789\n", + ?line Len = length(Msg), + ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), + ?line {ok,P} = inet:port(L), + ?line Server = self(), + ?line Client = + spawn_link( + fun () -> + receive after 2000 -> ok end, + {ok,S} = gen_tcp:connect("localhost", P, [{active,false}]), + ?line ok = gen_tcp:send(S, Msg), + receive {Server,close} -> ok end, + receive after 2000 -> ok end, + ?line ok = gen_tcp:close(S) + end), + ?line {ok,A} = gen_tcp:accept(L), + ?line Client ! {Server,close}, + ?line {error,closed} = gen_tcp:recv(A, Len+1), + ok. + +%%% Here we tests that gen_tcp:recv/2 will return {error,closed} following +%%% a send operation of a huge amount data when the other end closed the socket. +%%% +partial_recv_and_close_3(Config) when is_list(Config) -> + [do_partial_recv_and_close_3() || _ <- lists:seq(0, 20)], + ok. + +do_partial_recv_and_close_3() -> + Parent = self(), + spawn_link(fun() -> + {ok,L} = gen_tcp:listen(0, [{active,false}]), + {ok,{_,Port}} = inet:sockname(L), + Parent ! {port,Port}, + {ok,S} = gen_tcp:accept(L), + gen_tcp:recv(S, 1), + gen_tcp:close(S) + end), + receive + {port,Port} -> ok + end, + ?line Much = ones(8*64*1024), + ?line {ok,S} = gen_tcp:connect(localhost, Port, [{active,false}]), + + %% Send a lot of data (most of it will be queued). The receiver will read one byte + %% and close the connection. The write operation will fail. + ?line gen_tcp:send(S, Much), + + %% We should always get {error,closed} here. + ?line {error,closed} = gen_tcp:recv(S, 0). + + +test_prio_put_get() -> + Tos = 3 bsl 5, + ?line {ok,L1} = gen_tcp:listen(0, [{active,false}]), + ?line ok = inet:setopts(L1,[{priority,3}]), + ?line ok = inet:setopts(L1,[{tos,Tos}]), + ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), + ?line ok = inet:setopts(L1,[{priority,3}]), % Dont destroy each other + ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), + ?line ok = inet:setopts(L1,[{reuseaddr,true}]), % Dont let others destroy + ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(L1,[priority,tos]), + ?line gen_tcp:close(L1), + ok. +test_prio_accept() -> + ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true},{priority,4}]), + ?line {ok,Port} = inet:port(Sock), + ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {priority,4}]), + ?line {ok,Sock3}=gen_tcp:accept(Sock), + ?line {ok,[{priority,4}]} = inet:getopts(Sock,[priority]), + ?line {ok,[{priority,4}]} = inet:getopts(Sock2,[priority]), + ?line {ok,[{priority,4}]} = inet:getopts(Sock3,[priority]), + ?line gen_tcp:close(Sock), + ?line gen_tcp:close(Sock2), + ?line gen_tcp:close(Sock3), + ok. + +test_prio_accept2() -> + Tos1 = 4 bsl 5, + Tos2 = 3 bsl 5, + ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true},{priority,4}, + {tos,Tos1}]), + ?line {ok,Port} = inet:port(Sock), + ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {priority,4}, + {tos,Tos2}]), + ?line {ok,Sock3}=gen_tcp:accept(Sock), + ?line {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), + ?line {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), + ?line {ok,[{priority,4},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), + ?line gen_tcp:close(Sock), + ?line gen_tcp:close(Sock2), + ?line gen_tcp:close(Sock3), + ok. + +test_prio_accept3() -> + Tos1 = 4 bsl 5, + Tos2 = 3 bsl 5, + ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true}, + {tos,Tos1}]), + ?line {ok,Port} = inet:port(Sock), + ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {tos,Tos2}]), + ?line {ok,Sock3}=gen_tcp:accept(Sock), + ?line {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock,[priority,tos]), + ?line {ok,[{priority,0},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), + ?line {ok,[{priority,0},{tos,Tos1}]} = inet:getopts(Sock3,[priority,tos]), + ?line gen_tcp:close(Sock), + ?line gen_tcp:close(Sock2), + ?line gen_tcp:close(Sock3), + ok. + +test_prio_accept_async() -> + Tos1 = 4 bsl 5, + Tos2 = 3 bsl 5, + Ref = make_ref(), + ?line spawn(?MODULE,priority_server,[{self(),Ref}]), + ?line Port = receive + {Ref,P} -> P + after 5000 -> ?t:fail({error,"helper process timeout"}) + end, + ?line receive + after 3000 -> ok + end, + ?line {ok,Sock2}=gen_tcp:connect("localhost",Port,[binary,{packet,0}, + {active,false}, + {reuseaddr,true}, + {priority,4}, + {tos,Tos2}]), + ?line receive + {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> + ok ; + {Ref,Error} -> + ?t:fail({missmatch,Error}) + after 5000 -> ?t:fail({error,"helper process timeout"}) + end, + ?line receive + {Ref,{ok,[{priority,4},{tos,Tos1}]}} -> + ok ; + {Ref,Error2} -> + ?t:fail({missmatch,Error2}) + after 5000 -> ?t:fail({error,"helper process timeout"}) + end, + + ?line {ok,[{priority,4},{tos,Tos2}]} = inet:getopts(Sock2,[priority,tos]), + ?line catch gen_tcp:close(Sock2), + ok. + +priority_server({Parent,Ref}) -> + Tos1 = 4 bsl 5, + ?line {ok,Sock}=gen_tcp:listen(0,[binary,{packet,0},{active,false}, + {reuseaddr,true},{priority,4}, + {tos,Tos1}]), + ?line {ok,Port} = inet:port(Sock), + Parent ! {Ref,Port}, + ?line {ok,Sock3}=gen_tcp:accept(Sock), + Parent ! {Ref, inet:getopts(Sock,[priority,tos])}, + Parent ! {Ref, inet:getopts(Sock3,[priority,tos])}, + ok. + +test_prio_fail() -> + ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), + ?line {error,_} = inet:setopts(L,[{priority,1000}]), +% This error could only happen in linux kernels earlier than 2.6.24.4 +% Privilege check is now disabled and IP_TOS can never fail (only silently +% be masked). +% ?line {error,_} = inet:setopts(L,[{tos,6 bsl 5}]), + ?line gen_tcp:close(L), + ok. + +test_prio_udp() -> + Tos = 3 bsl 5, + ?line {ok,S} = gen_udp:open(0,[{active,false},binary,{tos, Tos}, + {priority,3}]), + ?line {ok,[{priority,3},{tos,Tos}]} = inet:getopts(S,[priority,tos]), + ?line gen_udp:close(S), + ok. + +so_priority(doc) -> + ["Tests the so_priority and ip_tos options on sockets when applicable."]; +so_priority(suite) -> + []; +so_priority(Config) when is_list(Config) -> + ?line {ok,L} = gen_tcp:listen(0, [{active,false}]), + ?line ok = inet:setopts(L,[{priority,1}]), + ?line case inet:getopts(L,[priority]) of + {ok,[{priority,1}]} -> + gen_tcp:close(L), + test_prio_put_get(), + test_prio_accept(), + test_prio_accept2(), + test_prio_accept3(), + test_prio_accept_async(), + test_prio_fail(), + test_prio_udp(), + ok; + _ -> + case os:type() of + {unix,linux} -> + case os:version() of + {X,Y,_} when (X > 2) or ((X =:= 2) and (Y >= 4)) -> + ?line ?t:fail({error, + "so_priority should work on this " + "OS, but does not"}); + _ -> + {skip, "SO_PRIORITY not suppoorted"} + end; + _ -> + {skip, "SO_PRIORITY not suppoorted"} + end + end. + +%% Accept test utilities (suites are below) + +millis() -> + {A,B,C}=erlang:now(), + (A*1000000*1000)+(B*1000)+(C div 1000). + +collect_accepts(Tmo) -> + A = millis(), + receive + {accepted,P,Msg} -> + [{P,Msg}] ++ collect_accepts(Tmo-(millis() - A)) + after Tmo -> + [] + end. + +-define(EXPECT_ACCEPTS(Pattern,Timeout), + (fun() -> + case collect_accepts(Timeout) of + Pattern -> + ok; + Other -> + {error,{unexpected,{Other,process_info(self(),messages)}}} + end + end)()). + +collect_connects(Tmo) -> + A = millis(), + receive + {connected,P,Msg} -> + [{P,Msg}] ++ collect_connects(Tmo-(millis() - A)) + after Tmo -> + [] + end. + +-define(EXPECT_CONNECTS(Pattern,Timeout), + (fun() -> + case collect_connects(Timeout) of + Pattern -> + ok; + Other -> + {error,{unexpected,Other}} + end + end)()). + +mktmofun(Tmo,Parent,LS) -> + fun() -> Parent ! {accepted,self(), catch gen_tcp:accept(LS,Tmo)} end. + +%% Accept tests +primitive_accept(suite) -> + []; +primitive_accept(doc) -> + ["Test singular accept"]; +primitive_accept(Config) when is_list(Config) -> + ?line {ok,LS}=gen_tcp:listen(0,[]), + ?line {ok,PortNo}=inet:port(LS), + ?line Parent = self(), + ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + ?line P = spawn(F), + ?line gen_tcp:connect("localhost",PortNo,[]), + ?line receive + {accepted,P,{ok,P0}} when is_port(P0) -> + ok; + {accepted,P,Other0} -> + {error,Other0} + after 500 -> + {error,timeout} + end. + + +multi_accept_close_listen(suite) -> + []; +multi_accept_close_listen(doc) -> + ["Closing listen socket when multi-accepting"]; +multi_accept_close_listen(Config) when is_list(Config) -> + ?line {ok,LS}=gen_tcp:listen(0,[]), + ?line Parent = self(), + ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + ?line spawn(F), + ?line spawn(F), + ?line spawn(F), + ?line spawn(F), + ?line gen_tcp:close(LS), + ?line ?EXPECT_ACCEPTS([{_,{error,closed}},{_,{error,closed}}, + {_,{error,closed}},{_,{error,closed}}], 500). + +accept_timeout(suite) -> + []; +accept_timeout(doc) -> + ["Single accept with timeout"]; +accept_timeout(Config) when is_list(Config) -> + ?line {ok,LS}=gen_tcp:listen(0,[]), + ?line Parent = self(), + ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS,1000)} end, + ?line P = spawn(F), + ?line ?EXPECT_ACCEPTS([{P,{error,timeout}}],2000). + +accept_timeouts_in_order(suite) -> + []; +accept_timeouts_in_order(doc) -> + ["Check that multi-accept timeouts happen in the correct order"]; +accept_timeouts_in_order(Config) when is_list(Config) -> + ?line {ok,LS}=gen_tcp:listen(0,[]), + ?line Parent = self(), + ?line P1 = spawn(mktmofun(1000,Parent,LS)), + ?line P2 = spawn(mktmofun(1200,Parent,LS)), + ?line P3 = spawn(mktmofun(1300,Parent,LS)), + ?line P4 = spawn(mktmofun(1400,Parent,LS)), + ?line ?EXPECT_ACCEPTS([{P1,{error,timeout}},{P2,{error,timeout}}, + {P3,{error,timeout}},{P4,{error,timeout}}], 2000). + +accept_timeouts_in_order2(suite) -> + []; +accept_timeouts_in_order2(doc) -> + ["Check that multi-accept timeouts happen in the correct order (more)"]; +accept_timeouts_in_order2(Config) when is_list(Config) -> + ?line {ok,LS}=gen_tcp:listen(0,[]), + ?line Parent = self(), + ?line P1 = spawn(mktmofun(1400,Parent,LS)), + ?line P2 = spawn(mktmofun(1300,Parent,LS)), + ?line P3 = spawn(mktmofun(1200,Parent,LS)), + ?line P4 = spawn(mktmofun(1000,Parent,LS)), + ?line ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P3,{error,timeout}}, + {P2,{error,timeout}},{P1,{error,timeout}}], 2000). + +accept_timeouts_in_order3(suite) -> + []; +accept_timeouts_in_order3(doc) -> + ["Check that multi-accept timeouts happen in the correct order (even more)"]; +accept_timeouts_in_order3(Config) when is_list(Config) -> + ?line {ok,LS}=gen_tcp:listen(0,[]), + ?line Parent = self(), + ?line P1 = spawn(mktmofun(1200,Parent,LS)), + ?line P2 = spawn(mktmofun(1400,Parent,LS)), + ?line P3 = spawn(mktmofun(1300,Parent,LS)), + ?line P4 = spawn(mktmofun(1000,Parent,LS)), + ?line ?EXPECT_ACCEPTS([{P4,{error,timeout}},{P1,{error,timeout}}, + {P3,{error,timeout}},{P2,{error,timeout}}], 2000). + +accept_timeouts_mixed(suite) -> + []; +accept_timeouts_mixed(doc) -> + ["Check that multi-accept timeouts behave correctly when mixed with successful timeouts"]; +accept_timeouts_mixed(Config) when is_list(Config) -> + ?line {ok,LS}=gen_tcp:listen(0,[]), + ?line Parent = self(), + ?line {ok,PortNo}=inet:port(LS), + ?line P1 = spawn(mktmofun(1000,Parent,LS)), + ?line wait_until_accepting(P1,500), + ?line P2 = spawn(mktmofun(2000,Parent,LS)), + ?line wait_until_accepting(P2,500), + ?line P3 = spawn(mktmofun(3000,Parent,LS)), + ?line wait_until_accepting(P3,500), + ?line P4 = spawn(mktmofun(4000,Parent,LS)), + ?line wait_until_accepting(P4,500), + ?line ok = ?EXPECT_ACCEPTS([{P1,{error,timeout}}],1500), + ?line {ok,_}=gen_tcp:connect("localhost",PortNo,[]), + ?line ok = ?EXPECT_ACCEPTS([{P2,{ok,Port0}}] when is_port(Port0),100), + ?line ok = ?EXPECT_ACCEPTS([{P3,{error,timeout}}],2000), + ?line gen_tcp:connect("localhost",PortNo,[]), + ?line ?EXPECT_ACCEPTS([{P4,{ok,Port1}}] when is_port(Port1),100). + +killing_acceptor(suite) -> + []; +killing_acceptor(doc) -> + ["Check that single acceptor behaves as expected when killed"]; +killing_acceptor(Config) when is_list(Config) -> + ?line {ok,LS}=gen_tcp:listen(0,[]), + ?line Pid = spawn(fun() -> erlang:display({accepted,self(),gen_tcp:accept(LS)}) end), + ?line receive after 100 -> + ok + end, + ?line {ok,L1} = prim_inet:getstatus(LS), + ?line true = lists:member(accepting, L1), + ?line exit(Pid,kill), + ?line receive after 100 -> + ok + end, + ?line {ok,L2} = prim_inet:getstatus(LS), + ?line false = lists:member(accepting, L2), + ok. + +killing_multi_acceptors(suite) -> + []; +killing_multi_acceptors(doc) -> + ["Check that multi acceptors behaves as expected when killed"]; +killing_multi_acceptors(Config) when is_list(Config) -> + ?line {ok,LS}=gen_tcp:listen(0,[]), + ?line Parent = self(), + ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + ?line F2 = mktmofun(1000,Parent,LS), + ?line Pid = spawn(F), + ?line Pid2 = spawn(F2), + ?line receive after 100 -> + ok + end, + ?line {ok,L1} = prim_inet:getstatus(LS), + ?line true = lists:member(accepting, L1), + ?line exit(Pid,kill), + ?line receive after 100 -> + ok + end, + ?line {ok,L2} = prim_inet:getstatus(LS), + ?line true = lists:member(accepting, L2), + ?line ok = ?EXPECT_ACCEPTS([{Pid2,{error,timeout}}],1000), + ?line {ok,L3} = prim_inet:getstatus(LS), + ?line false = lists:member(accepting, L3), + ok. + +killing_multi_acceptors2(suite) -> + []; +killing_multi_acceptors2(doc) -> + ["Check that multi acceptors behaves as expected when killed (more)"]; +killing_multi_acceptors2(Config) when is_list(Config) -> + ?line {ok,LS}=gen_tcp:listen(0,[]), + ?line Parent = self(), + ?line {ok,PortNo}=inet:port(LS), + ?line F = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + ?line F2 = mktmofun(1000,Parent,LS), + ?line Pid = spawn(F), + ?line Pid2 = spawn(F), + ?line receive after 100 -> + ok + end, + ?line {ok,L1} = prim_inet:getstatus(LS), + ?line true = lists:member(accepting, L1), + ?line exit(Pid,kill), + ?line receive after 100 -> + ok + end, + ?line {ok,L2} = prim_inet:getstatus(LS), + ?line true = lists:member(accepting, L2), + ?line exit(Pid2,kill), + ?line receive after 100 -> + ok + end, + ?line {ok,L3} = prim_inet:getstatus(LS), + ?line false = lists:member(accepting, L3), + ?line Pid3 = spawn(F2), + ?line receive after 100 -> + ok + end, + ?line {ok,L4} = prim_inet:getstatus(LS), + ?line true = lists:member(accepting, L4), + ?line gen_tcp:connect("localhost",PortNo,[]), + ?line ok = ?EXPECT_ACCEPTS([{Pid3,{ok,Port}}] when is_port(Port),100), + ?line {ok,L5} = prim_inet:getstatus(LS), + ?line false = lists:member(accepting, L5), + ok. + +several_accepts_in_one_go(suite) -> + []; +several_accepts_in_one_go(doc) -> + ["checks that multi-accept works when more than one accept can be " + "done at once (wb test of inet_driver)"]; +several_accepts_in_one_go(Config) when is_list(Config) -> + ?line {ok,LS}=gen_tcp:listen(0,[]), + ?line Parent = self(), + ?line {ok,PortNo}=inet:port(LS), + ?line F1 = fun() -> Parent ! {accepted,self(),gen_tcp:accept(LS)} end, + ?line F2 = fun() -> Parent ! {connected,self(),gen_tcp:connect("localhost",PortNo,[])} end, + ?line spawn(F1), + ?line spawn(F1), + ?line spawn(F1), + ?line spawn(F1), + ?line spawn(F1), + ?line spawn(F1), + ?line spawn(F1), + ?line spawn(F1), + ?line ok = ?EXPECT_ACCEPTS([],500), + ?line spawn(F2), + ?line spawn(F2), + ?line spawn(F2), + ?line spawn(F2), + ?line spawn(F2), + ?line spawn(F2), + ?line spawn(F2), + ?line spawn(F2), + ?line ok = ?EXPECT_ACCEPTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],15000), + ?line ok = ?EXPECT_CONNECTS([{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}},{_,{ok,_}}],1000), + ok. + + +flush(Msgs) -> + erlang:yield(), + receive Msg -> flush([Msg|Msgs]) + after 0 -> lists:reverse(Msgs) + end. + +wait_until_accepting(Proc,0) -> + exit({timeout_waiting_for_accepting,Proc}); +wait_until_accepting(Proc,N) -> + case process_info(Proc,current_function) of + {current_function,{prim_inet,accept0,2}} -> + case process_info(Proc,status) of + {status,waiting} -> + ok; + _O1 -> + receive + after 5 -> + wait_until_accepting(Proc,N-1) + end + end; + _O2 -> + receive + after 5 -> + wait_until_accepting(Proc,N-1) + end + end. + + + +active_once_closed(suite) -> + []; +active_once_closed(doc) -> + ["Check that active once and tcp_close messages behave as expected"]; +active_once_closed(Config) when is_list(Config) -> + (fun() -> + ?line {Loop,A} = setup_closed_ao(), + ?line Loop({{error,closed},{error,econnaborted}}, + fun() -> gen_tcp:send(A,"Hello") end), + ?line ok = inet:setopts(A,[{active,once}]), + ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + ?line {error,einval} = inet:setopts(A,[{active,once}]), + ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + end)(), + (fun() -> + ?line {Loop,A} = setup_closed_ao(), + ?line Loop({{error,closed},{error,econnaborted}}, + fun() -> gen_tcp:send(A,"Hello") end), + ?line ok = inet:setopts(A,[{active,true}]), + ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + ?line {error,einval} = inet:setopts(A,[{active,true}]), + ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + end)(), + (fun() -> + ?line {Loop,A} = setup_closed_ao(), + ?line Loop({{error,closed},{error,econnaborted}}, + fun() -> gen_tcp:send(A,"Hello") end), + ?line ok = inet:setopts(A,[{active,true}]), + ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + ?line {error,einval} = inet:setopts(A,[{active,once}]), + ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + end)(), + (fun() -> + ?line {Loop,A} = setup_closed_ao(), + ?line Loop({{error,closed},{error,econnaborted}}, + fun() -> gen_tcp:send(A,"Hello") end), + ?line ok = inet:setopts(A,[{active,once}]), + ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end, + ?line {error,einval} = inet:setopts(A,[{active,true}]), + ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end + end)(), + (fun() -> + ?line {Loop,A} = setup_closed_ao(), + ?line Loop({{error,closed},{error,econnaborted}}, + fun() -> gen_tcp:send(A,"Hello") end), + ?line ok = inet:setopts(A,[{active,false}]), + ?line ok = receive {tcp_closed, A} -> error after 1000 -> ok end, + ?line ok = inet:setopts(A,[{active,once}]), + ?line ok = receive {tcp_closed, A} -> ok after 1000 -> error end + end)(). + +send_timeout(suite) -> + []; +send_timeout(doc) -> + ["Test the send_timeout socket option"]; +send_timeout(Config) when is_list(Config) -> + %% Basic + BasicFun = + fun(AutoClose) -> + ?line {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), + ?line {error,timeout} = + Loop(fun() -> + Res = gen_tcp:send(A,<<1:10000>>), + %%erlang:display(Res), + Res + end), + %% Check that the socket is not busy/closed... + Error = after_send_timeout(AutoClose), + ?line {error,Error} = gen_tcp:send(A,<<"Hej">>), + ?line test_server:stop_node(RNode) + end, + BasicFun(false), + BasicFun(true), + %% Check timeout length + ?line Self = self(), + ?line Pid = + spawn(fun() -> + {Loop,A,RNode} = setup_timeout_sink(1000, true), + {error,timeout} = + Loop(fun() -> + Res = gen_tcp:send(A,<<1:10000>>), + %%erlang:display(Res), + Self ! Res, + Res + end), + test_server:stop_node(RNode) + end), + ?line Diff = get_max_diff(), + ?line io:format("Max time for send: ~p~n",[Diff]), + ?line true = (Diff > 500) and (Diff < 1500), + %% Let test_server slave die... + ?line Mon = erlang:monitor(process, Pid), + ?line receive {'DOWN',Mon,process,Pid,_} -> ok end, + %% Check that parallell writers do not hang forever + ParaFun = + fun(AutoClose) -> + ?line {Loop,A,RNode} = setup_timeout_sink(1000, AutoClose), + SenderFun = fun() -> + {error,Error} = + Loop(fun() -> + gen_tcp:send(A, <<1:10000>>) + end), + Self ! {error,Error} + end, + ?line spawn_link(SenderFun), + ?line spawn_link(SenderFun), + ?line receive + {error,timeout} -> ok + after 10000 -> + ?line exit(timeout) + end, + NextErr = after_send_timeout(AutoClose), + ?line receive + {error,NextErr} -> ok + after 10000 -> + ?line exit(timeout) + end, + ?line {error,NextErr} = gen_tcp:send(A,<<"Hej">>), + ?line test_server:stop_node(RNode) + end, + ParaFun(false), + ParaFun(true), + ok. + +after_send_timeout(AutoClose) -> + case AutoClose of + true -> enotconn; + false -> timeout + end. + +get_max_diff() -> + receive + ok -> + get_max_diff(0) + after 10000 -> + exit(timeout) + end. + +get_max_diff(Max) -> + T1 = millistamp(), + receive + ok -> + Diff = millistamp() - T1, + if + Diff > Max -> + get_max_diff(Diff); + true -> + get_max_diff(Max) + end; + {error,timeout} -> + Diff = millistamp() - T1, + if + Diff > Max -> + Diff; + true -> + Max + end + after 10000 -> + exit(timeout) + end. + +setup_closed_ao() -> + Dir = filename:dirname(code:which(?MODULE)), + {ok,R} = test_server:start_node(test_default_options_slave,slave, + [{args,"-pa " ++ Dir}]), + Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), + {ok, L} = gen_tcp:listen(0, [{active,false},{packet,2}]), + Fun = fun(F) -> + receive + {From,X} when is_function(X) -> + From ! {self(),X()}, F(F); + die -> ok + end + end, + Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), + {ok, Port} = inet:port(L), + Remote = fun(Fu) -> + Pid ! {self(), Fu}, + receive {Pid,X} -> X + end + end, + {ok, C} = Remote(fun() -> + gen_tcp:connect(Host,Port, + [{active,false},{packet,2}]) + end), + {ok,A} = gen_tcp:accept(L), + gen_tcp:send(A,"Hello"), + {ok, "Hello"} = Remote(fun() -> gen_tcp:recv(C,0) end), + ok = Remote(fun() -> gen_tcp:close(C) end), + Loop2 = fun(_,_,_,0) -> + {failure, timeout}; + (L2,{MA,MB},F2,N) -> + case F2() of + MA -> MA; + MB -> MB; + Other -> io:format("~p~n",[Other]), + receive after 1000 -> ok end, + L2(L2,{MA,MB},F2,N-1) + end + end, + Loop = fun(Match2,F3) -> Loop2(Loop2,Match2,F3,10) end, + test_server:stop_node(R), + {Loop,A}. + +setup_timeout_sink(Timeout, AutoClose) -> + Dir = filename:dirname(code:which(?MODULE)), + {ok,R} = test_server:start_node(test_default_options_slave,slave, + [{args,"-pa " ++ Dir}]), + Host = list_to_atom(lists:nth(2,string:tokens(atom_to_list(node()),"@"))), + {ok, L} = gen_tcp:listen(0, [{active,false},{packet,2}, + {send_timeout,Timeout}, + {send_timeout_close,AutoClose}]), + Fun = fun(F) -> + receive + {From,X} when is_function(X) -> + From ! {self(),X()}, F(F); + die -> ok + end + end, + Pid = rpc:call(R,erlang,spawn,[fun() -> Fun(Fun) end]), + {ok, Port} = inet:port(L), + Remote = fun(Fu) -> + Pid ! {self(), Fu}, + receive {Pid,X} -> X + end + end, + {ok, C} = Remote(fun() -> + gen_tcp:connect(Host,Port, + [{active,false},{packet,2}]) + end), + {ok,A} = gen_tcp:accept(L), + gen_tcp:send(A,"Hello"), + {ok, "Hello"} = Remote(fun() -> gen_tcp:recv(C,0) end), + Loop2 = fun(_,_,0) -> + {failure, timeout}; + (L2,F2,N) -> + Ret = F2(), + io:format("~p~n",[Ret]), + case Ret of + ok -> receive after 1 -> ok end, + L2(L2,F2,N-1); + Other -> Other + end + end, + Loop = fun(F3) -> Loop2(Loop2,F3,1000) end, + {Loop,A,R}. + +millistamp() -> + {Mega, Secs, Micros} = erlang:now(), + (Micros div 1000) + Secs * 1000 + Mega * 1000000000. + +has_superfluous_schedulers() -> + case {erlang:system_info(schedulers), + erlang:system_info(logical_processors)} of + {S, unknown} when S > 1 -> true; + {S, P} when S > P -> true; + _ -> false + end. + + +otp_7731(suite) -> []; +otp_7731(doc) -> + "Leaking message from inet_drv {inet_reply,P,ok} " + "when a socket sending resumes working after a send_timeout"; +otp_7731(Config) when is_list(Config) -> + ?line ServerPid = spawn_link(?MODULE, otp_7731_server, [self()]), + ?line receive {ServerPid, ready, PortNum} -> ok end, + + ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum, + [binary, {active, false}, {packet, raw}, + {send_timeout, 1000}]), + otp_7731_send(Socket), + io:format("Sending complete...\n",[]), + ServerPid ! {self(), recv}, + receive {ServerPid, ok} -> ok end, + + io:format("Client waiting for leaking messages...\n",[]), + + %% Now make sure inet_drv does not leak any internal messages. + receive Msg -> + ?line test_server:fail({unexpected, Msg}) + after 1000 -> + ok + end, + io:format("No leaking messages. Done.\n",[]), + gen_tcp:close(Socket). + +otp_7731_send(Socket) -> + Bin = <<1:10000>>, + io:format("Client sending ~p bytes...\n",[size(Bin)]), + ?line case gen_tcp:send(Socket, Bin) of + ok -> otp_7731_send(Socket); + {error,timeout} -> ok + end. + +otp_7731_server(ClientPid) -> + ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, + {active, false}]), + ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), + ClientPid ! {self(), ready, PortNum}, + + {ok, CSocket} = gen_tcp:accept(LSocket), + gen_tcp:close(LSocket), + + io:format("Server got connection, wait for recv order...\n",[]), + + receive {ClientPid, recv} -> ok end, + + io:format("Server start receiving...\n",[]), + + otp_7731_recv(CSocket), + + ClientPid ! {self(), ok}, + + io:format("Server finished, closing...\n",[]), + gen_tcp:close(CSocket). + + +otp_7731_recv(Socket) -> + ?line case gen_tcp:recv(Socket, 0, 1000) of + {ok, Bin} -> + io:format("Server received ~p bytes\n",[size(Bin)]), + otp_7731_recv(Socket); + {error,timeout} -> + io:format("Server got receive timeout\n",[]), + ok + end. + + +%% OTP-7615: TCP-ports hanging in CLOSING state when sending large +%% buffer followed by a recv() that returns error due to closed +%% connection. +zombie_sockets(suite) -> []; +zombie_sockets(doc) -> ["OTP-7615 Leaking closed ports."]; +zombie_sockets(Config) when is_list(Config) -> + register(zombie_collector,self()), + Calls = 10, + Server = spawn_link(?MODULE, zombie_server,[self(), Calls]), + ?line {Server, ready, PortNum} = receive Msg -> Msg end, + io:format("Ports before = ~p\n",[lists:sort(erlang:ports())]), + zombie_client_loop(Calls, PortNum), + Ports = lists:sort(zombie_collector(Calls,[])), + Server ! terminate, + io:format("Collected ports = ~p\n",[Ports]), + ?line [] = zombies_alive(Ports, 10), + timer:sleep(1000), + ok. + +zombie_client_loop(0, _) -> ok; +zombie_client_loop(N, PortNum) when is_integer(PortNum) -> + ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum, + [binary, {active, false}, {packet, raw}]), + ?line gen_tcp:close(Socket), % to make server recv fail + zombie_client_loop(N-1, PortNum). + + +zombie_collector(0,Acc) -> + Acc; +zombie_collector(N,Acc) -> + receive + {closed, Socket} -> + zombie_collector(N-1,[Socket|Acc]); + E -> + {unexpected, E, Acc} + end. + +zombies_alive(Ports, WaitSec) -> + Alive = lists:sort(erlang:ports()), + io:format("Alive = ~p\n",[Alive]), + Zombies = lists:filter(fun(P) -> lists:member(P, Alive) end, Ports), + case Zombies of + [] -> []; + _ -> + case WaitSec of + 0 -> Zombies; + _ -> timer:sleep(1000), % Wait some more for zombies to die + zombies_alive(Zombies, WaitSec-1) + end + end. + +zombie_server(Pid, Calls) -> + ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, raw}, + {active, false}, {backlog, Calls}]), + ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), + BigBin = list_to_binary(lists:duplicate(100*1024, 77)), + Pid ! {self(), ready, PortNum}, + zombie_accept_loop(LSocket, BigBin, Calls), + ?line terminate = receive Msg -> Msg end. + +zombie_accept_loop(_, _, 0) -> + ok; +zombie_accept_loop(Socket, BigBin, Calls) -> + ?line case gen_tcp:accept(Socket) of + {ok, NewSocket} -> + spawn_link(fun() -> zombie_serve_client(NewSocket, BigBin) end), + zombie_accept_loop(Socket, BigBin, Calls-1); + E -> + E + end. + +zombie_serve_client(Socket, Bin) -> + %%io:format("Got connection on ~p\n",[Socket]), + ?line gen_tcp:send(Socket, Bin), + %%io:format("Sent data, waiting for reply on ~p\n",[Socket]), + ?line case gen_tcp:recv(Socket, 4) of + {error,closed} -> ok; + {error,econnaborted} -> ok % may be returned on Windows + end, + %%io:format("Closing ~p\n",[Socket]), + ?line gen_tcp:close(Socket), + zombie_collector ! {closed, Socket}. + + + +otp_7816(suite) -> []; +otp_7816(doc) -> + "Hanging send on windows when sending iolist with more than 16 binaries."; +otp_7816(Config) when is_list(Config) -> + Client = self(), + ?line Server = spawn_link(fun()-> otp_7816_server(Client) end), + ?line receive {Server, ready, PortNum} -> ok end, + + ?line {ok, Socket} = gen_tcp:connect("localhost", PortNum, + [binary, {active, false}, {packet, 4}, + {send_timeout, 10}]), + %% We use the undocumented feature that sending can be resumed after + %% a send_timeout without any data loss if the peer starts to receive data. + %% Unless of course the 7816-bug is in affect, in which case the write event + %% for the socket is lost on windows and not all data is sent. + + [otp_7816_send(Socket,18,BinSize,Server) || BinSize <- lists:seq(1000, 2000, 123)], + + io:format("Sending complete...\n",[]), + + ?line ok = gen_tcp:close(Socket), + Server ! {self(), closed}, + ?line {Server, closed} = receive M -> M end. + + +otp_7816_send(Socket, BinNr, BinSize, Server) -> + Data = lists:duplicate(BinNr, <<1:(BinSize*8)>>), + SentBytes = otp_7816_send_data(Socket, Data, 0) * BinNr * BinSize, + io:format("Client sent ~p bytes...\n",[SentBytes]), + Server ! {self(),recv,SentBytes}, + ?line {Server, ok} = receive M -> M end. + + + +otp_7816_send_data(Socket, Data, Loops) -> + io:format("Client sending data...\n",[]), + case gen_tcp:send(Socket, Data) of + ok -> + otp_7816_send_data(Socket,Data, Loops+1); + {error,timeout} -> + Loops+1 + end. + + +otp_7816_server(Client) -> + ?line {ok, LSocket} = gen_tcp:listen(0, [binary, {packet, 4}, + {active, false}]), + ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), + Client ! {self(), ready, PortNum}, + + ?line {ok, CSocket} = gen_tcp:accept(LSocket), + io:format("Server got connection...\n",[]), + ?line gen_tcp:close(LSocket), + + otp_7816_server_loop(CSocket), + + io:format("Server terminating.\n",[]). + + +otp_7816_server_loop(CSocket) -> + io:format("Server waiting for order...\n",[]), + + receive + {Client, recv, RecvBytes} -> + io:format("Server start receiving...\n",[]), + + ?line ok = otp_7816_recv(CSocket, RecvBytes), + + Client ! {self(), ok}, + otp_7816_server_loop(CSocket); + + {Client, closed} -> + ?line {error, closed} = gen_tcp:recv(CSocket, 0, 1000), + Client ! {self(), closed} + end. + + +otp_7816_recv(_, 0) -> + io:format("Server got all.\n",[]), + ok; +otp_7816_recv(CSocket, BytesLeft) -> + ?line case gen_tcp:recv(CSocket, 0, 1000) of + {ok, Bin} when byte_size(Bin) =< BytesLeft -> + io:format("Server received ~p of ~p bytes.\n",[size(Bin), BytesLeft]), + otp_7816_recv(CSocket, BytesLeft - byte_size(Bin)); + {error,timeout} -> + io:format("Server got receive timeout when expecting more data\n",[]), + error + end. + +otp_8102(doc) -> ["Receive a packet with a faulty packet header"]; +otp_8102(suite) -> []; +otp_8102(Config) when is_list(Config) -> + ?line {ok, LSocket} = gen_tcp:listen(0, []), + ?line {ok, {_, PortNum}} = inet:sockname(LSocket), + io:format("Listening on ~w with port number ~p\n", [LSocket, PortNum]), + + [otp_8102_do(LSocket, PortNum, otp_8102_packet(Type,Size)) + || Size <- lists:seq(-10,-1), + Type <- [4, {cdr,big}, {cdr,little}]], + + gen_tcp:close(LSocket), + ok. + +otp_8102_packet(4, Size) -> + {<<Size:32/big>>, 4}; +otp_8102_packet({cdr,big}, Size) -> + {<<"GIOP",0,0,0,0,Size:32/big>>, cdr}; +otp_8102_packet({cdr,little}, Size) -> + {<<"GIOP",0,0,1,0,Size:32/little>>, cdr}. + +otp_8102_do(LSocket, PortNum, {Bin,PType}) -> + + io:format("Connect with packet option ~p ...\n",[PType]), + ?line {ok, RSocket} = gen_tcp:connect("localhost", PortNum, [binary, + {packet,PType}, + {active,true}]), + ?line {ok, SSocket} = gen_tcp:accept(LSocket), + + io:format("Got connection, sending ~p...\n",[Bin]), + + ?line ok = gen_tcp:send(SSocket, Bin), + + io:format("Sending complete...\n",[]), + + ?line {tcp_error,RSocket,emsgsize} = receive M -> M end, + + io:format("Got error msg, ok.\n",[]), + gen_tcp:close(SSocket), + gen_tcp:close(RSocket). + diff --git a/lib/kernel/test/gen_udp_SUITE.erl b/lib/kernel/test/gen_udp_SUITE.erl new file mode 100644 index 0000000000..bd5685952e --- /dev/null +++ b/lib/kernel/test/gen_udp_SUITE.erl @@ -0,0 +1,410 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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 the behavior of gen_udp. Testing udp is really a very unfunny task, +% because udp is not deterministic. +% +-module(gen_udp_SUITE). +-include("test_server.hrl"). + + +-define(default_timeout, ?t:minutes(1)). + +% XXX - we should pick a port that we _know_ is closed. That's pretty hard. +-define(CLOSED_PORT, 6666). + +-export([all/1]). +-export([init_per_testcase/2, fin_per_testcase/2]). + +-export([send_to_closed/1, + buffer_size/1, binary_passive_recv/1, bad_address/1, + read_packets/1, open_fd/1]). + +all(suite) -> + [send_to_closed, + buffer_size, binary_passive_recv, bad_address, read_packets, + open_fd]. + +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +%%------------------------------------------------------------- +%% Send two packets to a closed port (on some systems this causes the socket +%% to be closed). + +send_to_closed(doc) -> + ["Tests core functionality."]; +send_to_closed(suite) -> + []; +send_to_closed(Config) when is_list(Config) -> + ?line {ok, Sock} = gen_udp:open(0), + ?line ok = gen_udp:send(Sock, {127,0,0,1}, ?CLOSED_PORT, "foo"), + timer:sleep(2), + ?line ok = gen_udp:send(Sock, {127,0,0,1}, ?CLOSED_PORT, "foo"), + ?line ok = gen_udp:close(Sock), + ok. + + + +%%------------------------------------------------------------- +%% Test that the UDP socket buffer sizes are settable + +buffer_size(suite) -> + []; +buffer_size(doc) -> + ["Test UDP buffer size setting."]; +buffer_size(Config) when is_list(Config) -> + ?line Len = 256, + ?line Bin = list_to_binary(lists:seq(0, Len-1)), + ?line M = 8192 div Len, + ?line Spec0 = + [{opt,M},{safe,M-1},{long,M+1}, + {opt,2*M},{safe,2*M-1},{long,2*M+1}, + {opt,4*M},{safe,4*M-1},{long,4*M+1}], + ?line Spec = + [case Tag of + opt -> + [{recbuf,Val*Len},{sndbuf,(Val + 2)*Len}]; + safe -> + {list_to_binary(lists:duplicate(Val, Bin)), + [correct]}; + long -> + {list_to_binary(lists:duplicate(Val, Bin)), + [truncated,emsgsize,timeout]} + end || {Tag,Val} <- Spec0], + %% + ?line {ok, ClientSocket} = gen_udp:open(0, [binary]), + ?line {ok, ClientPort} = inet:port(ClientSocket), + ?line Client = self(), + ?line ClientIP = {127,0,0,1}, + ?line ServerIP = {127,0,0,1}, + ?line Server = + spawn_link( + fun () -> + {ok, ServerSocket} = gen_udp:open(0, [binary]), + {ok, ServerPort} = inet:port(ServerSocket), + Client ! {self(),port,ServerPort}, + buffer_size_server(Client, ClientIP, ClientPort, + ServerSocket, 1, Spec), + ok = gen_udp:close(ServerSocket) + end), + ?line Mref = erlang:monitor(process, Server), + ?line receive + {Server,port,ServerPort} -> + ?line buffer_size_client(Server, ServerIP, ServerPort, + ClientSocket, 1, Spec) + end, + ?line ok = gen_udp:close(ClientSocket), + ?line receive + {'DOWN',Mref,_,_,normal} -> + ?line ok + end. + +buffer_size_client(_, _, _, _, _, []) -> + ?line ok; +buffer_size_client(Server, IP, Port, + Socket, Cnt, [Opts|T]) when is_list(Opts) -> + ?line ok = inet:setopts(Socket, Opts), + ?line Server ! {self(),setopts,Cnt}, + ?line receive {Server,setopts,Cnt} -> ok end, + ?line buffer_size_client(Server, IP, Port, Socket, Cnt+1, T); +buffer_size_client(Server, IP, Port, + Socket, Cnt, [{B,Replies}|T]) when is_binary(B) -> + ?line ok = gen_udp:send(Socket, IP, Port, B), + ?line receive + {Server,Cnt,Reply} -> + ?line case lists:member(Reply, Replies) of + true -> ok; + false -> + ?line + ?t:fail({reply_mismatch,Cnt,Reply,Replies, + byte_size(B), + inet:getopts(Socket, + [sndbuf,recbuf])}) + end + end, + ?line buffer_size_client(Server, IP, Port, Socket, Cnt+1, T). + +buffer_size_server(_, _, _, _, _, []) -> + ok; +buffer_size_server(Client, IP, Port, + Socket, Cnt, [Opts|T]) when is_list(Opts) -> + receive {Client,setopts,Cnt} -> ok end, + ok = inet:setopts(Socket, Opts), + Client ! {self(),setopts,Cnt}, + buffer_size_server(Client, IP, Port, Socket, Cnt+1, T); +buffer_size_server(Client, IP, Port, + Socket, Cnt, [{B,_}|T]) when is_binary(B) -> + Client ! + {self(),Cnt, + receive + {udp,Socket,IP,Port,D} when is_binary(D) -> + SizeD = byte_size(D), + case B of + D -> correct; + <<D:SizeD/binary,_/binary>> -> truncated + end; + {udp_error,Socket,Error} -> Error + after 5000 -> timeout + end}, + buffer_size_server(Client, IP, Port, Socket, Cnt+1, T). + + + +%%------------------------------------------------------------- +%% OTP-3823 gen_udp:recv does not return address in binary mode +%% + +binary_passive_recv(suite) -> + []; +binary_passive_recv(doc) -> + ["OTP-3823 gen_udp:recv does not return address in binary mode"]; +binary_passive_recv(Config) when is_list(Config) -> + ?line D = "The quick brown fox jumps over a lazy dog", + ?line B = list_to_binary(D), + ?line {ok, R} = gen_udp:open(0, [binary, {active, false}]), + ?line {ok, RP} = inet:port(R), + ?line {ok, S} = gen_udp:open(0), + ?line {ok, SP} = inet:port(S), + ?line ok = gen_udp:send(S, localhost, RP, D), + ?line {ok, {{127, 0, 0, 1}, SP, B}} = gen_udp:recv(R, byte_size(B)+1), + ?line ok = gen_udp:close(S), + ?line ok = gen_udp:close(R), + ok. + + +%%------------------------------------------------------------- +%% OTP-3836 inet_udp crashes when IP-address is larger than 255. + +bad_address(suite) -> + []; +bad_address(doc) -> + ["OTP-3836 inet_udp crashes when IP-address is larger than 255."]; +bad_address(Config) when is_list(Config) -> + ?line {ok, R} = gen_udp:open(0), + ?line {ok, RP} = inet:port(R), + ?line {ok, S} = gen_udp:open(0), + ?line {ok, _SP} = inet:port(S), + ?line {'EXIT', badarg} = + (catch gen_udp:send(S, {127,0,0,1,0}, RP, "void")), + ?line {'EXIT', badarg} = + (catch gen_udp:send(S, {127,0,0,256}, RP, "void")), + ?line ok = gen_udp:close(S), + ?line ok = gen_udp:close(R), + ok. + + +%%------------------------------------------------------------- +%% OTP-6249 UDP option for number of packet reads +%% +%% Starts a slave node that on command sends a bunch of messages +%% to our UDP port. The receiving process just receives and +%% ignores the incoming messages, but counts them. +%% A tracing process traces the receiving process for +%% 'receive' and scheduling events. From the trace, +%% message contents is verified; and, how many messages +%% are received per in/out scheduling, which should be +%% the same as the read_packets parameter. +%% +%% What happens on the SMP emulator remains to be seen... +%% + +read_packets(doc) -> + ["OTP-6249 UDP option for number of packet reads."]; +read_packets(Config) when is_list(Config) -> + case erlang:system_info(smp_support) of + false -> + read_packets_1(); + true -> + %% We would need some new sort of tracing to test this + %% option reliably in an SMP emulator. + {skip,"SMP emulator"} + end. + +read_packets_1() -> + ?line N1 = 5, + ?line N2 = 7, + ?line {ok,R} = gen_udp:open(0, [{read_packets,N1}]), + ?line {ok,RP} = inet:port(R), + ?line {ok,Node} = start_node(gen_udp_SUITE_read_packets), + ?line Die = make_ref(), + ?line Loop = erlang:spawn_link(fun () -> infinite_loop(Die) end), + %% + ?line Msgs1 = [erlang:integer_to_list(M) || M <- lists:seq(1, N1*3)], + ?line [V1|_] = read_packets_test(R, RP, Msgs1, Node), + ?line {ok,[{read_packets,N1}]} = inet:getopts(R, [read_packets]), + %% + ?line ok = inet:setopts(R, [{read_packets,N2}]), + ?line Msgs2 = [erlang:integer_to_list(M) || M <- lists:seq(1, N2*3)], + ?line [V2|_] = read_packets_test(R, RP, Msgs2, Node), + ?line {ok,[{read_packets,N2}]} = inet:getopts(R, [read_packets]), + %% + ?line stop_node(Node), + ?line Mref = erlang:monitor(process, Loop), + ?line Loop ! Die, + ?line receive + {'DOWN',Mref,_,_, normal} -> + case {V1,V2} of + {N1,N2} -> + ok; + _ when V1 =/= N1, V2 =/= N2 -> + ok + end + end. + +infinite_loop(Die) -> + receive + Die -> + ok + after + 0 -> + infinite_loop(Die) + end. + +read_packets_test(R, RP, Msgs, Node) -> + Len = length(Msgs), + Receiver = self(), + Tracer = + spawn_link( + fun () -> + receive + {Receiver,get_trace} -> + Receiver ! {self(),{trace,flush()}} + end + end), + Sender = + spawn_opt( + Node, + fun () -> + {ok,S} = gen_udp:open(0), + {ok,SP} = inet:port(S), + Receiver ! {self(),{port,SP}}, + receive + {Receiver,go} -> + read_packets_send(S, RP, Msgs) + end + end, + [link,{priority,high}]), + receive + {Sender,{port,SP}} -> + erlang:trace(self(), true, + [running,'receive',{tracer,Tracer}]), + erlang:yield(), + Sender ! {Receiver,go}, + read_packets_recv(Len), + erlang:trace(self(), false, [all]), + Tracer ! {Receiver,get_trace}, + receive + {Tracer,{trace,Trace}} -> + read_packets_verify(R, SP, Msgs, Trace) + end + end. + +read_packets_send(S, RP, [Msg|Msgs]) -> + ok = gen_udp:send(S, localhost, RP, Msg), + read_packets_send(S, RP, Msgs); +read_packets_send(_S, _RP, []) -> + ok. + +read_packets_recv(0) -> + ok; +read_packets_recv(N) -> + receive + _ -> + read_packets_recv(N - 1) + after 5000 -> + timeout + end. + +read_packets_verify(R, SP, Msg, Trace) -> + lists:reverse( + lists:sort(read_packets_verify(R, SP, Msg, Trace, 0))). + +read_packets_verify(R, SP, Msgs, [{trace,Self,OutIn,_}|Trace], M) + when Self =:= self(), OutIn =:= out; + Self =:= self(), OutIn =:= in -> + push(M, read_packets_verify(R, SP, Msgs, Trace, 0)); +read_packets_verify(R, SP, [Msg|Msgs], + [{trace,Self,'receive',{udp,R,{127,0,0,1},SP,Msg}} + |Trace], M) + when Self =:= self() -> + read_packets_verify(R, SP, Msgs, Trace, M+1); +read_packets_verify(_R, _SP, [], [], M) -> + push(M, []); +read_packets_verify(_R, _SP, Msgs, Trace, M) -> + ?t:fail({read_packets_verify,mismatch,Msgs,Trace,M}). + +push(0, Vs) -> + Vs; +push(V, Vs) -> + [V|Vs]. + +flush() -> + receive + X -> + [X|flush()] + after 200 -> + [] + end. + + + +open_fd(suite) -> + []; +open_fd(doc) -> + ["Test that the 'fd' option works"]; +open_fd(Config) when is_list(Config) -> + Msg = "Det g�r ont n�r knoppar brista. Varf�r skulle annars v�ren tveka?", + Addr = {127,0,0,1}, + {ok,S1} = gen_udp:open(0), + {ok,P2} = inet:port(S1), + {ok,FD} = prim_inet:getfd(S1), + {ok,S2} = gen_udp:open(P2, [{fd,FD}]), + {ok,S3} = gen_udp:open(0), + {ok,P3} = inet:port(S3), + ok = gen_udp:send(S3, Addr, P2, Msg), + receive + {udp,S2,Addr,P3,Msg} -> + ok = gen_udp:send(S2,Addr,P3,Msg), + receive + {udp,S3,Addr,P2,Msg} -> + ok + after 1000 -> + ?t:fail(io_lib:format("~w", [flush()])) + end + after 1000 -> + ?t:fail(io_lib:format("~w", [flush()])) + end. + + +% +% Utils +% +start_node(Name) -> + Pa = filename:dirname(code:which(?MODULE)), + ?t:start_node(Name, slave, [{args, "-pa " ++ Pa}]). + +stop_node(Node) -> + ?t:stop_node(Node). diff --git a/lib/kernel/test/global_SUITE.erl b/lib/kernel/test/global_SUITE.erl new file mode 100644 index 0000000000..a8c68985e2 --- /dev/null +++ b/lib/kernel/test/global_SUITE.erl @@ -0,0 +1,4395 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. 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(global_SUITE). + +-compile(r11). % some code is run from r11-nodes + +%-define(line_trace, 1). + +-export([all/1, + names/1, names_hidden/1, locks/1, locks_hidden/1, + bad_input/1, names_and_locks/1, lock_die/1, name_die/1, + basic_partition/1, basic_name_partition/1, + advanced_partition/1, stress_partition/1, + ring/1, simple_ring/1, line/1, simple_line/1, + global_lost_nodes/1, otp_1849/1, + otp_3162/1, otp_5640/1, otp_5737/1, + otp_6931/1, + simple_disconnect/1, + simple_resolve/1, simple_resolve2/1, simple_resolve3/1, + leftover_name/1, re_register_name/1, name_exit/1, external_nodes/1, + many_nodes/1, sync_0/1, + global_groups_change/1, + register_1/1, + both_known_1/1, + lost_unregister/1, + mass_death/1, + garbage_messages/1]). + +-export([global_load/3, lock_global/2, lock_global2/2]). + +-export([ttt/1]). +-export([mass_spawn/1]). + +-export([start_tracer/0, stop_tracer/0, get_trace/0]). + +-compile(export_all). + +-include("test_server.hrl"). + +-define(NODES, [node()|nodes()]). + +-define(UNTIL(Seq), loop_until_true(fun() -> Seq end, Config)). + +%% The resource used by the global module. +-define(GLOBAL_LOCK, global). + +ttt(suite) -> + [ +%% 5&6: succeeds +%% 4&5&6: succeeds +%% 3&4&5&6: succeeds +%% 1&2&3&6: fails +%% 1&2&6: succeeds +%% 3&6: succeeds + names, names_hidden, locks, locks_hidden, + bad_input, + names_and_locks, lock_die, name_die, basic_partition, +% advanced_partition, basic_name_partition, +% stress_partition, simple_ring, simple_line, + ring]. + +all(suite) -> + case init:get_argument(ring_line) of + {ok, _} -> + [ring_line]; + _ -> + [names, names_hidden, locks, locks_hidden, + bad_input, + names_and_locks, lock_die, name_die, basic_partition, + advanced_partition, basic_name_partition, + stress_partition, simple_ring, simple_line, + ring, line, global_lost_nodes, otp_1849, + otp_3162, otp_5640, otp_5737, otp_6931, + simple_disconnect, simple_resolve, simple_resolve2, + simple_resolve3, + leftover_name, re_register_name, name_exit, + external_nodes, many_nodes, sync_0, global_groups_change, + register_1, both_known_1, lost_unregister, + mass_death, garbage_messages] + end. + +-define(TESTCASE, testcase_name). +-define(testcase, ?config(?TESTCASE, Config)). +-define(nodes_tag, '$global_nodes'). +-define(registered, ?config(registered, Config)). + +init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> + ok = gen_server:call(global_name_server, high_level_trace_start,infinity), + [{?TESTCASE, Case}, {registered, registered()} | Config]. + +fin_per_testcase(_Case, Config) -> + ?line write_high_level_trace(Config), + ?line _ = + gen_server:call(global_name_server, high_level_trace_stop, infinity), + ?line[global:unregister_name(N) || N <- global:registered_names(), + N =/= test_server], + ?line InitRegistered = ?registered, + ?line Registered = registered(), + ?line [io:format("~s local names: ~p~n", [What, N]) || + {What, N} <- [{"Added", Registered -- InitRegistered}, + {"Removed", InitRegistered -- Registered}], + N =/= []], + ok. + +%%% General comments: +%%% One source of problems with failing tests can be that the nodes from the +%%% previous test haven't died yet. +%%% So, when stressing a particular test by running it in a loop, it may +%%% fail already when starting the help nodes, even if the nodes have been +%%% monitored and the nodedowns picked up at the previous round. Waiting +%%% a few seconds between rounds seems to solve the problem. Possibly the +%%% timeout of 7 seconds for connections can also be a problem. This problem +%%% is the same with old (vsn 3) and new global (vsn 4). + + +%%% Test that register_name/2 registers the name on all nodes, even if +%%% a new node appears in the middle of the operation (OTP-3552). +%%% +%%% Test scenario: process p2 is spawned, locks global, starts a slave node, +%%% and tells the parent to do register_name. Then p2 sleeps for five seconds +%%% and releases the lock. Now the name should exist on both our own node +%%% and on the slave node (we wait until that is true; it seems that we +%%% can do rpc calls to another node before the connection is really up). +register_1(suite) -> []; +register_1(Config) when is_list(Config) -> + Timeout = 15, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + P = spawn_link(?MODULE, lock_global, [self(), Config]), + receive + {P, ok} -> + io:format("p1: received ok~n"), + ok + end, + P ! step2, + io:format("p1: sent step2~n"), + ?line yes = global:register_name(foo, self()), + io:format("p1: registered~n"), + P ! step3, + receive + {P, I, I2} -> + ok + end, + if + I =:= I2 -> + ok; + true -> + test_server:fail({notsync, I, I2}) + end, + ?line _ = global:unregister_name(foo), + write_high_level_trace(Config), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +lock_global(Parent, Config) -> + Id = {global, self()}, + io:format("p2: setting lock~n"), + global:set_lock(Id, [node()]), + Parent ! {self(), ok}, + io:format("p2: sent ok~n"), + receive + step2 -> + io:format("p2: received step2"), + ok + end, + io:format("p2: starting slave~n"), + {ok, Host} = inet:gethostname(), + {ok, N1} = slave:start(Host, node1), + io:format("p2: deleting lock~n"), + global:del_lock(Id, [node()]), + io:format("p2: deleted lock~n"), + receive + step3 -> + ok + end, + io:format("p2: received step3~n"), + I = global:whereis_name(foo), + io:format("p2: name ~p~n", [I]), + ?line ?UNTIL(I =:= rpc:call(N1, global, whereis_name, [foo])), + I2 = I, + slave:stop(N1), + io:format("p2: name2 ~p~n", [I2]), + Parent ! {self(), I, I2}, + ok. + +%%% Test for the OTP-3576 problem: if nodes 1 and 2 are separated and +%%% brought together again, while keeping connection with 3, it could +%%% happen that if someone temporarily held the 'global' lock, +%%% 'try_again_locker' would be called, and this time cause both 1 and 2 +%%% to obtain a lock for 'global' on node 3, which would keep the +%%% name registry from ever becoming consistent again. +both_known_1(suite) -> []; +both_known_1(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + + ?line OrigNames = global:registered_names(), + + ?line [Cp1, Cp2, Cp3] = start_nodes([cp1, cp2, cp3], slave, Config), + + ?line wait_for_ready_net(Config), + + ?line rpc_disconnect_node(Cp1, Cp2, Config), + + ?line {_Pid1, yes} = rpc:call(Cp1, ?MODULE, start_proc, [p1]), + ?line {_Pid2, yes} = rpc:call(Cp2, ?MODULE, start_proc, [p2]), + + ?line Names10 = rpc:call(Cp1, global, registered_names, []), + ?line Names20 = rpc:call(Cp2, global, registered_names, []), + ?line Names30 = rpc:call(Cp3, global, registered_names, []), + + Names1 = Names10 -- OrigNames, + Names2 = Names20 -- OrigNames, + Names3 = Names30 -- OrigNames, + + ?line [p1] = lists:sort(Names1), + ?line [p2] = lists:sort(Names2), + ?line [p1, p2] = lists:sort(Names3), + + ?line Locker = spawn(Cp3, ?MODULE, lock_global2, [{global, l3}, + self()]), + + ?line receive + {locked, S} -> + true = S + end, + + ?line pong = rpc:call(Cp1, net_adm, ping, [Cp2]), + + %% Bring cp1 and cp2 together, while someone has locked global. + %% They will now loop in 'loop_locker'. + + ?line Names10_2 = rpc:call(Cp1, global, registered_names, []), + ?line Names20_2 = rpc:call(Cp2, global, registered_names, []), + ?line Names30_2 = rpc:call(Cp3, global, registered_names, []), + + Names1_2 = Names10_2 -- OrigNames, + Names2_2 = Names20_2 -- OrigNames, + Names3_2 = Names30_2 -- OrigNames, + + ?line [p1] = lists:sort(Names1_2), + ?line [p2] = lists:sort(Names2_2), + ?line [p1, p2] = lists:sort(Names3_2), + + %% Let go of the lock, and expect the lockers to resolve the name + %% registry. + Locker ! {ok, self()}, + + ?line + ?UNTIL(begin + ?line Names10_3 = rpc:call(Cp1, global, registered_names, []), + ?line Names20_3 = rpc:call(Cp2, global, registered_names, []), + ?line Names30_3 = rpc:call(Cp3, global, registered_names, []), + + Names1_3 = Names10_3 -- OrigNames, + Names2_3 = Names20_3 -- OrigNames, + Names3_3 = Names30_3 -- OrigNames, + + N1 = lists:sort(Names1_3), + N2 = lists:sort(Names2_3), + N3 = lists:sort(Names3_3), + (N1 =:= [p1, p2]) and (N2 =:= [p1, p2]) and (N3 =:= [p1, p2]) + end), + + write_high_level_trace(Config), + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +lost_unregister(suite) -> []; +lost_unregister(doc) -> + ["OTP-6428. An unregistered name reappears."]; +lost_unregister(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + + ?line {ok, B} = start_node(b, Config), + ?line {ok, C} = start_node(c, Config), + Nodes = [node(), B, C], + + ?line wait_for_ready_net(Config), + + % start a proc and register it + ?line {Pid, yes} = start_proc(test), + + ?line ?UNTIL(Pid =:= global:whereis_name(test)), + ?line check_everywhere(Nodes, test, Config), + + ?line rpc_disconnect_node(B, C, Config), + ?line check_everywhere(Nodes, test, Config), + ?line _ = rpc:call(B, global, unregister_name, [test]), + ?line ?UNTIL(undefined =:= global:whereis_name(test)), + ?line Pid = rpc:call(C, global, whereis_name, [test]), + ?line check_everywhere(Nodes--[C], test, Config), + ?line pong = rpc:call(B, net_adm, ping, [C]), + + %% Now the name has reappeared on node B. + ?line ?UNTIL(Pid =:= global:whereis_name(test)), + ?line check_everywhere(Nodes, test, Config), + + exit_p(Pid), + + ?line ?UNTIL(undefined =:= global:whereis_name(test)), + ?line check_everywhere(Nodes, test, Config), + + write_high_level_trace(Config), + stop_node(B), + stop_node(C), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +-define(UNTIL_LOOP, 300). + +-define(end_tag, 'end at'). + +init_high_level_trace(Time) -> + Mul = try + test_server:timetrap_scale_factor() + catch _:_ -> 1 + end, + put(?end_tag, msec() + Time * Mul * 1000), + %% Assures that started nodes start the high level trace automatically. + ok = gen_server:call(global_name_server, high_level_trace_start,infinity), + os:putenv("GLOBAL_HIGH_LEVEL_TRACE", "TRUE"), + put(?nodes_tag, []). + +loop_until_true(Fun, Config) -> + case Fun() of + true -> + true; + _ -> + case get(?end_tag) of + undefined -> + timer:sleep(?UNTIL_LOOP), + loop_until_true(Fun, Config); + EndAt -> + Left = EndAt - msec(), + case Left < 6000 of + true -> + write_high_level_trace(Config), + Ref = make_ref(), + receive Ref -> ok end; + false -> + timer:sleep(?UNTIL_LOOP), + loop_until_true(Fun, Config) + end + end + end. + +write_high_level_trace(Config) -> + case erase(?nodes_tag) of + undefined -> + ok; + Nodes0 -> + Nodes = lists:usort([node() | Nodes0]), + write_high_level_trace(Nodes, Config) + end. + +write_high_level_trace(Nodes, Config) -> + When = now(), + %% 'info' returns more than the trace, which is nice. + Data = [{Node, {info, rpc:call(Node, global, info, [])}} || + Node <- Nodes], + Dir = ?config(priv_dir, Config), + DataFile = filename:join([Dir, lists:concat(["global_", ?testcase])]), + file:write_file(DataFile, term_to_binary({high_level_trace, When, Data})). + +lock_global2(Id, Parent) -> + S = global:set_lock(Id), + Parent ! {locked, S}, + receive + {ok, Parent} -> + ok + end. + +%%----------------------------------------------------------------- +%% Test suite for global names and locks. +%% Should be started in a CC view with: +%% erl -sname XXX -rsh ctrsh where XX not in [cp1, cp2, cp3] +%%----------------------------------------------------------------- + +%cp1 - cp3 are started, and the name 'test' registered for a process on +%test_server. Then it is checked that the name is registered on all +%nodes, using whereis_name and safe_whereis_name. Check that the same +%name can't be registered with another value. Exit the registered +%process and check that the name disappears. Register a new process +%(Pid2) under the name 'test'. Let another new process (Pid3) +%reregister itself under the same name. Test global:send/2. Test +%unregister. Kill Pid3. Start a process (Pid6) on cp3, +%register it as 'test', stop cp1 - cp3 and check that 'test' disappeared. +%Kill Pid2 and check that 'test' isn't registered. + +names(suite) -> []; +names(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line {ok, Cp1} = start_node(cp1, Config), + ?line {ok, Cp2} = start_node(cp2, Config), + ?line {ok, Cp3} = start_node(cp3, Config), + + ?line wait_for_ready_net(Config), + + % start a proc and register it + ?line {Pid, yes} = start_proc(test), + + % test that it is registered at all nodes + ?line + ?UNTIL(begin + (Pid =:= global:safe_whereis_name(test)) and + (Pid =:= rpc:call(Cp1, global, safe_whereis_name, [test])) and + (Pid =:= rpc:call(Cp2, global, safe_whereis_name, [test])) and + (Pid =:= rpc:call(Cp3, global, safe_whereis_name, [test])) and + (Pid =:= global:whereis_name(test)) and + (Pid =:= rpc:call(Cp1, global, whereis_name, [test])) and + (Pid =:= rpc:call(Cp2, global, whereis_name, [test])) and + (Pid =:= rpc:call(Cp3, global, whereis_name, [test])) and + ([test] =:= global:registered_names() -- OrigNames) + end), + + % try to register the same name + ?line no = global:register_name(test, self()), + ?line no = rpc:call(Cp1, global, register_name, [test, self()]), + + % let process exit, check that it is unregistered automatically + exit_p(Pid), + + ?line + ?UNTIL((undefined =:= global:whereis_name(test)) and + (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and + (undefined =:= rpc:call(Cp2, global, whereis_name, [test])) and + (undefined =:= rpc:call(Cp3, global, whereis_name, [test]))), + + % test re_register + ?line {Pid2, yes} = start_proc(test), + ?line ?UNTIL(Pid2 =:= rpc:call(Cp3, global, whereis_name, [test])), + Pid3 = rpc:call(Cp3, ?MODULE, start_proc2, [test]), + ?line ?UNTIL(Pid3 =:= rpc:call(Cp3, global, whereis_name, [test])), + Pid3 = global:whereis_name(test), + + % test sending + global:send(test, {ping, self()}), + receive + {pong, Cp3} -> ok + after + 2000 -> test_server:fail(timeout1) + end, + + rpc:call(Cp1, global, send, [test, {ping, self()}]), + receive + {pong, Cp3} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + + ?line _ = global:unregister_name(test), + ?line + ?UNTIL((undefined =:= global:whereis_name(test)) and + (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and + (undefined =:= rpc:call(Cp2, global, whereis_name, [test])) and + (undefined =:= rpc:call(Cp3, global, whereis_name, [test]))), + + exit_p(Pid3), + + ?line ?UNTIL(undefined =:= global:whereis_name(test)), + + % register a proc + ?line {_Pid6, yes} = rpc:call(Cp3, ?MODULE, start_proc, [test]), + + write_high_level_trace(Config), + % stop the nodes, and make sure names are released. + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + + ?line ?UNTIL(undefined =:= global:whereis_name(test)), + exit_p(Pid2), + + ?line ?UNTIL(undefined =:= global:whereis_name(test)), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +names_hidden(suite) -> []; +names_hidden(doc) -> + ["Tests that names on a hidden node doesn't interfere with names on " + "visible nodes."]; +names_hidden(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + ?line OrigNodes = nodes(), + + ?line {ok, Cp1} = start_node(cp1, Config), + ?line {ok, Cp2} = start_node(cp2, Config), + ?line {ok, Cp3} = start_hidden_node(cp3, Config), + ?line pong = rpc:call(Cp1, net_adm, ping, [Cp3]), + ?line pong = rpc:call(Cp3, net_adm, ping, [Cp2]), + ?line pong = rpc:call(Cp3, net_adm, ping, [node()]), + + ?line [] = [Cp1, Cp2 | OrigNodes] -- nodes(), + + % start a proc on hidden node and register it + ?line {HPid, yes} = rpc:call(Cp3, ?MODULE, start_proc, [test]), + ?line Cp3 = node(HPid), + + % Check that it didn't get registered on visible nodes + ?line + ?UNTIL((undefined =:= global:safe_whereis_name(test)) and + (undefined =:= rpc:call(Cp1, global, safe_whereis_name, [test])) and + (undefined =:= rpc:call(Cp2, global, safe_whereis_name, [test])) and + (undefined =:= global:whereis_name(test)) and + (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and + (undefined =:= rpc:call(Cp2, global, whereis_name, [test]))), + + % start a proc on visible node and register it + ?line {Pid, yes} = start_proc(test), + ?line true = (Pid =/= HPid), + + % test that it is registered at all nodes + ?line + ?UNTIL((Pid =:= global:safe_whereis_name(test)) and + (Pid =:= rpc:call(Cp1, global, safe_whereis_name, [test])) and + (Pid =:= rpc:call(Cp2, global, safe_whereis_name, [test])) and + (HPid =:= rpc:call(Cp3, global, safe_whereis_name, [test])) and + (Pid =:= global:whereis_name(test)) and + (Pid =:= rpc:call(Cp1, global, whereis_name, [test])) and + (Pid =:= rpc:call(Cp2, global, whereis_name, [test])) and + (HPid =:= rpc:call(Cp3, global, whereis_name, [test])) and + ([test] =:= global:registered_names() -- OrigNames)), + + % try to register the same name + ?line no = global:register_name(test, self()), + ?line no = rpc:call(Cp1, global, register_name, [test, self()]), + + % let process exit, check that it is unregistered automatically + exit_p(Pid), + + ?line + ?UNTIL((undefined =:= global:whereis_name(test)) and + (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and + (undefined =:= rpc:call(Cp2, global, whereis_name, [test])) and + (HPid =:= rpc:call(Cp3, global, whereis_name, [test]))), + + % test re_register + ?line {Pid2, yes} = start_proc(test), + ?line ?UNTIL(Pid2 =:= rpc:call(Cp2, global, whereis_name, [test])), + Pid3 = rpc:call(Cp2, ?MODULE, start_proc2, [test]), + ?line ?UNTIL(Pid3 =:= rpc:call(Cp2, global, whereis_name, [test])), + ?line Pid3 = global:whereis_name(test), + + % test sending + ?line Pid3 = global:send(test, {ping, self()}), + receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout1) + end, + + rpc:call(Cp1, global, send, [test, {ping, self()}]), + receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + + ?line _ = rpc:call(Cp3, global, unregister_name, [test]), + ?line + ?UNTIL((Pid3 =:= global:whereis_name(test)) and + (Pid3 =:= rpc:call(Cp1, global, whereis_name, [test])) and + (Pid3 =:= rpc:call(Cp2, global, whereis_name, [test])) and + (undefined =:= rpc:call(Cp3, global, whereis_name, [test]))), + + ?line _ = global:unregister_name(test), + ?line + ?UNTIL((undefined =:= global:whereis_name(test)) and + (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and + (undefined =:= rpc:call(Cp2, global, whereis_name, [test])) and + (undefined =:= rpc:call(Cp3, global, whereis_name, [test]))), + + exit_p(Pid3), + exit_p(HPid), + + ?line ?UNTIL(undefined =:= global:whereis_name(test)), + + write_high_level_trace(Config), + % stop the nodes, and make sure names are released. + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +locks(suite) -> []; +locks(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line {ok, Cp1} = start_node(cp1, Config), + ?line {ok, Cp2} = start_node(cp2, Config), + ?line {ok, Cp3} = start_node(cp3, Config), + + ?line wait_for_ready_net(Config), + + % start two procs + ?line Pid = start_proc(), + ?line Pid2 = rpc:call(Cp1, ?MODULE, start_proc, []), + % set a lock, and make sure noone else can set the same lock + ?line true = global:set_lock({test_lock, self()}, ?NODES, 1), + ?line false = req(Pid, {set_lock, test_lock, self()}), + ?line false = req(Pid2, {set_lock, test_lock, self()}), + % delete, and let another proc set the lock + global:del_lock({test_lock, self()}), + ?line true = req(Pid, {set_lock, test_lock, self()}), + ?line false = req(Pid2, {set_lock, test_lock, self()}), + ?line false = global:set_lock({test_lock, self()}, ?NODES,1), + % kill lock-holding proc, make sure the lock is released + exit_p(Pid), + ?UNTIL(true =:= global:set_lock({test_lock, self()}, ?NODES,1)), + Pid2 ! {set_lock_loop, test_lock, self()}, + % make sure we don't have the msg + receive + {got_lock, Pid2} -> test_server:fail(got_lock) + after + 1000 -> ok + end, + global:del_lock({test_lock, self()}), + % make sure pid2 got the lock + receive + {got_lock, Pid2} -> ok + after + % 12000 >> 5000, which is the max time before a new retry for + % set_lock + 12000 -> test_server:fail(got_lock2) + end, + + % let proc set the same lock + ?line true = req(Pid2, {set_lock, test_lock, self()}), + % let proc set new lock + ?line true = req(Pid2, {set_lock, test_lock2, self()}), + ?line false = global:set_lock({test_lock, self()},?NODES,1), + ?line false = global:set_lock({test_lock2, self()}, ?NODES,1), + exit_p(Pid2), +% erlang:display({locks1, ets:tab2list(global_locks)}), + ?UNTIL(true =:= global:set_lock({test_lock, self()}, ?NODES, 1)), + ?UNTIL(true =:= global:set_lock({test_lock2, self()}, ?NODES, 1)), + ?line global:del_lock({test_lock, self()}), + ?line global:del_lock({test_lock2, self()}), + + % let proc set two locks + ?line Pid3 = rpc:call(Cp1, ?MODULE, start_proc, []), + ?line true = req(Pid3, {set_lock, test_lock, self()}), + ?line true = req(Pid3, {set_lock, test_lock2, self()}), + % del one lock + ?line Pid3 ! {del_lock, test_lock2}, + ?line test_server:sleep(100), + % check that one lock is still set, but not the other + ?line false = global:set_lock({test_lock, self()}, ?NODES, 1), + ?line true = global:set_lock({test_lock2, self()}, ?NODES, 1), + ?line global:del_lock({test_lock2, self()}), + % kill lock-holder + exit_p(Pid3), +% erlang:display({locks2, ets:tab2list(global_locks)}), + ?UNTIL(true =:= global:set_lock({test_lock, self()}, ?NODES, 1)), + ?line global:del_lock({test_lock, self()}), + ?UNTIL(true =:= global:set_lock({test_lock2, self()}, ?NODES, 1)), + ?line global:del_lock({test_lock2, self()}), + + % start one proc on each node + ?line Pid4 = start_proc(), + ?line Pid5 = rpc:call(Cp1, ?MODULE, start_proc, []), + ?line Pid6 = rpc:call(Cp2, ?MODULE, start_proc, []), + ?line Pid7 = rpc:call(Cp3, ?MODULE, start_proc, []), + % set lock on two nodes + ?line true = req(Pid4, {set_lock, test_lock, self(), [node(), Cp1]}), + ?line false = req(Pid5, {set_lock, test_lock, self(), [node(), Cp1]}), + % set same lock on other two nodes + ?line true = req(Pid6, {set_lock, test_lock, self(), [Cp2, Cp3]}), + ?line false = req(Pid7, {set_lock, test_lock, self(), [Cp2, Cp3]}), + % release lock + Pid6 ! {del_lock, test_lock, [Cp2, Cp3]}, + % try to set lock on a node that already has the lock + ?line false = req(Pid6, {set_lock, test_lock, self(), [Cp1, Cp2, Cp3]}), + + % set lock on a node + exit_p(Pid4), + ?UNTIL(true =:= req(Pid5, {set_lock, test_lock, self(), [node(), Cp1]})), + ?line Pid8 = start_proc(), + ?line false = req(Pid8, {set_lock, test_lock, self()}), + write_high_level_trace(Config), + % stop the nodes, and make sure locks are released. + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + ?line test_server:sleep(100), + ?line true = req(Pid8, {set_lock, test_lock, self()}), + exit_p(Pid8), + ?line test_server:sleep(10), + + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + + +locks_hidden(suite) -> []; +locks_hidden(doc) -> + ["Tests that locks on a hidden node doesn't interere with locks on " + "visible nodes."]; +locks_hidden(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNodes = nodes(), + ?line {ok, Cp1} = start_node(cp1, Config), + ?line {ok, Cp2} = start_node(cp2, Config), + ?line {ok, Cp3} = start_hidden_node(cp3, Config), + ?line pong = rpc:call(Cp1, net_adm, ping, [Cp3]), + ?line pong = rpc:call(Cp3, net_adm, ping, [Cp2]), + ?line pong = rpc:call(Cp3, net_adm, ping, [node()]), + + ?line [] = [Cp1, Cp2 | OrigNodes] -- nodes(), + + % start two procs + ?line Pid = start_proc(), + ?line Pid2 = rpc:call(Cp1, ?MODULE, start_proc, []), + ?line HPid = rpc:call(Cp3, ?MODULE, start_proc, []), + % Make sure hidden node doesn't interfere with visible nodes lock + ?line true = req(HPid, {set_lock, test_lock, self()}), + ?line true = global:set_lock({test_lock, self()}, ?NODES, 1), + ?line false = req(Pid, {set_lock, test_lock, self()}), + ?line true = req(HPid, {del_lock_sync, test_lock, self()}), + ?line false = req(Pid2, {set_lock, test_lock, self()}), + % delete, and let another proc set the lock + global:del_lock({test_lock, self()}), + ?line true = req(Pid, {set_lock, test_lock, self()}), + ?line false = req(Pid2, {set_lock, test_lock, self()}), + ?line false = global:set_lock({test_lock, self()}, ?NODES,1), + % kill lock-holding proc, make sure the lock is released + exit_p(Pid), + ?UNTIL(true =:= global:set_lock({test_lock, self()}, ?NODES, 1)), + ?UNTIL(true =:= req(HPid, {set_lock, test_lock, self()})), + Pid2 ! {set_lock_loop, test_lock, self()}, + % make sure we don't have the msg + receive + {got_lock, Pid2} -> test_server:fail(got_lock) + after + 1000 -> ok + end, + global:del_lock({test_lock, self()}), + % make sure pid2 got the lock + receive + {got_lock, Pid2} -> ok + after + % 12000 >> 5000, which is the max time before a new retry for + % set_lock + 12000 -> test_server:fail(got_lock2) + end, + ?line true = req(HPid, {del_lock_sync, test_lock, self()}), + + % let proc set the same lock + ?line true = req(Pid2, {set_lock, test_lock, self()}), + % let proc set new lock + ?line true = req(Pid2, {set_lock, test_lock2, self()}), + ?line true = req(HPid, {set_lock, test_lock, self()}), + ?line true = req(HPid, {set_lock, test_lock2, self()}), + exit_p(HPid), + ?line false = global:set_lock({test_lock, self()},?NODES,1), + ?line false = global:set_lock({test_lock2, self()}, ?NODES,1), + exit_p(Pid2), +% erlang:display({locks1, ets:tab2list(global_locks)}), + ?UNTIL(true =:= global:set_lock({test_lock, self()}, ?NODES, 1)), + ?UNTIL(true =:= global:set_lock({test_lock2, self()}, ?NODES, 1)), + ?line global:del_lock({test_lock, self()}), + ?line global:del_lock({test_lock2, self()}), + + write_high_level_trace(Config), + % stop the nodes, and make sure locks are released. + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + + +bad_input(suite) -> []; +bad_input(Config) when is_list(Config) -> + Timeout = 15, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + Pid = whereis(global_name_server), + ?line {'EXIT', _} = (catch global:set_lock(bad_id)), + ?line {'EXIT', _} = (catch global:set_lock({id, self()}, bad_nodes)), + ?line {'EXIT', _} = (catch global:del_lock(bad_id)), + ?line {'EXIT', _} = (catch global:del_lock({id, self()}, bad_nodes)), + ?line {'EXIT', _} = (catch global:register_name(name, bad_pid)), + ?line {'EXIT', _} = (catch global:reregister_name(name, bad_pid)), + ?line {'EXIT', _} = (catch global:trans(bad_id, {m,f})), + ?line {'EXIT', _} = (catch global:trans({id, self()}, {m,f}, [node()], -1)), + ?line Pid = whereis(global_name_server), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +names_and_locks(suite) -> []; +names_and_locks(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line {ok, Cp1} = start_node(cp1, Config), + ?line {ok, Cp2} = start_node(cp2, Config), + ?line {ok, Cp3} = start_node(cp3, Config), + + % start one proc on each node + ?line PidTS = start_proc(), + ?line Pid1 = rpc:call(Cp1, ?MODULE, start_proc, []), + ?line Pid2 = rpc:call(Cp2, ?MODULE, start_proc, []), + ?line Pid3 = rpc:call(Cp3, ?MODULE, start_proc, []), + % register some of them + ?line yes = global:register_name(test1, Pid1), + ?line yes = global:register_name(test2, Pid2), + ?line yes = global:register_name(test3, Pid3), + ?line no = global:register_name(test3, PidTS), + ?line yes = global:register_name(test4, PidTS), + + % set lock on two nodes + ?line true = req(PidTS, {set_lock, test_lock, self(), [node(), Cp1]}), + ?line false = req(Pid1, {set_lock, test_lock, self(), [node(), Cp1]}), + % set same lock on other two nodes + ?line true = req(Pid2, {set_lock, test_lock, self(), [Cp2, Cp3]}), + ?line false = req(Pid3, {set_lock, test_lock, self(), [Cp2, Cp3]}), + % release lock + Pid2 ! {del_lock, test_lock, [Cp2, Cp3]}, + ?line test_server:sleep(100), + % try to set lock on a node that already has the lock + ?line false = req(Pid2, {set_lock, test_lock, self(), [Cp1, Cp2, Cp3]}), + % set two locks + ?line true = req(Pid2, {set_lock, test_lock, self(), [Cp2, Cp3]}), + ?line true = req(Pid2, {set_lock, test_lock2, self(), [Cp2, Cp3]}), + + % kill some processes, make sure all locks/names are released + exit_p(PidTS), + ?line ?UNTIL(undefined =:= global:whereis_name(test4)), + ?line true = global:set_lock({test_lock, self()}, [node(), Cp1], 1), + global:del_lock({test_lock, self()}, [node(), Cp1]), + + exit_p(Pid2), + ?line + ?UNTIL((undefined =:= global:whereis_name(test2)) and + (true =:= global:set_lock({test_lock, self()}, [Cp2, Cp3], 1)) and + (true =:= global:set_lock({test_lock2, self()}, [Cp2, Cp3], 1))), + + global:del_lock({test_lock, self()}, [Cp2, Cp3]), + global:del_lock({test_lock2, self()}, [Cp2, Cp3]), + + exit_p(Pid1), + exit_p(Pid3), + + ?line ?UNTIL(OrigNames =:= global:registered_names()), + + write_high_level_trace(Config), + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +lock_die(suite) -> []; +lock_die(doc) -> + ["OTP-6341. Remove locks using monitors."]; +lock_die(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line {ok, Cp1} = start_node(cp1, Config), + ?line {ok, Cp2} = start_node(cp2, Config), + + %% First test. + LockId = {id, self()}, + ?line Pid2 = start_proc(), + ?line true = req(Pid2, {set_lock2, LockId, self()}), + + ?line true = global:set_lock(LockId, [Cp1]), + %% Id is locked on Cp1 and Cp2 (by Pid2) but not by self(): + %% (there is no mon. ref) + ?line _ = global:del_lock(LockId, [node(), Cp1, Cp2]), + + ?line exit_p(Pid2), + + %% Second test. + ?line Pid3 = start_proc(), + ?line true = req(Pid3, {set_lock, id, self(), [Cp1]}), + %% The lock is removed from Cp1 thanks to monitors. + ?line exit_p(Pid3), + + ?line true = global:set_lock(LockId, [node(), Cp1]), + ?line _ = global:del_lock(LockId, [node(), Cp1]), + + ?line ?UNTIL(OrigNames =:= global:registered_names()), + write_high_level_trace(Config), + stop_node(Cp1), + stop_node(Cp2), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +name_die(suite) -> []; +name_die(doc) -> + ["OTP-6341. Remove names using monitors."]; +name_die(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + ?line [Cp1] = Cps = start_nodes([z], peer, Config), % z > test_server + Nodes = lists:sort([node() | Cps]), + ?line wait_for_ready_net(Config), + + Name = name_die, + ?line Pid = rpc:call(Cp1, ?MODULE, start_proc, []), + + %% Test 1. No resolver is called if the same pid is registered on + %% both partitions. + T1 = node(), + Part1 = [T1], + Part2 = [Cp1], + ?line rpc_cast(Cp1, + ?MODULE, part_2_2, [Config, + Part1, + Part2, + []]), + ?line ?UNTIL(is_ready_partition(Config)), + ?line ?UNTIL(undefined =:= global:whereis_name(Name)), + ?line yes = global:register_name(Name, Pid), + + ?line pong = net_adm:ping(Cp1), + ?line wait_for_ready_net(Nodes, Config), + ?line assert_pid(global:whereis_name(Name)), + exit_p(Pid), + ?line ?UNTIL(OrigNames =:= global:registered_names()), + + %% Test 2. Register a name running outside the current partition. + %% Killing the pid will not remove the name from the current + %% partition, unless monitors are used. + ?line Pid2 = rpc:call(Cp1, ?MODULE, start_proc, []), + Dir = ?config(priv_dir, Config), + KillFile = filename:join([Dir, "kill.txt"]), + file:delete(KillFile), + ?line erlang:spawn(Cp1, fun() -> kill_pid(Pid2, KillFile, Config) end), + ?line rpc_cast(Cp1, + ?MODULE, part_2_2, [Config, + Part1, + Part2, + []]), + ?line ?UNTIL(is_ready_partition(Config)), + ?line ?UNTIL(undefined =:= global:whereis_name(Name)), + ?line yes = global:register_name(Name, Pid2), + ?line touch(KillFile, "kill"), + ?line file_contents(KillFile, "done", Config), + file:delete(KillFile), + + ?line ?UNTIL(OrigNames =:= global:registered_names()), + write_high_level_trace(Config), + stop_nodes(Cps), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +kill_pid(Pid, File, Config) -> + file_contents(File, "kill", Config), + exit_p(Pid), + touch(File, "done"). + +basic_partition(suite) -> []; +basic_partition(doc) -> + ["Tests that two partitioned networks exchange correct info."]; +basic_partition(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line [Cp1, Cp2, Cp3] = start_nodes([cp1, cp2, cp3], peer, Config), + ?line [Cp1, Cp2, Cp3] = lists:sort(nodes()), + + ?line wait_for_ready_net(Config), + + % make cp2 and cp3 connected, partitioned from us and cp1 + ?line rpc_cast(Cp2, ?MODULE, part1, [Config, node(), Cp1, Cp3]), + ?line ?UNTIL(is_ready_partition(Config)), + + % start different processes in both partitions + ?line {Pid, yes} = start_proc(test), + + % connect to other partition + ?line pong = net_adm:ping(Cp2), + ?line pong = net_adm:ping(Cp3), + ?line [Cp1, Cp2, Cp3] = lists:sort(nodes()), + + % check names + ?line ?UNTIL(Pid =:= rpc:call(Cp2, global, whereis_name, [test])), + ?line ?UNTIL(undefined =/= global:whereis_name(test2)), + ?line Pid2 = global:whereis_name(test2), + ?line Pid2 = rpc:call(Cp2, global, whereis_name, [test2]), + ?line assert_pid(Pid2), + ?line Pid3 = global:whereis_name(test4), + ?line ?UNTIL(Pid3 =:= rpc:call(Cp1, global, whereis_name, [test4])), + ?line assert_pid(Pid3), + + % kill all procs + ?line Pid3 = global:send(test4, die), + % sleep to let the proc die + wait_for_exit(Pid3), + ?line ?UNTIL(undefined =:= global:whereis_name(test4)), + + exit_p(Pid), + exit_p(Pid2), + + ?line ?UNTIL(OrigNames =:= global:registered_names()), + + write_high_level_trace(Config), + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +basic_name_partition(suite) -> + []; +basic_name_partition(doc) -> + ["Creates two partitions with two nodes in each partition.", + "Tests that names are exchanged correctly, and that EXITs", + "during connect phase are handled correctly."]; +basic_name_partition(Config) when is_list(Config) -> + Timeout = 60, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line [Cp1, Cp2, Cp3] = start_nodes([cp1, cp2, cp3], peer, Config), + ?line [Cp1, Cp2, Cp3] = lists:sort(nodes()), + Nodes = ?NODES, + + ?line wait_for_ready_net(Config), + + % There used to be more than one name registered for some + % processes. That was a mistake; there is no support for more than + % one name per process, and the manual is quite clear about that + % ("equivalent to the register/2 and whereis/1 BIFs"). The + % resolver procedure did not take care of such "duplicated" names, + % which caused this testcase to fail every now and then. + + % make cp2 and cp3 connected, partitioned from us and cp1 + % us: register name03 + % cp1: register name12 + % cp2: register name12 + % cp3: register name03 + + ?line rpc_cast(Cp2, ?MODULE, part1_5, [Config, node(), Cp1, Cp3]), + ?line ?UNTIL(is_ready_partition(Config)), + + % start different processes in both partitions + ?line {_, yes} = start_proc_basic(name03), + ?line {_, yes} = rpc:call(Cp1, ?MODULE, start_proc_basic, [name12]), + test_server:sleep(1000), + + % connect to other partition + ?line pong = net_adm:ping(Cp3), + + ?line ?UNTIL([Cp1, Cp2, Cp3] =:= lists:sort(nodes())), + ?line wait_for_ready_net(Config), + % check names + ?line Pid03 = global:whereis_name(name03), + ?line assert_pid(Pid03), + ?line true = lists:member(node(Pid03), [node(), Cp3]), + ?line check_everywhere(Nodes, name03, Config), + + ?line Pid12 = global:whereis_name(name12), + ?line assert_pid(Pid12), + ?line true = lists:member(node(Pid12), [Cp1, Cp2]), + ?line check_everywhere(Nodes, name12, Config), + + % kill all procs + ?line Pid12 = global:send(name12, die), + ?line Pid03 = global:send(name03, die), + % sleep to let the procs die + wait_for_exit(Pid12), + wait_for_exit(Pid03), + ?line + ?UNTIL(begin + Names = [name03, name12], + lists:duplicate(length(Names), undefined) + =:= [global:whereis_name(Name) || Name <- Names] + end), + + ?line ?UNTIL(OrigNames =:= global:registered_names()), + + write_high_level_trace(Config), + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +%Peer nodes cp0 - cp6 are started. Break apart the connections from +%cp3-cp6 to cp0-cp2 and test_server so we get two partitions. +%In the cp3-cp6 partition, start one process on each node and register +%using both erlang:register, and global:register (test1 on cp3, test2 on +%cp4, test3 on cp5, test4 on cp6), using different resolution functions: +%default for test1, notify_all_name for test2, random_notify_name for test3 +%and one for test4 that sends a message to test_server and keeps the +%process which is greater in the standard ordering. In the other partition, +%do the same (test1 on test_server, test2 on cp0, test3 on cp1, test4 on cp2). +%Sleep a little, then from test_server, connect to cp3-cp6 in order. +%Check that the values for the registered names are the expected ones, and +%that the messages from test4 arrive. + +advanced_partition(suite) -> + []; +advanced_partition(doc) -> + ["Test that names are resolved correctly when two", + "partitioned networks connect."]; +advanced_partition(Config) when is_list(Config) -> + Timeout = 60, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line [Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6] + = start_nodes([cp0, cp1, cp2, cp3, cp4, cp5, cp6], peer, Config), + Nodes = lists:sort([node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6]), + ?line wait_for_ready_net(Config), + + % make cp3-cp6 connected, partitioned from us and cp0-cp2 + ?line rpc_cast(Cp3, ?MODULE, part2, + [Config, self(), node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5,Cp6]), + ?line ?UNTIL(is_ready_partition(Config)), + + % start different processes in this partition + ?line start_procs(self(), Cp0, Cp1, Cp2, Config), + + % connect to other partition + ?line pong = net_adm:ping(Cp3), + ?line pong = net_adm:ping(Cp4), + ?line pong = net_adm:ping(Cp5), + ?line pong = net_adm:ping(Cp6), + + ?line wait_for_ready_net(Config), + + ?line + ?UNTIL(lists:member(undefined, + [rpc:call(Cp3, erlang, whereis, [test1]), + rpc:call(node(), erlang, whereis, [test1])])), + + Nt1 = rpc:call(Cp3, erlang, whereis, [test1]), + Nt2 = rpc:call(Cp4, erlang, whereis, [test2]), + Nt3 = rpc:call(Cp5, erlang, whereis, [test3]), + Nt4 = rpc:call(Cp6, erlang, whereis, [test4]), + + Mt1 = rpc:call(node(), erlang, whereis, [test1]), + Mt2 = rpc:call(Cp0, erlang, whereis, [test2]), + Mt3 = rpc:call(Cp1, erlang, whereis, [test3]), + _Mt4 = rpc:call(Cp2, erlang, whereis, [test4]), + + % check names + ?line Pid1 = global:whereis_name(test1), + ?line Pid1 = rpc:call(Cp3, global, whereis_name, [test1]), + ?line assert_pid(Pid1), + ?line true = lists:member(Pid1, [Nt1, Mt1]), + ?line true = lists:member(undefined, [Nt1, Mt1]), + ?line check_everywhere(Nodes, test1, Config), + + ?line undefined = global:whereis_name(test2), + ?line undefined = rpc:call(Cp3, global, whereis_name, [test2]), + ?line yes = sreq(Nt2, {got_notify, self()}), + ?line yes = sreq(Mt2, {got_notify, self()}), + ?line check_everywhere(Nodes, test2, Config), + + ?line Pid3 = global:whereis_name(test3), + ?line Pid3 = rpc:call(Cp3, global, whereis_name, [test3]), + ?line assert_pid(Pid3), + ?line true = lists:member(Pid3, [Nt3, Mt3]), + ?line no = sreq(Pid3, {got_notify, self()}), + ?line yes = sreq(other(Pid3, [Nt2, Nt3]), {got_notify, self()}), + ?line check_everywhere(Nodes, test3, Config), + + ?line Pid4 = global:whereis_name(test4), + ?line Pid4 = rpc:call(Cp3, global, whereis_name, [test4]), + ?line assert_pid(Pid4), +% ?line true = lists:member(Pid4, [Nt4, Mt4]), + ?line Pid4 = Nt4, + ?line check_everywhere(Nodes, test4, Config), + + ?line 1 = collect_resolves(), + + ?line Pid1 = global:send(test1, die), + exit_p(Pid3), + exit_p(Pid4), + wait_for_exit(Pid1), + wait_for_exit(Pid3), + ?line ?UNTIL(OrigNames =:= global:registered_names()), + + write_high_level_trace(Config), + stop_node(Cp0), + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + stop_node(Cp4), + stop_node(Cp5), + stop_node(Cp6), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +%Peer nodes cp0 - cp6 are started, and partitioned just like in +%advanced_partition. Start cp8, only connected to test_server. Let cp6 +%break apart from the rest, and 12 s later, ping cp0 and cp3, and +%register the name test5. After the same 12 s, let cp5 halt. +%Wait for the death of cp5. Ping cp3 (at the same time as cp6 does). +%Take down cp2. Start cp7, restart cp2. Ping cp4, cp6 and cp8. +%Now, expect all nodes to be connected and have the same picture of all +%registered names. + +stress_partition(suite) -> + []; +stress_partition(doc) -> + ["Stress global, make a partitioned net, make some nodes", + "go up/down a bit."]; +stress_partition(Config) when is_list(Config) -> + Timeout = 90, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line [Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6] + = start_nodes([cp0, cp1, cp2, cp3, cp4, cp5, cp6], peer, Config), + + ?line wait_for_ready_net(Config), + + % make cp3-cp5 connected, partitioned from us and cp0-cp2 + % cp6 is alone (single node). cp6 pings cp0 and cp3 in 12 secs... + ?line rpc_cast(Cp3, ?MODULE, part3, + [Config, self(), node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5,Cp6]), + ?line ?UNTIL(is_ready_partition(Config)), + + % start different processes in this partition + ?line start_procs(self(), Cp0, Cp1, Cp2, Config), + + ?line {ok, Cp8} = start_peer_node(cp8, Config), + + monitor_node(Cp5, true), + receive + {nodedown, Cp5} -> ok + after + 20000 -> test_server:fail({no_nodedown, Cp5}) + end, + monitor_node(Cp5, false), + + % Ok, now cp6 pings us, and cp5 will go down. + + % connect to other partition + ?line pong = net_adm:ping(Cp3), + ?line rpc_cast(Cp2, ?MODULE, crash, [0]), + + % Start new nodes + ?line {ok, Cp7} = start_peer_node(cp7, Config), + ?line {ok, Cp2_2} = start_peer_node(cp2, Config), + Nodes = lists:sort([node(), Cp0, Cp1, Cp2_2, Cp3, Cp4, Cp6, Cp7, Cp8]), + put(?nodes_tag, Nodes), + + ?line pong = net_adm:ping(Cp4), + ?line pong = net_adm:ping(Cp6), + ?line pong = net_adm:ping(Cp8), + + ?line wait_for_ready_net(Nodes, Config), + + % Make sure that all nodes have the same picture of all names + ?line check_everywhere(Nodes, test1, Config), + ?line assert_pid(global:whereis_name(test1)), + + ?line check_everywhere(Nodes, test2, Config), + ?line undefined = global:whereis_name(test2), + + ?line check_everywhere(Nodes, test3, Config), + ?line assert_pid(global:whereis_name(test3)), + + ?line check_everywhere(Nodes, test4, Config), + ?line assert_pid(global:whereis_name(test4)), + + ?line check_everywhere(Nodes, test5, Config), + ?line ?UNTIL(undefined =:= global:whereis_name(test5)), + + ?line assert_pid(global:send(test1, die)), + ?line assert_pid(global:send(test3, die)), + ?line assert_pid(global:send(test4, die)), + + ?line ?UNTIL(OrigNames =:= global:registered_names()), + + write_high_level_trace(Config), + stop_node(Cp0), + stop_node(Cp1), + stop_node(Cp2_2), + stop_node(Cp3), + stop_node(Cp4), + stop_node(Cp5), + stop_node(Cp6), + stop_node(Cp7), + stop_node(Cp8), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + + +%% Use this one to test alot of connection tests +%% erl -sname ts -rsh ctrsh -pa /clearcase/otp/internal_tools/test_server/ebin/ -ring_line 10000 -s test_server run_test global_SUITE + +ring_line(suite) -> []; +ring_line(doc) -> [""]; +ring_line(Config) when is_list(Config) -> + {ok, [[N]]} = init:get_argument(ring_line), + loop_it(list_to_integer(N), Config). + +loop_it(N, Config) -> loop_it(N,N, Config). + +loop_it(0,_, _Config) -> ok; +loop_it(N,M, Config) -> + test_server:format(1, "Round: ~w", [M-N]), + ring(Config), + line(Config), + loop_it(N-1,M, Config). + + +ring(suite) -> + []; +ring(doc) -> + ["Make 10 single nodes, all having the same name.", + "Make all ping its predecessor, pinging in a ring.", + "Make sure that there's just one winner."]; +ring(Config) when is_list(Config) -> + Timeout = 60, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line [Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6, Cp7, Cp8] + = start_nodes([cp0, cp1, cp2, cp3, cp4, cp5, cp6, cp7, cp8], + peer, Config), + Nodes = lists:sort([node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6, Cp7, Cp8]), + + ?line wait_for_ready_net(Config), + + Time = msec() + 7000, + + ?line rpc_cast(Cp0, ?MODULE, single_node, [Time, Cp8, Config]), + ?line rpc_cast(Cp1, ?MODULE, single_node, [Time, Cp0, Config]), + ?line rpc_cast(Cp2, ?MODULE, single_node, [Time, Cp1, Config]), + ?line rpc_cast(Cp3, ?MODULE, single_node, [Time, Cp2, Config]), + ?line rpc_cast(Cp4, ?MODULE, single_node, [Time, Cp3, Config]), + ?line rpc_cast(Cp5, ?MODULE, single_node, [Time, Cp4, Config]), + ?line rpc_cast(Cp6, ?MODULE, single_node, [Time, Cp5, Config]), + ?line rpc_cast(Cp7, ?MODULE, single_node, [Time, Cp6, Config]), + ?line rpc_cast(Cp8, ?MODULE, single_node, [Time, Cp7, Config]), + + % sleep to make the partitioned net ready + test_server:sleep(Time - msec()), + + ?line pong = net_adm:ping(Cp0), + ?line pong = net_adm:ping(Cp1), + ?line pong = net_adm:ping(Cp2), + ?line pong = net_adm:ping(Cp3), + ?line pong = net_adm:ping(Cp4), + ?line pong = net_adm:ping(Cp5), + ?line pong = net_adm:ping(Cp6), + ?line pong = net_adm:ping(Cp7), + ?line pong = net_adm:ping(Cp8), + + ?line pong = net_adm:ping(Cp0), + ?line pong = net_adm:ping(Cp1), + ?line pong = net_adm:ping(Cp2), + ?line pong = net_adm:ping(Cp3), + ?line pong = net_adm:ping(Cp4), + ?line pong = net_adm:ping(Cp5), + ?line pong = net_adm:ping(Cp6), + ?line pong = net_adm:ping(Cp7), + ?line pong = net_adm:ping(Cp8), + + ?line wait_for_ready_net(Nodes, Config), + + % Just make sure that all nodes have the same picture of all names + ?line check_everywhere(Nodes, single_name, Config), + ?line assert_pid(global:whereis_name(single_name)), + + ?line + ?UNTIL(begin + {Ns2, []} = rpc:multicall(Nodes, erlang, whereis, + [single_name]), + 9 =:= lists:foldl(fun(undefined, N) -> N + 1; + (_, N) -> N + end, + 0, Ns2) + end), + + ?line assert_pid(global:send(single_name, die)), + + ?line ?UNTIL(OrigNames =:= global:registered_names()), + + write_high_level_trace(Config), + stop_node(Cp0), + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + stop_node(Cp4), + stop_node(Cp5), + stop_node(Cp6), + stop_node(Cp7), + stop_node(Cp8), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +simple_ring(suite) -> + []; +simple_ring(doc) -> + ["Simpler version of the ring case. Used because there are some", + "distribution problems with many nodes.", + "Make 6 single nodes, all having the same name.", + "Make all ping its predecessor, pinging in a ring.", + "Make sure that there's just one winner."]; +simple_ring(Config) when is_list(Config) -> + Timeout = 60, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + Names = [cp0, cp1, cp2, cp3, cp4, cp5], + ?line [Cp0, Cp1, Cp2, Cp3, Cp4, Cp5] + = start_nodes(Names, peer, Config), + Nodes = lists:sort([node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5]), + + ?line wait_for_ready_net(Config), + + Time = msec() + 5000, + + ?line rpc_cast(Cp0, ?MODULE, single_node, [Time, Cp5, Config]), + ?line rpc_cast(Cp1, ?MODULE, single_node, [Time, Cp0, Config]), + ?line rpc_cast(Cp2, ?MODULE, single_node, [Time, Cp1, Config]), + ?line rpc_cast(Cp3, ?MODULE, single_node, [Time, Cp2, Config]), + ?line rpc_cast(Cp4, ?MODULE, single_node, [Time, Cp3, Config]), + ?line rpc_cast(Cp5, ?MODULE, single_node, [Time, Cp4, Config]), + + % sleep to make the partitioned net ready + test_server:sleep(Time - msec()), + + ?line pong = net_adm:ping(Cp0), + ?line pong = net_adm:ping(Cp1), + ?line pong = net_adm:ping(Cp2), + ?line pong = net_adm:ping(Cp3), + ?line pong = net_adm:ping(Cp4), + ?line pong = net_adm:ping(Cp5), + + ?line pong = net_adm:ping(Cp0), + ?line pong = net_adm:ping(Cp1), + ?line pong = net_adm:ping(Cp2), + ?line pong = net_adm:ping(Cp3), + ?line pong = net_adm:ping(Cp4), + ?line pong = net_adm:ping(Cp5), + + ?line wait_for_ready_net(Nodes, Config), + + % Just make sure that all nodes have the same picture of all names + ?line check_everywhere(Nodes, single_name, Config), + ?line assert_pid(global:whereis_name(single_name)), + + ?line + ?UNTIL(begin + {Ns2, []} = rpc:multicall(Nodes, erlang, whereis, + [single_name]), + 6 =:= lists:foldl(fun(undefined, N) -> N + 1; + (_, N) -> N + end, + 0, Ns2) + end), + + ?line assert_pid(global:send(single_name, die)), + + ?line ?UNTIL(OrigNames =:= global:registered_names()), + + write_high_level_trace(Config), + stop_node(Cp0), + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + stop_node(Cp4), + stop_node(Cp5), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +line(suite) -> + []; +line(doc) -> + ["Make 6 single nodes, all having the same name.", + "Make all ping its predecessor, pinging in a line.", + "Make sure that there's just one winner."]; +line(Config) when is_list(Config) -> + Timeout = 60, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line [Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6, Cp7, Cp8] + = start_nodes([cp0, cp1, cp2, cp3, cp4, cp5, cp6, cp7, cp8], + peer, Config), + Nodes = lists:sort([node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6, Cp7, Cp8]), + + ?line wait_for_ready_net(Config), + + Time = msec() + 7000, + + ?line rpc_cast(Cp0, ?MODULE, single_node, + [Time, Cp0, Config]), % ping ourself! + ?line rpc_cast(Cp1, ?MODULE, single_node, [Time, Cp0, Config]), + ?line rpc_cast(Cp2, ?MODULE, single_node, [Time, Cp1, Config]), + ?line rpc_cast(Cp3, ?MODULE, single_node, [Time, Cp2, Config]), + ?line rpc_cast(Cp4, ?MODULE, single_node, [Time, Cp3, Config]), + ?line rpc_cast(Cp5, ?MODULE, single_node, [Time, Cp4, Config]), + ?line rpc_cast(Cp6, ?MODULE, single_node, [Time, Cp5, Config]), + ?line rpc_cast(Cp7, ?MODULE, single_node, [Time, Cp6, Config]), + ?line rpc_cast(Cp8, ?MODULE, single_node, [Time, Cp7, Config]), + + % sleep to make the partitioned net ready + test_server:sleep(Time - msec()), + + ?line pong = net_adm:ping(Cp0), + ?line pong = net_adm:ping(Cp1), + ?line pong = net_adm:ping(Cp2), + ?line pong = net_adm:ping(Cp3), + ?line pong = net_adm:ping(Cp4), + ?line pong = net_adm:ping(Cp5), + ?line pong = net_adm:ping(Cp6), + ?line pong = net_adm:ping(Cp7), + ?line pong = net_adm:ping(Cp8), + + ?line pong = net_adm:ping(Cp0), + ?line pong = net_adm:ping(Cp1), + ?line pong = net_adm:ping(Cp2), + ?line pong = net_adm:ping(Cp3), + ?line pong = net_adm:ping(Cp4), + ?line pong = net_adm:ping(Cp5), + ?line pong = net_adm:ping(Cp6), + ?line pong = net_adm:ping(Cp7), + ?line pong = net_adm:ping(Cp8), + + ?line wait_for_ready_net(Nodes, Config), + + % Just make sure that all nodes have the same picture of all names + ?line check_everywhere(Nodes, single_name, Config), + ?line assert_pid(global:whereis_name(single_name)), + + ?line + ?UNTIL(begin + {Ns2, []} = rpc:multicall(Nodes, erlang, whereis, + [single_name]), + 9 =:= lists:foldl(fun(undefined, N) -> N + 1; + (_, N) -> N + end, + 0, Ns2) + end), + + ?line assert_pid(global:send(single_name, die)), + + ?line ?UNTIL(OrigNames =:= global:registered_names()), + + write_high_level_trace(Config), + stop_node(Cp0), + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + stop_node(Cp4), + stop_node(Cp5), + stop_node(Cp6), + stop_node(Cp7), + stop_node(Cp8), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + + +simple_line(suite) -> + []; +simple_line(doc) -> + ["Simpler version of the line case. Used because there are some", + "distribution problems with many nodes.", + "Make 6 single nodes, all having the same name.", + "Make all ping its predecessor, pinging in a line.", + "Make sure that there's just one winner."]; +simple_line(Config) when is_list(Config) -> + Timeout = 60, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line [Cp0, Cp1, Cp2, Cp3, Cp4, Cp5] + = start_nodes([cp0, cp1, cp2, cp3, cp4, cp5], peer, Config), + Nodes = lists:sort([node(), Cp0, Cp1, Cp2, Cp3, Cp4, Cp5]), + + ?line wait_for_ready_net(Config), + + Time = msec() + 5000, + + ?line rpc_cast(Cp0, ?MODULE, single_node, + [Time, Cp0, Config]), % ping ourself! + ?line rpc_cast(Cp1, ?MODULE, single_node, [Time, Cp0, Config]), + ?line rpc_cast(Cp2, ?MODULE, single_node, [Time, Cp1, Config]), + ?line rpc_cast(Cp3, ?MODULE, single_node, [Time, Cp2, Config]), + ?line rpc_cast(Cp4, ?MODULE, single_node, [Time, Cp3, Config]), + ?line rpc_cast(Cp5, ?MODULE, single_node, [Time, Cp4, Config]), + + % sleep to make the partitioned net ready + test_server:sleep(Time - msec()), + + ?line pong = net_adm:ping(Cp0), + ?line pong = net_adm:ping(Cp1), + ?line pong = net_adm:ping(Cp2), + ?line pong = net_adm:ping(Cp3), + ?line pong = net_adm:ping(Cp4), + ?line pong = net_adm:ping(Cp5), + + ?line pong = net_adm:ping(Cp0), + ?line pong = net_adm:ping(Cp1), + ?line pong = net_adm:ping(Cp2), + ?line pong = net_adm:ping(Cp3), + ?line pong = net_adm:ping(Cp4), + ?line pong = net_adm:ping(Cp5), + + ?line wait_for_ready_net(Nodes, Config), + + % Just make sure that all nodes have the same picture of all names + ?line check_everywhere(Nodes, single_name, Config), + ?line assert_pid(global:whereis_name(single_name)), + + ?line + ?UNTIL(begin + {Ns2, []} = rpc:multicall(Nodes, erlang, whereis, + [single_name]), + 6 =:= lists:foldl(fun(undefined, N) -> N + 1; + (_, N) -> N + end, + 0, Ns2) + end), + + ?line assert_pid(global:send(single_name, die)), + + ?line ?UNTIL(OrigNames =:= global:registered_names()), + + write_high_level_trace(Config), + stop_node(Cp0), + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + stop_node(Cp4), + stop_node(Cp5), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +otp_1849(suite) -> []; +otp_1849(doc) -> + ["Test ticket: Global should keep track of all pids that set the same lock."]; +otp_1849(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line {ok, Cp1} = start_node(cp1, Config), + ?line {ok, Cp2} = start_node(cp2, Config), + ?line {ok, Cp3} = start_node(cp3, Config), + + ?line wait_for_ready_net(Config), + + % start procs on each node + ?line Pid1 = rpc:call(Cp1, ?MODULE, start_proc, []), + ?line assert_pid(Pid1), + ?line Pid2 = rpc:call(Cp2, ?MODULE, start_proc, []), + ?line assert_pid(Pid2), + ?line Pid3 = rpc:call(Cp3, ?MODULE, start_proc, []), + ?line assert_pid(Pid3), + + % set a lock on every node + ?line true = req(Pid1, {set_lock2, {test_lock, ?MODULE}, self()}), + ?line true = req(Pid2, {set_lock2, {test_lock, ?MODULE}, self()}), + ?line true = req(Pid3, {set_lock2, {test_lock, ?MODULE}, self()}), + + ?line + ?UNTIL(begin + [{test_lock, ?MODULE, Lock1}] = + rpc:call(Cp1, ets, tab2list, [global_locks]), + 3 =:= length(Lock1) + end), + + ?line true = req(Pid3, {del_lock2, {test_lock, ?MODULE}, self()}), + ?line + ?UNTIL(begin + [{test_lock, ?MODULE, Lock2}] = + rpc:call(Cp1, ets, tab2list, [global_locks]), + 2 =:= length(Lock2) + end), + + ?line true = req(Pid2, {del_lock2, {test_lock, ?MODULE}, self()}), + ?line + ?UNTIL(begin + [{test_lock, ?MODULE, Lock3}] = + rpc:call(Cp1, ets, tab2list, [global_locks]), + 1 =:= length(Lock3) + end), + + ?line true = req(Pid1, {del_lock2, {test_lock, ?MODULE}, self()}), + ?line ?UNTIL([] =:= rpc:call(Cp1, ets, tab2list, [global_locks])), + + + ?line true = req(Pid1, {set_lock2, {test_lock, ?MODULE}, self()}), + ?line true = req(Pid2, {set_lock2, {test_lock, ?MODULE}, self()}), + ?line true = req(Pid3, {set_lock2, {test_lock, ?MODULE}, self()}), + ?line false = req(Pid2, {set_lock2, {test_lock, not_valid}, self()}), + + exit_p(Pid1), + ?line + ?UNTIL(begin + [{test_lock, ?MODULE, Lock10}] = + rpc:call(Cp1, ets, tab2list, [global_locks]), + 2 =:= length(Lock10) + end), + ?line + ?UNTIL(begin + [{test_lock, ?MODULE, Lock11}] = + rpc:call(Cp2, ets, tab2list, [global_locks]), + 2 =:= length(Lock11) + end), + ?line + ?UNTIL(begin + [{test_lock, ?MODULE, Lock12}] = + rpc:call(Cp3, ets, tab2list, [global_locks]), + 2 =:= length(Lock12) + end), + + write_high_level_trace(Config), + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + + +otp_3162(suite) -> []; +otp_3162(doc) -> + ["Test ticket: Deadlock in global"]; +otp_3162(Config) when is_list(Config) -> + StartFun = fun() -> + {ok, Cp1} = start_node(cp1, Config), + {ok, Cp2} = start_node(cp2, Config), + {ok, Cp3} = start_node(cp3, Config), + [Cp1, Cp2, Cp3] + end, + do_otp_3162(StartFun, Config). + +do_otp_3162(StartFun, Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line [Cp1, Cp2, Cp3] = StartFun(), + + ?line wait_for_ready_net(Config), + + % start procs on each node + ?line Pid1 = rpc:call(Cp1, ?MODULE, start_proc4, [kalle]), + ?line assert_pid(Pid1), + ?line Pid2 = rpc:call(Cp2, ?MODULE, start_proc4, [stina]), + ?line assert_pid(Pid2), + ?line Pid3 = rpc:call(Cp3, ?MODULE, start_proc4, [vera]), + ?line assert_pid(Pid3), + + ?line rpc_disconnect_node(Cp1, Cp2, Config), + + ?line ?UNTIL + ([Cp3] =:= lists:sort(rpc:call(Cp1, erlang, nodes, [])) -- [node()]), + + ?line ?UNTIL([kalle, test_server, vera] =:= + lists:sort(rpc:call(Cp1, global, registered_names, []))), + ?line ?UNTIL + ([Cp3] =:= lists:sort(rpc:call(Cp2, erlang, nodes, [])) -- [node()]), + ?line ?UNTIL([stina, test_server, vera] =:= + lists:sort(rpc:call(Cp2, global, registered_names, []))), + ?line ?UNTIL + ([Cp1, Cp2] =:= + lists:sort(rpc:call(Cp3, erlang, nodes, [])) -- [node()]), + ?line ?UNTIL([kalle, stina, test_server, vera] =:= + lists:sort(rpc:call(Cp3, global, registered_names, []))), + + ?line pong = rpc:call(Cp2, net_adm, ping, [Cp1]), + + ?line ?UNTIL + ([Cp2, Cp3] =:= + lists:sort(rpc:call(Cp1, erlang, nodes, [])) -- [node()]), + ?line + ?UNTIL(begin + NN = lists:sort(rpc:call(Cp1, global, registered_names, [])), + [kalle, stina, test_server, vera] =:= NN + end), + ?line ?UNTIL + ([Cp1, Cp3] =:= + lists:sort(rpc:call(Cp2, erlang, nodes, [])) -- [node()]), + ?line ?UNTIL([kalle, stina, test_server, vera] =:= + lists:sort(rpc:call(Cp2, global, registered_names, []))), + ?line ?UNTIL + ([Cp1, Cp2] =:= + lists:sort(rpc:call(Cp3, erlang, nodes, [])) -- [node()]), + ?line ?UNTIL([kalle, stina, test_server, vera] =:= + lists:sort(rpc:call(Cp3, global, registered_names, []))), + + write_high_level_trace(Config), + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + + +otp_5640(suite) -> []; +otp_5640(doc) -> + ["OTP-5640. 'allow' multiple names for registered processes."]; +otp_5640(Config) when is_list(Config) -> + Timeout = 25, + ?line Dog = test_server:timetrap(test_server:seconds(Timeout)), + init_high_level_trace(Timeout), + init_condition(Config), + ?line {ok, B} = start_node(b, Config), + + ?line Nodes = lists:sort([node(), B]), + ?line wait_for_ready_net(Nodes, Config), + + Server = whereis(global_name_server), + ServerB = rpc:call(B, erlang, whereis, [global_name_server]), + + Me = self(), + Proc = spawn(fun() -> otp_5640_proc(Me) end), + + ?line yes = global:register_name(name1, Proc), + ?line no = global:register_name(name2, Proc), + + ?line ok = application:set_env(kernel, global_multi_name_action, allow), + ?line yes = global:register_name(name2, Proc), + + test_server:sleep(100), + ?line Proc = global:whereis_name(name1), + ?line Proc = global:whereis_name(name2), + ?line check_everywhere(Nodes, name1, Config), + ?line check_everywhere(Nodes, name2, Config), + + ?line {monitors_2levels, MonBy1} = mon_by_servers(Proc), + ?line [] = ([Server,Server,ServerB,ServerB] -- MonBy1), + ?line {links,[]} = process_info(Proc, links), + ?line _ = global:unregister_name(name1), + + test_server:sleep(100), + ?line undefined = global:whereis_name(name1), + ?line Proc = global:whereis_name(name2), + ?line check_everywhere(Nodes, name1, Config), + ?line check_everywhere(Nodes, name2, Config), + + ?line {monitors_2levels, MonBy2} = mon_by_servers(Proc), + ?line [] = ([Server,ServerB] -- MonBy2), + TmpMonBy2 = MonBy2 -- [Server,ServerB], + ?line TmpMonBy2 = TmpMonBy2 -- [Server,ServerB], + ?line {links,[]} = process_info(Proc, links), + + ?line yes = global:register_name(name1, Proc), + + Proc ! die, + + test_server:sleep(100), + ?line undefined = global:whereis_name(name1), + ?line undefined = global:whereis_name(name2), + ?line check_everywhere(Nodes, name1, Config), + ?line check_everywhere(Nodes, name2, Config), + ?line {monitors, GMonitors} = process_info(Server, monitors), + ?line false = lists:member({process, Proc}, GMonitors), + + write_high_level_trace(Config), + stop_node(B), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +otp_5640_proc(_Parent) -> + receive + die -> + exit(normal) + end. + +otp_5737(suite) -> []; +otp_5737(doc) -> + ["OTP-5737. set_lock/3 and trans/4 accept Retries = 0."]; +otp_5737(Config) when is_list(Config) -> + Timeout = 25, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + + LockId = {?MODULE,self()}, + Nodes = [node()], + ?line {'EXIT', _} = (catch global:set_lock(LockId, Nodes, -1)), + ?line {'EXIT', _} = (catch global:set_lock(LockId, Nodes, a)), + ?line true = global:set_lock(LockId, Nodes, 0), + Time1 = now(), + ?line false = global:set_lock({?MODULE,not_me}, Nodes, 0), + ?line true = timer:now_diff(now(), Time1) < 5000, + ?line _ = global:del_lock(LockId, Nodes), + + Fun = fun() -> ok end, + ?line {'EXIT', _} = (catch global:trans(LockId, Fun, Nodes, -1)), + ?line {'EXIT', _} = (catch global:trans(LockId, Fun, Nodes, a)), + ?line ok = global:trans(LockId, Fun, Nodes, 0), + + write_high_level_trace(Config), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +otp_6931(suite) -> []; +otp_6931(doc) -> ["OTP-6931. Ignore nodeup when connect_all=false."]; +otp_6931(Config) when is_list(Config) -> + Me = self(), + ?line {ok, CAf} = start_non_connecting_node(ca_false, Config), + ?line ok = rpc:call(CAf, error_logger, add_report_handler, [?MODULE, Me]), + ?line info = rpc:call(CAf, error_logger, warning_map, []), + ?line {global_name_server,CAf} ! {nodeup, fake_node}, + timer:sleep(100), + stop_node(CAf), + receive {nodeup,fake_node} -> test_server:fail({info_report, was, sent}) + after 1000 -> ok + end, + ok. + +%%%----------------------------------------------------------------- +%%% Testing a disconnected node. Not two partitions. +%%%----------------------------------------------------------------- +simple_disconnect(suite) -> []; +simple_disconnect(doc) -> ["OTP-5563. Disconnected nodes (not partitions)"]; +simple_disconnect(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + %% Three nodes (test_server, n_1, n_2). + ?line [Cp1, Cp2] = Cps = start_nodes([n_1, n_2], peer, Config), + ?line wait_for_ready_net(Config), + + Nodes = lists:sort([node() | Cps]), + + lists:foreach(fun(N) -> rpc:call(N, ?MODULE, start_tracer, []) end,Nodes), + + Name = name, + Resolver = {no_module, resolve_none}, % will never be called + PingNode = Cp2, + + ?line {_Pid1, yes} = + rpc:call(Cp1, ?MODULE, start_resolver, [Name, Resolver]), + test_server:sleep(100), + + %% Disconnect test_server and Cp2. + ?line true = erlang:disconnect_node(Cp2), + test_server:sleep(500), + + %% _Pid is registered on Cp1. The exchange of names between Cp2 and + %% test_server sees two identical pids. + ?line pong = net_adm:ping(PingNode), + ?line ?UNTIL(Cps =:= lists:sort(nodes())), + + ?line {_, Trace0} = collect_tracers(Nodes), + ?line Resolvers = [P || {_Node,new_resolver,{pid,P}} <- Trace0], + ?line lists:foreach(fun(P) -> P ! die end, Resolvers), + ?line lists:foreach(fun(P) -> wait_for_exit(P) end, Resolvers), + ?line check_everywhere(Nodes, Name, Config), + ?line undefined = global:whereis_name(Name), + + ?line {_, Trace1} = collect_tracers(Nodes), + Trace = Trace0 ++ Trace1, + ?line [] = [foo || {_, resolve_none, _, _} <- Trace], + + ?line Gs = name_servers(Nodes), + ?line [_, _, _] = monitored_by_node(Trace, Gs), + + lists:foreach(fun(N) -> rpc:call(N, ?MODULE, stop_tracer, []) end, Nodes), + + ?line OrigNames = global:registered_names(), + write_high_level_trace(Config), + stop_nodes(Cps), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Not used right now. +simple_dis(Nodes0, Name, Resolver, Config) -> + Nodes = [node() | Nodes0], + NN = lists:zip(Nodes, lists:seq(1, length(Nodes))), + [{_Node,Other} | Dis] = + [{N,[N1 || {N1,I1} <- NN, I1 > I + 1]} || {N,I} <- NN], + lists:foreach( + fun({Node, DisNodes}) -> + Args = [Node, DisNodes, Name, Resolver], + ok = rpc:call(Node, ?MODULE, simple_dis_node, Args) + end, Dis), + ok = simple_dis_node(node(), Other, Name, Resolver, Config). + +simple_dis_node(_Node, DisNodes, _Name, _Resolver, Config) -> + lists:foreach( + fun(OtherNode) -> _ = erlang:disconnect_node(OtherNode) end, DisNodes), + ?line ?UNTIL(DisNodes -- nodes() =:= DisNodes), + ok. + + + +%%%----------------------------------------------------------------- +%%% Testing resolve of name. Many combinations with four nodes. +%%%----------------------------------------------------------------- +-record(cf, { + link, % node expected to have registered process running + ping, % node in partition 2 to be pinged + n1, % node starting registered process in partition 1 + n2, % node starting registered process in partition 2 + nodes, % nodes expected to exist after ping + n_res, % expected number of resolvers after ping + config + }). + +-define(RES(F), {F, fun ?MODULE:F/3}). + +simple_resolve(suite) -> []; +simple_resolve(doc) -> ["OTP-5563. Partitions and names."]; +simple_resolve(Config) when is_list(Config) -> + Timeout = 360, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line [N1, A2, Z2] = Cps = start_nodes([n_1, a_2, z_2], peer, Config), + Nodes = lists:sort([node() | Cps]), + ?line wait_for_ready_net(Config), + + lists:foreach(fun(N) -> + rpc:call(N, ?MODULE, start_tracer, []) + end, Nodes), + + %% There used to be a link between global_name_server and the + %% registered name. Now there are only monitors, but the field + %% name 'link' remains... + + Cf = #cf{link = none, ping = A2, n1 = node(), n2 = A2, + nodes = [node(), N1, A2, Z2], n_res = 2, config = Config}, + + %% There is no test with a resolver that deletes a pid (like + %% global_exit_name does). The resulting DOWN signal just clears + %% out the pid from the tables, which should be harmless. So all + %% tests are done with resolvers that keep both processes. This + %% should catch all cases which used to result in bogus process + %% links (now: only monitors are used). + + %% Two partitions are created in each case below: [node(), n_1] + %% and [a_2, z_2]. A name ('name') is registered in both + %% partitions whereafter node() or n_1 pings a_2 or z_2. Note that + %% node() = test_server, which means that node() < z_2 and node() + %% > a_2. The lesser node calls the resolver. + + %% [The following comment does not apply now that monitors are used.] + %% The resolver is run on a_2 with the process on node() + %% as first argument. The process registered as 'name' on a_2 is + %% removed from the tables. It is unlinked from a_2, and the new + %% process (on node()) is inserted without trying to link to it + %% (it it known to run on some other node, in the other + %% partition). The new process is not sent to the other partition + %% for update since it already exists there. + res(?RES(resolve_first), Cps, Cf#cf{link = node(), n2 = A2}), + %% The same, but the z_2 takes the place of a_2. + res(?RES(resolve_first), Cps, Cf#cf{link = node(), n2 = Z2}), + %% The resolver is run on test_server. + res(?RES(resolve_first), Cps, Cf#cf{link = A2, n2 = A2, ping = Z2}), + res(?RES(resolve_first), Cps, Cf#cf{link = Z2, n2 = Z2, ping = Z2}), + %% Now the same tests but with n_1 taking the place of test_server. + res(?RES(resolve_first), Cps, Cf#cf{link = N1, n1 = N1, n2 = A2}), + res(?RES(resolve_first), Cps, Cf#cf{link = N1, n1 = N1, n2 = Z2}), + res(?RES(resolve_first), Cps, Cf#cf{link = A2, n1 = N1, n2 = A2, ping = Z2}), + res(?RES(resolve_first), Cps, Cf#cf{link = Z2, n1 = N1, n2 = Z2, ping = Z2}), + + %% [Maybe this set of tests is the same as (ismorphic to?) the last one.] + %% The resolver is run on a_2 with the process on node() + %% as first argument. The process registered as 'name' on a_2 is + %% the one kept. The old process is unlinked on node(), and the + %% new process (on a_2) is inserted without trying to link to it + %% (it it known to run on some other node). + res(?RES(resolve_second), Cps, Cf#cf{link = A2, n2 = A2}), + %% The same, but the z_2 takes the place of a_2. + res(?RES(resolve_second), Cps, Cf#cf{link = Z2, n2 = Z2}), + %% The resolver is run on test_server. + res(?RES(resolve_second), Cps, Cf#cf{link = node(), n2 = A2, ping = Z2}), + res(?RES(resolve_second), Cps, Cf#cf{link = node(), n2 = Z2, ping = Z2}), + %% Now the same tests but with n_1 taking the place of test_server. + res(?RES(resolve_second), Cps, Cf#cf{link = A2, n1 = N1, n2 = A2}), + res(?RES(resolve_second), Cps, Cf#cf{link = Z2, n1 = N1, n2 = Z2}), + res(?RES(resolve_second), Cps, Cf#cf{link = N1, n1 = N1, n2 = A2, ping = Z2}), + res(?RES(resolve_second), Cps, Cf#cf{link = N1, n1 = N1, n2 = Z2, ping = Z2}), + + %% A resolver that does not return one of the pids. + res(?RES(bad_resolver), Cps, Cf#cf{n2 = A2}), + res(?RES(bad_resolver), Cps, Cf#cf{n2 = Z2}), + %% The resolver is run on test_server. + res(?RES(bad_resolver), Cps, Cf#cf{n2 = A2, ping = Z2}), + res(?RES(bad_resolver), Cps, Cf#cf{n2 = Z2, ping = Z2}), + %% Now the same tests but with n_1 taking the place of test_server. + res(?RES(bad_resolver), Cps, Cf#cf{n1 = N1, n2 = A2}), + res(?RES(bad_resolver), Cps, Cf#cf{n1 = N1, n2 = Z2}), + res(?RES(bad_resolver), Cps, Cf#cf{n1 = N1, n2 = A2, ping = Z2}), + res(?RES(bad_resolver), Cps, Cf#cf{n1 = N1, n2 = Z2, ping = Z2}), + + %% Both processes are unlinked (demonitored). + res(?RES(resolve_none), Cps, Cf#cf{n2 = A2}), + res(?RES(resolve_none), Cps, Cf#cf{n2 = Z2}), + res(?RES(resolve_none), Cps, Cf#cf{n2 = A2, ping = Z2}), + res(?RES(resolve_none), Cps, Cf#cf{n2 = Z2, ping = Z2}), + res(?RES(resolve_none), Cps, Cf#cf{n1 = N1, n2 = A2}), + res(?RES(resolve_none), Cps, Cf#cf{n1 = N1, n2 = Z2}), + res(?RES(resolve_none), Cps, Cf#cf{n1 = N1, n2 = A2, ping = Z2}), + res(?RES(resolve_none), Cps, Cf#cf{n1 = N1, n2 = Z2, ping = Z2}), + + %% A resolver faking badrpc. The resolver is run on a_2, and the + %% process on node() is kept. + res(?RES(badrpc_resolver), Cps, Cf#cf{link = node(), n2 = A2}), + + %% An exiting resolver. A kind of badrpc. + res(?RES(exit_resolver), Cps, Cf#cf{link = node(), n2 = A2}), + res(?RES(exit_resolver), Cps, Cf#cf{link = node(), n2 = Z2}), + res(?RES(exit_resolver), Cps, Cf#cf{link = A2, n2 = A2, ping = Z2}), + res(?RES(exit_resolver), Cps, Cf#cf{link = Z2, n2 = Z2, ping = Z2}), + res(?RES(exit_resolver), Cps, Cf#cf{link = N1, n1 = N1, n2 = A2}), + res(?RES(exit_resolver), Cps, Cf#cf{link = N1, n1 = N1, n2 = Z2}), + res(?RES(exit_resolver), Cps, Cf#cf{link = A2, n1 = N1, n2 = A2, ping = Z2}), + res(?RES(exit_resolver), Cps, Cf#cf{link = Z2, n1 = N1, n2 = Z2, ping = Z2}), + + %% A locker that takes a lock. It used to be that the + %% global_name_server was busy exchanging names, which caused a + %% deadlock. + res(?RES(lock_resolver), Cps, Cf#cf{link = node()}), + + %% A resolver that disconnects from the node of the first pid + %% once. The nodedown message is processed (the resolver killed), + %% then a new attempt (nodeup etc.) is made. This time the + %% resolver does not disconnect any node. + res(?RES(disconnect_first), Cps, Cf#cf{link = Z2, n2 = Z2, + nodes = [node(), N1, A2, Z2]}), + + ?line lists:foreach(fun(N) -> + rpc:call(N, ?MODULE, stop_tracer, []) + end, Nodes), + + ?line OrigNames = global:registered_names(), + write_high_level_trace(Config), + stop_nodes(Cps), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +simple_resolve2(suite) -> []; +simple_resolve2(doc) -> ["OTP-5563. Partitions and names."]; +simple_resolve2(Config) when is_list(Config) -> + %% Continuation of simple_resolve. Of some reason it did not + %% always work to re-start z_2. "Cannot be a global bug." + + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line [N1, A2, Z2] = Cps = start_nodes([n_1, a_2, z_2], peer, Config), + ?line wait_for_ready_net(Config), + Nodes = lists:sort([node() | Cps]), + + lists:foreach(fun(N) -> + rpc:call(N, ?MODULE, start_tracer, []) + end, Nodes), + + Cf = #cf{link = none, ping = A2, n1 = node(), n2 = A2, + nodes = [node(), N1, A2, Z2], n_res = 2, config = Config}, + + %% Halt z_2. + res(?RES(halt_second), Cps, Cf#cf{link = N1, n1 = N1, n2 = Z2, ping = A2, + nodes = [node(), N1, A2], n_res = 1}), + + ?line lists:foreach(fun(N) -> + rpc:call(N, ?MODULE, stop_tracer, []) + end, Nodes), + + ?line OrigNames = global:registered_names(), + write_high_level_trace(Config), + stop_nodes(Cps), % Not all nodes may be present, but it works anyway. + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +simple_resolve3(suite) -> []; +simple_resolve3(doc) -> ["OTP-5563. Partitions and names."]; +simple_resolve3(Config) when is_list(Config) -> + %% Continuation of simple_resolve. + + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line [N1, A2, Z2] = Cps = start_nodes([n_1, a_2, z_2], peer, Config), + ?line wait_for_ready_net(Config), + Nodes = lists:sort([node() | Cps]), + + lists:foreach(fun(N) -> + rpc:call(N, ?MODULE, start_tracer, []) + end, Nodes), + + Cf = #cf{link = none, ping = A2, n1 = node(), n2 = A2, + nodes = [node(), N1, A2, Z2], n_res = 2, config = Config}, + + %% Halt a_2. + res(?RES(halt_second), Cps, Cf#cf{link = node(), n2 = A2, + nodes = [node(), N1], n_res = 1}), + + ?line lists:foreach(fun(N) -> + rpc:call(N, ?MODULE, stop_tracer, []) + end, Nodes), + + ?line OrigNames = global:registered_names(), + write_high_level_trace(Config), + stop_nodes(Cps), % Not all nodes may be present, but it works anyway. + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +res({Res,Resolver}, [N1, A2, Z2], Cf) -> + %% Note: there are no links anymore, but monitors. + #cf{link = LinkedNode, ping = PingNode, n1 = Res1, n2 = OtherNode, + nodes = Nodes0, n_res = NRes, config = Config} = Cf, + ?t:format("~n~nResolver: ~p", [Res]), + ?t:format(" Registered on partition 1: ~p", [Res1]), + ?t:format(" Registered on partition 2: ~p", [OtherNode]), + ?t:format(" Pinged node: ~p", [PingNode]), + ?t:format(" Linked node: ~p", [LinkedNode]), + ?t:format(" Expected # resolvers: ~p", [NRes]), + Nodes = lists:sort(Nodes0), + T1 = node(), + Part1 = [T1, N1], + Part2 = [A2, Z2], + Name = name, + + %% A registered name is resolved in different scenarios with just + %% four nodes. In each scenario it is checked that exactly the + %% expected monitors remain between registered processes and the + %% global_name_server. + + ?line rpc_cast(OtherNode, + ?MODULE, + part_2_2, + [Config, Part1, Part2, [{Name, Resolver}]]), + ?line ?UNTIL(is_ready_partition(Config)), + ?line {_Pid1, yes} = + rpc:call(Res1, ?MODULE, start_resolver, [Name, Resolver]), + + ?line pong = net_adm:ping(PingNode), + ?line wait_for_ready_net(Nodes, Config), + + ?line check_everywhere(Nodes, Name, Config), + ?line case global:whereis_name(Name) of + undefined when LinkedNode =:= none -> ok; + Pid -> assert_pid(Pid) + end, + + ?line {_, Trace0} = collect_tracers(Nodes), + ?line Resolvers = [P || {_Node,new_resolver,{pid,P}} <- Trace0], + + ?line NRes = length(Resolvers), + + %% Wait for extra monitor processes to be created. + %% This applies as long as global:do_monitor/1 spawns processes. + %% (Some day monitor() will be truly synchronous.) + test_server:sleep(100), + + ?line lists:foreach(fun(P) -> P ! die end, Resolvers), + ?line lists:foreach(fun(P) -> wait_for_exit(P) end, Resolvers), + + ?line check_everywhere(Nodes, Name, Config), + ?line undefined = global:whereis_name(Name), + + %% Wait for monitors to remove names. + test_server:sleep(100), + + ?line {_, Trace1} = collect_tracers(Nodes), + Trace = Trace0 ++ Trace1, + + ?line Gs = name_servers([T1, N1, A2, Z2]), + ?line MonitoredByNode = monitored_by_node(Trace, Gs), + ?line MonitoredBy = [M || {_N,M} <- MonitoredByNode], + + X = MonitoredBy -- Gs, + LengthGs = length(Gs), + ?line case MonitoredBy of + [] when LinkedNode =:= none -> ok; + Gs -> ok; + _ when LengthGs < 4, X =:= [] -> ok; + _ -> ?t:format("ERROR:~nMonitoredBy ~p~n" + "global_name_servers ~p~n", + [MonitoredByNode, Gs]), + ?t:fail(monitor_mismatch) + end, + ok. + +name_servers(Nodes) -> + lists:sort([rpc:call(N, erlang, whereis, [global_name_server]) || + N <- Nodes, + pong =:= net_adm:ping(N)]). + +monitored_by_node(Trace, Servers) -> + lists:sort([{node(M),M} || + {_Node,_P,died,{monitors_2levels,ML}} <- Trace, + M <- ML, + lists:member(M, Servers)]). + +%% Runs on a node in Part2 +part_2_2(Config, Part1, Part2, NameResolvers) -> + make_partition(Config, Part1, Part2), + lists:foreach + (fun({Name, Resolver}) -> + ?line {Pid2, yes} = start_resolver(Name, Resolver), + trace_message({node(), part_2_2, nodes(), {pid2,Pid2}}) + end, NameResolvers). + +resolve_first(name, Pid1, _Pid2) -> + Pid1. + +resolve_second(name, _Pid1, Pid2) -> + Pid2. + +resolve_none(name, _Pid1, _Pid2) -> + none. + +bad_resolver(name, _Pid1, _Pid2) -> + bad_answer. + +badrpc_resolver(name, _Pid1, _Pid2) -> + {badrpc, badrpc}. + +exit_resolver(name, _Pid1, _Pid2) -> + erlang:error(bad_resolver). + +lock_resolver(name, Pid1, _Pid2) -> + Id = {?MODULE, self()}, + Nodes = [node()], + ?line true = global:set_lock(Id, Nodes), + _ = global:del_lock(Id, Nodes), + Pid1. + +disconnect_first(name, Pid1, Pid2) -> + Name = disconnect_first_name, + case whereis(Name) of + undefined -> + spawn(fun() -> disconnect_first_name(Name) end), + true = erlang:disconnect_node(node(Pid1)); + Pid when is_pid(Pid) -> + Pid ! die + end, + Pid2. + +disconnect_first_name(Name) -> + register(Name, self()), + receive die -> ok end. + +halt_second(name, _Pid1, Pid2) -> + rpc:call(node(Pid2), erlang, halt, []), + Pid2. + +start_resolver(Name, Resolver) -> + Self = self(), + Pid = spawn(fun() -> init_resolver(Self, Name, Resolver) end), + trace_message({node(), new_resolver, {pid, Pid}}), + receive + {Pid, Res} -> {Pid, Res} + end. + +init_resolver(Parent, Name, Resolver) -> + X = global:register_name(Name, self(), Resolver), + Parent ! {self(), X}, + loop_resolver(). + +loop_resolver() -> + receive + die -> + trace_message({node(), self(), died, mon_by_servers(self())}), + exit(normal) + end. + +%% The server sometimes uses an extra process for monitoring. +%% The server monitors that extra process. +mon_by_servers(Proc) -> + {monitored_by, ML} = process_info(Proc, monitored_by), + {monitors_2levels, + lists:append([ML | + [begin + {monitored_by, MML} = rpc:call(node(M), + erlang, + process_info, + [M, monitored_by]), + MML + end || M <- ML]])}. + +-define(REGNAME, contact_a_2). + +leftover_name(suite) -> []; +leftover_name(doc) -> ["OTP-5563. Bug: nodedown while synching."]; +leftover_name(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + ?line [N1, A2, Z2] = Cps = start_nodes([n_1, a_2, z_2], peer, Config), + Nodes = lists:sort([node() | Cps]), + ?line wait_for_ready_net(Config), + + lists:foreach(fun(N) -> + rpc:call(N, ?MODULE, start_tracer, []) + end, Nodes), + + Name = name, % registered on a_2 + ResName = resolved_name, % registered on n_1 and a_2 + %% + ?line _Pid = ping_a_2_fun(?REGNAME, N1, A2), + + T1 = node(), + Part1 = [T1, N1], + Part2 = [A2, Z2], + NoResolver = {no_module, resolve_none}, + Resolver = fun contact_a_2/3, + ?line rpc_cast(A2, + ?MODULE, part_2_2, [Config, + Part1, + Part2, + [{Name, NoResolver}, + {ResName, Resolver}]]), + ?line ?UNTIL(is_ready_partition(Config)), + + %% resolved_name is resolved to run on a_2, an insert operation is + %% sent to n_1. The resolver function halts a_2, but the nodedown + %% message is handled by n_1 _before_ the insert operation is run + %% (at least every now and then; sometimes it seems to be + %% delayed). Unless "artificial" nodedown messages are sent the + %% name would linger on indefinitely. [There is no test case for + %% the situation that no nodedown message at all is sent.] + ?line {_Pid1, yes} = + rpc:call(N1, ?MODULE, start_resolver, + [ResName, fun contact_a_2/3]), + test_server:sleep(1000), + + ?line trace_message({node(), pinging, z_2}), + ?line pong = net_adm:ping(Z2), + ?line ?UNTIL((Nodes -- [A2]) =:= lists:sort(?NODES)), + ?t:sleep(1000), + + ?line {_,Trace0} = collect_tracers(Nodes), + + ?line Resolvers = [P || {_Node,new_resolver,{pid,P}} <- Trace0], + ?line lists:foreach(fun(P) -> P ! die end, Resolvers), + ?line lists:foreach(fun(P) -> wait_for_exit(P) end, Resolvers), + + ?line lists:foreach(fun(N) -> + rpc:call(N, ?MODULE, stop_tracer, []) + end, Nodes), + + ?line ?UNTIL(OrigNames =:= global:registered_names()), + write_high_level_trace(Config), + stop_nodes(Cps), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Runs on n_1 +contact_a_2(resolved_name, Pid1, Pid2) -> + trace_message({node(), ?REGNAME, {pid1,Pid1}, {pid2,Pid2}, + {node1,node(Pid1)}, {node2,node(Pid2)}}), + ?REGNAME ! doit, + Pid2. + +ping_a_2_fun(RegName, N1, A2) -> + spawn(N1, fun() -> ping_a_2(RegName, N1, A2) end). + +ping_a_2(RegName, N1, A2) -> + register(RegName, self()), + receive doit -> + trace_message({node(), ping_a_2, {a2, A2}}), + monitor_node(A2, true), + %% Establish contact with a_2, then take it down. + rpc:call(N1, ?MODULE, halt_node, [A2]), + receive + {nodedown, A2} -> ok + end + end. + +halt_node(Node) -> + rpc:call(Node, erlang, halt, []). + +%%%----------------------------------------------------------------- +%%% Testing re-registration of a name. +%%%----------------------------------------------------------------- +re_register_name(suite) -> []; +re_register_name(doc) -> ["OTP-5563. Name is re-registered."]; +re_register_name(Config) when is_list(Config) -> + %% When re-registering a name the link to the old pid used to + %% linger on. Don't think is was a serious bug though--some memory + %% occupied by links, that's all. + %% Later: now monitors are checked. + Timeout = 15, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + Me = self(), + Pid1 = spawn(fun() -> proc(Me) end), + ?line yes = global:register_name(name, Pid1), + Pid2 = spawn(fun() -> proc(Me) end), + ?line _ = global:re_register_name(name, Pid2), + Pid2 ! die, + Pid1 ! die, + receive {Pid1, MonitoredBy1} -> [] = MonitoredBy1 end, + receive {Pid2, MonitoredBy2} -> [_] = MonitoredBy2 end, + ?line _ = global:unregister_name(name), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +proc(Parent) -> + receive die -> ok end, + {monitored_by, MonitoredBy} = process_info(self(), monitored_by), + Parent ! {self(), MonitoredBy}. + + +%%%----------------------------------------------------------------- +%%% +%%%----------------------------------------------------------------- +name_exit(suite) -> []; +name_exit(doc) -> ["OTP-5563. Registered process dies."]; +name_exit(Config) when is_list(Config) -> + case ?t:is_release_available("r11b") of + true -> + StartOldFun = + fun() -> + {ok, N1} = start_node_rel(n_1, r11b, Config), + {ok, N2} = start_node_rel(n_2, this, Config), + [N1, N2] + end, + ?t:format("Test of r11~n"), + do_name_exit(StartOldFun, old, Config); + false -> + ok + end, + StartFun = fun() -> + {ok, N1} = start_node_rel(n_1, this, Config), + {ok, N2} = start_node_rel(n_2, this, Config), + [N1, N2] + end, + ?t:format("Test of current release~n"), + do_name_exit(StartFun, current, Config). + +do_name_exit(StartFun, Version, Config) -> + %% When a registered process dies, the node where it is registered + %% removes the name from the table immediately, and then removes + %% it from other nodes using a lock. + %% This is perhaps not how it should work, but it is not easy to + %% change. + %% See also OTP-3737. + %% + %% The current release uses monitors so this test is not so relevant. + + Timeout = 60, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + %% Three nodes (test_server, n_1, n_2). + ?line Cps = StartFun(), + Nodes = lists:sort([node() | Cps]), + ?line wait_for_ready_net(Config), + lists:foreach(fun(N) -> rpc:call(N, ?MODULE, start_tracer, []) end,Nodes), + + Name = name, + ?line {Pid, yes} = start_proc(Name), + + Me = self(), + LL = spawn(fun() -> long_lock(Me) end), + receive + long_lock_taken -> ok + end, + + Pid ! die, + wait_for_exit_fast(Pid), + + ?t:sleep(100), + %% Name has been removed from node()'s table, but nowhere else + %% since there is a lock on 'global'. + {R1,[]} = rpc:multicall(Nodes, global, whereis_name, [Name]), + ?line case Version of + old -> [_,_] = lists:usort(R1); + current -> [undefined, undefined, undefined] = R1 + end, + ?t:sleep(3000), + ?line check_everywhere(Nodes, Name, Config), + + lists:foreach(fun(N) -> rpc:call(N, ?MODULE, stop_tracer, []) end, Nodes), + ?line OrigNames = global:registered_names(), + exit(LL, kill), + write_high_level_trace(Config), + stop_nodes(Cps), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +long_lock(Parent) -> + global:trans({?GLOBAL_LOCK,self()}, + fun() -> + Parent ! long_lock_taken, + timer:sleep(3000) + end). + +%%%----------------------------------------------------------------- +%%% Testing the support for external nodes (cnodes) +%%%----------------------------------------------------------------- +external_nodes(suite) -> []; +external_nodes(doc) -> ["OTP-5563. External nodes (cnodes)."]; +external_nodes(Config) when is_list(Config) -> + Timeout = 30, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + ?line [NodeB, NodeC] = start_nodes([b, c], peer, Config), + ?line wait_for_ready_net(Config), + + %% Nodes = ?NODES, + %% lists:foreach(fun(N) -> rpc:call(N, ?MODULE, start_tracer, []) end, + %% Nodes), + Name = name, + + %% Two partitions: [test_server] and [b, c]. + %% c registers an external name on b + ?line rpc_cast(NodeB, ?MODULE, part_ext, + [Config, node(), NodeC, Name]), + ?line ?UNTIL(is_ready_partition(Config)), + + ?line pong = net_adm:ping(NodeB), + ?line ?UNTIL([NodeB, NodeC] =:= lists:sort(nodes())), + ?line wait_for_ready_net(Config), + + ?line Cpid = rpc:call(NodeC, erlang, whereis, [Name]), + ExternalName = [{name,Cpid,NodeB}], + ?line ExternalName = get_ext_names(), + ?line ExternalName = rpc:call(NodeB, gen_server, call, + [global_name_server, get_names_ext]), + ?line ExternalName = rpc:call(NodeC, gen_server, call, + [global_name_server, get_names_ext]), + + ?line [_] = cnode_links(Cpid), + ?line [_,_,_] = cnode_monitored_by(Cpid), + ?line no = global:register_name(Name, self()), + ?line yes = global:re_register_name(Name, self()), + ?line ?UNTIL([] =:= cnode_monitored_by(Cpid)), + ?line ?UNTIL([] =:= cnode_links(Cpid)), + ?line [] = gen_server:call(global_name_server, get_names_ext, infinity), + + ?line Cpid ! {register, self(), Name}, + ?line receive {Cpid, Reply1} -> no = Reply1 end, + ?line _ = global:unregister_name(Name), + test_server:sleep(1000), + ?line Cpid ! {register, self(), Name}, + ?line ?UNTIL(length(get_ext_names()) =:= 1), + ?line receive {Cpid, Reply2} -> yes = Reply2 end, + + ?line Cpid ! {unregister, self(), Name}, + ?line ?UNTIL(length(get_ext_names()) =:= 0), + ?line receive {Cpid, Reply3} -> ok = Reply3 end, + + Cpid ! die, + ?line ?UNTIL(OrigNames =:= global:registered_names()), + ?line [] = get_ext_names(), + ?line [] = rpc:call(NodeB, gen_server, call, + [global_name_server, get_names_ext]), + ?line [] = rpc:call(NodeC, gen_server, call, + [global_name_server, get_names_ext]), + + ?line Cpid2 = erlang:spawn(NodeC, fun() -> cnode_proc(NodeB) end), + ?line Cpid2 ! {register, self(), Name}, + ?line receive {Cpid2, Reply4} -> yes = Reply4 end, + + %% It could be a bug that Cpid2 is linked to 'global_name_server' + %% at node 'b'. The effect: Cpid2 dies when node 'b' crashes. + stop_node(NodeB), + ?line ?UNTIL(OrigNames =:= global:registered_names()), + ?line [] = get_ext_names(), + ?line [] = rpc:call(NodeC, gen_server, call, + [global_name_server, get_names_ext]), + + %% ?line {_, Trace} = collect_tracers(Nodes), + %% lists:foreach(fun(M) -> erlang:display(M) end, Trace), + + ThisNode = node(), + ?line Cpid3 = erlang:spawn(NodeC, fun() -> cnode_proc(ThisNode) end), + ?line Cpid3 ! {register, self(), Name}, + ?line receive {Cpid3, Reply5} -> yes = Reply5 end, + + ?line ?UNTIL(length(get_ext_names()) =:= 1), + stop_node(NodeC), + ?line ?UNTIL(length(get_ext_names()) =:= 0), + + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +get_ext_names() -> + gen_server:call(global_name_server, get_names_ext, infinity). + +%% Runs at B +part_ext(Config, Main, C, Name) -> + make_partition(Config, [Main], [node(), C]), + ThisNode = node(), + Pid = erlang:spawn(C, fun() -> cnode_proc(ThisNode) end), + Pid ! {register, self(), Name}, + receive {Pid, Reply} -> yes = Reply end, + rpc:call(C, erlang, register, [Name, Pid]). + +cnode_links(Pid) -> + Pid ! {links, self()}, + receive + {links, Links} -> + Links + end. + +cnode_monitored_by(Pid) -> + Pid ! {monitored_by, self()}, + receive + {monitored_by, MonitoredBy} -> + MonitoredBy + end. + +cnode_proc(E) -> + receive + {register, From, Name} -> + Rep = rpc:call(E, global, register_name_external, [Name, self()]), + From ! {self(), Rep}; + {unregister, From, Name} -> + _ = rpc:call(E, global, unregister_name_external, [Name]), + From ! {self(), ok}; + {links, From} -> + From ! process_info(self(), links); + {monitored_by, From} -> + From ! process_info(self(), monitored_by); + die -> + exit(normal) + end, + cnode_proc(E). + + +many_nodes(suite) -> + []; +many_nodes(doc) -> + ["OTP-5770. Start many nodes. Make them connect at the same time."]; +many_nodes(Config) when is_list(Config) -> + Timeout = 180, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + + {Rels, N_cps} = + case ?t:os_type() of + {unix, Osname} when Osname =:= linux; + Osname =:= openbsd; + Osname =:= darwin -> + N_nodes = quite_a_few_nodes(32), + {node_rel(1, N_nodes, this), N_nodes}; + {unix, _} -> + case ?t:is_release_available("r11b") of + true -> + This = node_rel(1, 16, this), + R11B = node_rel(17, 32, r11b), + {This ++ R11B, 32}; + false -> + {node_rel(1, 32, this), 32} + end; + _ -> + {node_rel(1, 32, this), 32} + end, + ?line Cps = [begin {ok, Cp} = start_node_rel(Name, Rel, Config), Cp end || + {Name,Rel} <- Rels], + Nodes = lists:sort(?NODES), + ?line wait_for_ready_net(Nodes, Config), + + ?line Dir = ?config(priv_dir, Config), + GoFile = filename:join([Dir, "go.txt"]), + file:delete(GoFile), + + CpsFiles = [{N, filename:join([Dir, atom_to_list(N)++".node"])} || + N <- Cps], + IsoFun = + fun({N, File}) -> + file:delete(File), + rpc_cast(N, ?MODULE, isolated_node, [File, GoFile, Cps, Config]) + end, + ?line lists:foreach(IsoFun, CpsFiles), + + ?line all_nodes_files(CpsFiles, "isolated", Config), + ?line Time = msec(), + ?line sync_until(), + erlang:display(ready_to_go), + ?line touch(GoFile, "go"), + ?line all_nodes_files(CpsFiles, "done", Config), + ?line Time2 = msec(), + + ?line lists:foreach(fun(N) -> pong = net_adm:ping(N) end, Cps), + + ?line wait_for_ready_net(Config), + + write_high_level_trace(Config), % The test succeeded, but was it slow? + + ?line lists:foreach(fun({_N, File}) -> file:delete(File) end, CpsFiles), + ?line file:delete(GoFile), + + ?line ?UNTIL(OrigNames =:= global:registered_names()), + write_high_level_trace(Config), + ?line stop_nodes(Cps), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + Diff = Time2 - Time, + Return = lists:flatten(io_lib:format("~w nodes took ~w ms", + [N_cps, Diff])), + erlang:display({{nodes,N_cps},{time,Diff}}), + ?t:format("~s~n", [Return]), + {comment, Return}. + +node_rel(From, To, Rel) -> + [{lists:concat([cp, N]), Rel} || N <- lists:seq(From, To)]. + +isolated_node(File, GoFile, Nodes, Config) -> + Ns = lists:sort(Nodes), + exit(erlang:whereis(user), kill), + touch(File, "start_isolated"), + NodesList = nodes(), + append_to_file(File, [{nodes,Nodes},{nodes_list,NodesList}]), + Replies = + lists:map(fun(N) -> _ = erlang:disconnect_node(N) end, NodesList), + append_to_file(File, {replies,Replies}), + ?UNTIL(begin + Known = get_known(node()), + append_to_file(File, {known,Known}), + Known =:= [node()] + end), + touch(File, "isolated"), + sync_until(File), + file_contents(GoFile, "go", Config, File), + touch(File, "got_go"), + lists:foreach(fun(N) -> _ = net_adm:ping(N) end, shuffle(Nodes)), + touch(File, "pinged"), + ?line ?UNTIL((Ns -- get_known(node())) =:= []), + touch(File, "done"). + +touch(File, List) -> + ok = file:write_file(File, list_to_binary(List)). + +append_to_file(File, Term) -> + {ok, Fd} = file:open(File, [raw,binary,append]), + ok = file:write(Fd, io_lib:format("~p.~n", [Term])), + ok = file:close(Fd). + +all_nodes_files(CpsFiles, ContentsList, Config) -> + lists:all(fun({_N,File}) -> + file_contents(File, ContentsList, Config) + end, CpsFiles). + +file_contents(File, ContentsList, Config) -> + file_contents(File, ContentsList, Config, no_log_file). + +file_contents(File, ContentsList, Config, LogFile) -> + Contents = list_to_binary(ContentsList), + Sz = size(Contents), + ?UNTIL(begin + case file:read_file(File) of + {ok, FileContents}=Reply -> + case catch split_binary(FileContents, Sz) of + {Contents,_} -> + true; + _ -> + catch append_to_file(LogFile, + {File,Contents,Reply}), + false + end; + Reply -> + catch append_to_file(LogFile, {File, Contents, Reply}), + false + end + end). + +sync_until() -> + sync_until(no_log_file). + +sync_until(LogFile) -> + Time = ?UNTIL_LOOP - (msec(now()) rem ?UNTIL_LOOP), + catch append_to_file(LogFile, {sync_until, Time}), + timer:sleep(Time). + +shuffle(L) -> + [E || {_, E} <- lists:keysort(1, [{random:uniform(), E} || E <- L])]. + +sync_0(suite) -> []; +sync_0(doc) -> + ["OTP-5770. sync/0."]; +sync_0(Config) when is_list(Config) -> + Timeout = 180, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + + N_cps = + case ?t:os_type() of + {unix, Osname} when Osname =:= linux; + Osname =:= openbsd; + Osname =:= darwin -> + quite_a_few_nodes(30); + {unix, sunos} -> + 30; + {unix, _} -> + 16; + _ -> + 30 + end, + + Names = [lists:concat([cp,N]) || N <- lists:seq(1, N_cps)], + Cps = start_and_sync(Names), + ?line wait_for_ready_net(Config), + write_high_level_trace(Config), + stop_nodes(Cps), + + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +start_and_sync([]) -> + []; +start_and_sync([Name | Names]) -> + ?line {ok, N} = start_node(Name, slave, []), + ?line {Time, _Void} = rpc:call(N, timer, tc, [global, sync, []]), + ?t:format("~p: ~p~n", [Name, Time]), + [N | start_and_sync(Names)]. + +%%%----------------------------------------------------------------- +%%% Testing of change of global_groups parameter. +%%%----------------------------------------------------------------- +global_groups_change(suite) -> []; +global_groups_change(doc) -> ["Test change of global_groups parameter."]; +global_groups_change(Config) -> + Timeout = 90, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line M = from($@, atom_to_list(node())), + + % Create the .app files and the boot script + ?line {KernelVer, StdlibVer} = create_script_dc("dc"), + ?line case is_real_system(KernelVer, StdlibVer) of + true -> + Options = []; + false -> + Options = [local] + end, + + ?line ok = systools:make_script("dc", Options), + + [Ncp1,Ncp2,Ncp3,Ncp4,Ncp5,NcpA,NcpB,NcpC,NcpD,NcpE] = + node_names([cp1,cp2,cp3,cp4,cp5,cpA,cpB,cpC,cpD,cpE], Config), + + % Write config files + ?line Dir = ?config(priv_dir,Config), + ?line {ok, Fd_dc} = file:open(filename:join(Dir, "sys.config"), [write]), + ?line config_dc1(Fd_dc, Ncp1, Ncp2, Ncp3, NcpA, NcpB, NcpC, NcpD, NcpE), + ?line file:close(Fd_dc), + ?line Config1 = filename:join(Dir, "sys"), + + % Test [cp1, cp2, cp3] + ?line {ok, Cp1} = start_node_boot(Ncp1, Config1, dc), + ?line {ok, Cp2} = start_node_boot(Ncp2, Config1, dc), + ?line {ok, Cp3} = start_node_boot(Ncp3, Config1, dc), + ?line {ok, CpA} = start_node_boot(NcpA, Config1, dc), + ?line {ok, CpB} = start_node_boot(NcpB, Config1, dc), + ?line {ok, CpC} = start_node_boot(NcpC, Config1, dc), + ?line {ok, CpD} = start_node_boot(NcpD, Config1, dc), + ?line {ok, CpE} = start_node_boot(NcpE, Config1, dc), + + ?line pong = rpc:call(Cp1, net_adm, ping, [Cp2]), + ?line pong = rpc:call(Cp1, net_adm, ping, [Cp3]), + ?line pang = rpc:call(Cp1, net_adm, ping, + [list_to_atom(lists:concat(["cp5@", M]))]), + ?line pong = rpc:call(Cp2, net_adm, ping, [Cp3]), + ?line pang = rpc:call(Cp2, net_adm, ping, + [list_to_atom(lists:concat(["cp5@", M]))]), + + ?line {TestGG4, yes} = rpc:call(CpB, ?MODULE, start_proc, [test]), + ?line {TestGG5, yes} = rpc:call(CpE, ?MODULE, start_proc, [test]), + + + ?line pong = rpc:call(CpA, net_adm, ping, [CpC]), + ?line pong = rpc:call(CpC, net_adm, ping, [CpB]), + ?line pong = rpc:call(CpD, net_adm, ping, [CpC]), + ?line pong = rpc:call(CpE, net_adm, ping, [CpD]), + + ?line + ?UNTIL(begin + TestGG4_1 = rpc:call(CpA, global, whereis_name, [test]), + TestGG4_2 = rpc:call(CpB, global, whereis_name, [test]), + TestGG4_3 = rpc:call(CpC, global, whereis_name, [test]), + + TestGG5_1 = rpc:call(CpD, global, whereis_name, [test]), + TestGG5_2 = rpc:call(CpE, global, whereis_name, [test]), + io:format("~p~n", [[TestGG4, TestGG4_1, TestGG4_2,TestGG4_3]]), + io:format("~p~n", [[TestGG5, TestGG5_1, TestGG5_2]]), + (TestGG4_1 =:= TestGG4) and + (TestGG4_2 =:= TestGG4) and + (TestGG4_3 =:= TestGG4) and + (TestGG5_1 =:= TestGG5) and + (TestGG5_2 =:= TestGG5) + end), + + ?line ?t:format( "#### nodes() ~p~n",[nodes()]), + + ?line XDcWa1 = rpc:call(Cp1, global_group, info, []), + ?line XDcWa2 = rpc:call(Cp2, global_group, info, []), + ?line XDcWa3 = rpc:call(Cp3, global_group, info, []), + ?line ?t:format( "#### XDcWa1 ~p~n",[XDcWa1]), + ?line ?t:format( "#### XDcWa2 ~p~n",[XDcWa2]), + ?line ?t:format( "#### XDcWa3 ~p~n",[XDcWa3]), + + ?line stop_node(CpC), + + %% Read the current configuration parameters, and change them + ?line OldEnv = + rpc:call(Cp1, application_controller, prep_config_change, []), + ?line {value, {kernel, OldKernel}} = lists:keysearch(kernel, 1, OldEnv), + + ?line GG1 = + lists:sort([mk_node(Ncp1, M), mk_node(Ncp2, M), mk_node(Ncp5, M)]), + ?line GG2 = lists:sort([mk_node(Ncp3, M)]), + ?line GG3 = lists:sort([mk_node(Ncp4, M)]), + ?line GG4 = lists:sort([mk_node(NcpA, M), mk_node(NcpB, M)]), + ?line GG5 = + lists:sort([mk_node(NcpC, M), mk_node(NcpD, M), mk_node(NcpE, M)]), + + ?line NewNG = {global_groups,[{gg1, normal, GG1}, + {gg2, normal, GG2}, + {gg3, normal, GG3}, + {gg4, normal, GG4}, + {gg5, hidden, GG5}]}, + + ?line NewKernel = + [{kernel, lists:keyreplace(global_groups, 1, OldKernel, NewNG)}], + ?line ok = rpc:call(Cp1, application_controller, test_change_apps, + [[kernel], [NewKernel]]), + ?line ok = rpc:call(Cp2, application_controller, test_change_apps, + [[kernel], [NewKernel]]), + ?line ok = rpc:call(Cp3, application_controller, test_change_apps, + [[kernel], [NewKernel]]), + ?line ok = rpc:call(CpA, application_controller, test_change_apps, + [[kernel], [NewKernel]]), + ?line ok = rpc:call(CpB, application_controller, test_change_apps, + [[kernel], [NewKernel]]), + ?line ok = rpc:call(CpD, application_controller, test_change_apps, + [[kernel], [NewKernel]]), + ?line ok = rpc:call(CpE, application_controller, test_change_apps, + [[kernel], [NewKernel]]), + + ?line ?t:format("#### ~p~n",[multicall]), + ?line ?t:format( "#### ~p~n",[multicall]), + %% no idea to check the result from the rpc because the other + %% nodes will disconnect test server, and thus the result will + %% always be {badrpc, nodedown} + ?line rpc:multicall([Cp1, Cp2, Cp3, CpA, CpB, CpD, CpE], + application_controller, config_change, [OldEnv]), + + ?line {ok, Fd_dc2} = file:open(filename:join(Dir, "sys2.config"), [write]), + ?line config_dc2(Fd_dc2, NewNG, Ncp1, Ncp2, Ncp3), + ?line file:close(Fd_dc2), + ?line Config2 = filename:join(Dir, "sys2"), + ?line {ok, CpC} = start_node_boot(NcpC, Config2, dc), + + ?line sync_and_wait(CpA), + ?line sync_and_wait(CpD), + + ?line pong = rpc:call(CpA, net_adm, ping, [CpC]), + ?line pong = rpc:call(CpC, net_adm, ping, [CpB]), + ?line pong = rpc:call(CpD, net_adm, ping, [CpC]), + ?line pong = rpc:call(CpE, net_adm, ping, [CpD]), + + ?line GG5 = + lists:sort([mk_node(NcpC, M)|rpc:call(CpC, erlang, nodes, [])]), + ?line GG5 = + lists:sort([mk_node(NcpD, M)|rpc:call(CpD, erlang, nodes, [])]), + ?line GG5 = + lists:sort([mk_node(NcpE, M)|rpc:call(CpE, erlang, nodes, [])]), + + ?line false = + lists:member(mk_node(NcpC, M), rpc:call(CpA, erlang, nodes, [])), + ?line false = + lists:member(mk_node(NcpC, M), rpc:call(CpB, erlang, nodes, [])), + + ?line + ?UNTIL(begin + TestGG4a = rpc:call(CpA, global, whereis_name, [test]), + TestGG4b = rpc:call(CpB, global, whereis_name, [test]), + + TestGG5c = rpc:call(CpC, global, whereis_name, [test]), + TestGG5d = rpc:call(CpD, global, whereis_name, [test]), + TestGG5e = rpc:call(CpE, global, whereis_name, [test]), + io:format("~p~n", [[TestGG4, TestGG4a, TestGG4b]]), + io:format("~p~n", [[TestGG5, TestGG5c, TestGG5d, TestGG5e]]), + (TestGG4 =:= TestGG4a) and + (TestGG4 =:= TestGG4b) and + (TestGG5 =:= TestGG5c) and + (TestGG5 =:= TestGG5d) and + (TestGG5 =:= TestGG5e) + end), + + ?line Info1 = rpc:call(Cp1, global_group, info, []), + ?line Info2 = rpc:call(Cp2, global_group, info, []), + ?line Info3 = rpc:call(Cp3, global_group, info, []), + ?line InfoA = rpc:call(CpA, global_group, info, []), + ?line InfoB = rpc:call(CpB, global_group, info, []), + ?line InfoC = rpc:call(CpC, global_group, info, []), + ?line InfoD = rpc:call(CpD, global_group, info, []), + ?line InfoE = rpc:call(CpE, global_group, info, []), + ?line ?t:format( "#### Info1 ~p~n",[Info1]), + ?line ?t:format( "#### Info2 ~p~n",[Info2]), + ?line ?t:format( "#### Info3 ~p~n",[Info3]), + ?line ?t:format( "#### InfoA ~p~n",[InfoA]), + ?line ?t:format( "#### InfoB ~p~n",[InfoB]), + ?line ?t:format( "#### InfoC ~p~n",[InfoC]), + ?line ?t:format( "#### InfoD ~p~n",[InfoD]), + ?line ?t:format( "#### InfoE ~p~n",[InfoE]), + + ?line {global_groups, GGNodes} = NewNG, + + ?line Info1ok = [{state, synced}, + {own_group_name, gg1}, + {own_group_nodes, GG1}, + {synced_nodes, [mk_node(Ncp2, M)]}, + {sync_error, []}, + {no_contact, [mk_node(Ncp5, M)]}, + {other_groups, remove_gg_pub_type(lists:keydelete + (gg1, 1, GGNodes))}, + {monitoring, []}], + + + ?line Info2ok = [{state, synced}, + {own_group_name, gg1}, + {own_group_nodes, GG1}, + {synced_nodes, [mk_node(Ncp1, M)]}, + {sync_error, []}, + {no_contact, [mk_node(Ncp5, M)]}, + {other_groups, remove_gg_pub_type(lists:keydelete + (gg1, 1, GGNodes))}, + {monitoring, []}], + + ?line Info3ok = [{state, synced}, + {own_group_name, gg2}, + {own_group_nodes, GG2}, + {synced_nodes, []}, + {sync_error, []}, + {no_contact, []}, + {other_groups, remove_gg_pub_type(lists:keydelete + (gg2, 1, GGNodes))}, + {monitoring, []}], + + ?line InfoAok = [{state, synced}, + {own_group_name, gg4}, + {own_group_nodes, GG4}, + {synced_nodes, lists:delete(mk_node(NcpA, M), GG4)}, + {sync_error, []}, + {no_contact, []}, + {other_groups, remove_gg_pub_type(lists:keydelete + (gg4, 1, GGNodes))}, + {monitoring, []}], + + ?line InfoBok = [{state, synced}, + {own_group_name, gg4}, + {own_group_nodes, GG4}, + {synced_nodes, lists:delete(mk_node(NcpB, M), GG4)}, + {sync_error, []}, + {no_contact, []}, + {other_groups, remove_gg_pub_type(lists:keydelete + (gg4, 1, GGNodes))}, + {monitoring, []}], + + ?line InfoCok = [{state, synced}, + {own_group_name, gg5}, + {own_group_nodes, GG5}, + {synced_nodes, lists:delete(mk_node(NcpC, M), GG5)}, + {sync_error, []}, + {no_contact, []}, + {other_groups, remove_gg_pub_type(lists:keydelete + (gg5, 1, GGNodes))}, + {monitoring, []}], + + ?line InfoDok = [{state, synced}, + {own_group_name, gg5}, + {own_group_nodes, GG5}, + {synced_nodes, lists:delete(mk_node(NcpD, M), GG5)}, + {sync_error, []}, + {no_contact, []}, + {other_groups, remove_gg_pub_type(lists:keydelete + (gg5, 1, GGNodes))}, + {monitoring, []}], + + ?line InfoEok = [{state, synced}, + {own_group_name, gg5}, + {own_group_nodes, GG5}, + {synced_nodes, lists:delete(mk_node(NcpE, M), GG5)}, + {sync_error, []}, + {no_contact, []}, + {other_groups, remove_gg_pub_type(lists:keydelete + (gg5, 1, GGNodes))}, + {monitoring, []}], + + + ?line case Info1 of + Info1ok -> + ok; + _ -> + test_server:fail({{"could not change the global groups" + " in node", Cp1}, {Info1, Info1ok}}) + end, + + ?line case Info2 of + Info2ok -> + ok; + _ -> + test_server:fail({{"could not change the global groups" + " in node", Cp2}, {Info2, Info2ok}}) + end, + + ?line case Info3 of + Info3ok -> + ok; + _ -> + test_server:fail({{"could not change the global groups" + " in node", Cp3}, {Info3, Info3ok}}) + end, + + ?line case InfoA of + InfoAok -> + ok; + _ -> + test_server:fail({{"could not change the global groups" + " in node", CpA}, {InfoA, InfoAok}}) + end, + + ?line case InfoB of + InfoBok -> + ok; + _ -> + test_server:fail({{"could not change the global groups" + " in node", CpB}, {InfoB, InfoBok}}) + end, + + + ?line case InfoC of + InfoCok -> + ok; + _ -> + test_server:fail({{"could not change the global groups" + " in node", CpC}, {InfoC, InfoCok}}) + end, + + ?line case InfoD of + InfoDok -> + ok; + _ -> + test_server:fail({{"could not change the global groups" + " in node", CpD}, {InfoD, InfoDok}}) + end, + + ?line case InfoE of + InfoEok -> + ok; + _ -> + test_server:fail({{"could not change the global groups" + " in node", CpE}, {InfoE, InfoEok}}) + end, + + write_high_level_trace(Config), % no good since CpC was restarted + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + stop_node(CpA), + stop_node(CpB), + stop_node(CpC), + stop_node(CpD), + stop_node(CpE), + + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +sync_and_wait(Node) -> + Ref = make_ref(), + Self = self(), + spawn(Node, fun () -> + global_group:sync(), + case whereis(global_group_check) of + P when is_pid(P) -> + Self ! {Ref, P}; + _ -> + Self ! {Ref, done} + end + end), + receive + {Ref, P} when is_pid(P) -> + MonRef = erlang:monitor(process, P), + receive + {'DOWN',MonRef,process,P,_} -> + ok + end; + {Ref, _} -> + ok + end. + +%%% Copied from init_SUITE.erl. +is_real_system(KernelVsn, StdlibVsn) -> + LibDir = code:lib_dir(), + filelib:is_dir(filename:join(LibDir, "kernel-" ++ KernelVsn)) + andalso + filelib:is_dir(filename:join(LibDir, "stdlib-" ++ StdlibVsn)). + +create_script_dc(ScriptName) -> + ?line Name = filename:join(".", ScriptName), + ?line Apps = application_controller:which_applications(), + ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + ?line {ok,Fd} = file:open(Name ++ ".rel", [write]), + ?line {_, Version} = init:script_id(), + ?line io:format(Fd, + "{release, {\"Test release 3\", \"~s\"}, \n" + " {erts, \"4.4\"}, \n" + " [{kernel, \"~s\"}, {stdlib, \"~s\"}]}.\n", + [Version, KernelVer, StdlibVer]), + ?line file:close(Fd), + {KernelVer, StdlibVer}. + +%% Not used? +config_dc(Fd, Ncp1, Ncp2, Ncp3) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, 1000}," + "{global_groups, [{gg1, ['~s@~s', '~s@~s']}," + " {gg2, ['~s@~s']}]}" + " ]}].~n", + [Ncp1, M, Ncp2, M, Ncp3, M, Ncp1, M, Ncp2, M, Ncp3, M]). + + +config_dc1(Fd, Ncp1, Ncp2, Ncp3, NcpA, NcpB, NcpC, NcpD, NcpE) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s','~s@~s','~s@~s','~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, 1000}," + "{global_groups, [{gg1, ['~s@~s', '~s@~s']}," + " {gg2, ['~s@~s']}," + " {gg4, normal, ['~s@~s','~s@~s','~s@~s']}," + " {gg5, hidden, ['~s@~s','~s@~s']}]}]}].~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + NcpA, M, NcpB, M, NcpC, M, NcpD, M, NcpE, M, + Ncp1, M, Ncp2, M, + Ncp3, M, + NcpA, M, NcpB, M, NcpC, M, + NcpD, M, NcpE, M]). + +config_dc2(Fd, NewGG, Ncp1, Ncp2, Ncp3) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, 1000}," + "~p]}].~n", + [Ncp1, M, Ncp2, M, Ncp3, M, NewGG]). + + +from(H, [H | T]) -> T; +from(H, [_ | T]) -> from(H, T); +from(_H, []) -> []. + + + +other(A, [A, _B]) -> A; +other(_, [_A, B]) -> B. + + +%% this one runs at cp2 +part1(Config, Main, Cp1, Cp3) -> + case catch begin + make_partition(Config, [Main, Cp1], [node(), Cp3]), + ?line {_Pid, yes} = start_proc(test2), + ?line {_Pid2, yes} = start_proc(test4) + end of + {_, yes} -> ok; % w("ok", []); + {'EXIT', _R} -> + ok + % w("global_SUITE line:~w: ~p", [?LINE, _R]) + end. + +%% Runs at Cp2 +part1_5(Config, Main, Cp1, Cp3) -> + case catch begin + make_partition(Config, [Main, Cp1], [node(), Cp3]), + ?line {_Pid1, yes} = start_proc_basic(name12), + ?line {_Pid2, yes} = + rpc:call(Cp3, ?MODULE, start_proc_basic, [name03]) + end of + {_, yes} -> ok; % w("ok", []); + {'EXIT', _R} -> + ok + % w("global_SUITE line:~w: ~p", [?LINE, _R]) + end. + +w(X,Y) -> + {ok, F} = file:open("cp2.log", [write]), + io:format(F, X, Y), + file:close(F). + +%% this one runs on one node in Part2 +%% The partition is ready when is_ready_partition(Config) returns (true). +make_partition(Config, Part1, Part2) -> + Dir = ?config(priv_dir, Config), + Ns = [begin + Name = lists:concat([atom_to_list(N),"_",msec(),".part"]), + File = filename:join([Dir, Name]), + file:delete(File), + rpc_cast(N, ?MODULE, mk_part_node, [File, Part, Config], File), + {N, File} + end || Part <- [Part1, Part2], N <- Part], + all_nodes_files(Ns, "done", Config), + lists:foreach(fun({_N,File}) -> file:delete(File) end, Ns), + PartFile = make_partition_file(Config), + touch(PartFile, "done"). + +%% The node signals its success by touching a file. +mk_part_node(File, MyPart0, Config) -> + touch(File, "start"), % debug + MyPart = lists:sort(MyPart0), + ?UNTIL(is_node_in_part(File, MyPart)), + touch(File, "done"). + +%% The calls to append_to_file are for debugging. +is_node_in_part(File, MyPart) -> + lists:foreach(fun(N) -> + _ = erlang:disconnect_node(N) + end, nodes() -- MyPart), + case {(Known = get_known(node())) =:= MyPart, + (Nodes = lists:sort([node() | nodes()])) =:= MyPart} of + {true, true} -> + %% Make sure the resolvers have been terminated, + %% otherwise they may pop up and send some message. + %% (This check is probably unnecessary.) + case element(5, global:info()) of + [] -> + true; + Rs -> + erlang:display({is_node_in_part, resolvers, Rs}), + trace_message({node(), is_node_in_part, Rs}), + append_to_file(File, {now(), Known, Nodes, Rs}), + false + end; + _ -> + append_to_file(File, {now(), Known, Nodes}), + false + end. + +is_ready_partition(Config) -> + File = make_partition_file(Config), + file_contents(File, "done", Config), + file:delete(File), + true. + +make_partition_file(Config) -> + Dir = ?config(priv_dir, Config), + filename:join([Dir, atom_to_list(make_partition_done)]). + +%% this one runs at cp3 +part2(Config, Parent, Main, Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6) -> + make_partition(Config, [Main, Cp0, Cp1, Cp2], [Cp3, Cp4, Cp5, Cp6]), + start_procs(Parent, Cp4, Cp5, Cp6, Config). + +part3(Config, Parent, Main, Cp0, Cp1, Cp2, Cp3, Cp4, Cp5, Cp6) -> + make_partition(Config, [Main, Cp0, Cp1, Cp2], [Cp3, Cp4, Cp5, Cp6]), + start_procs(Parent, Cp4, Cp5, Cp6, Config), + % Make Cp6 alone + ?line rpc_cast(Cp5, ?MODULE, crash, [12000]), + ?line rpc_cast(Cp6, ?MODULE, alone, [Cp0, Cp3]). + +start_procs(Parent, N1, N2, N3, Config) -> + S1 = lists:sort([N1, N2, N3]), + ?line + ?UNTIL(begin + NN = lists:sort(nodes()), + S1 =:= NN + end), + ?line Pid3 = start_proc3(test1), + ?line Pid4 = rpc:call(N1, ?MODULE, start_proc3, [test2]), + ?line assert_pid(Pid4), + ?line Pid5 = rpc:call(N2, ?MODULE, start_proc3, [test3]), + ?line assert_pid(Pid5), + ?line Pid6 = rpc:call(N3, ?MODULE, start_proc3, [test4]), + ?line assert_pid(Pid6), + ?line yes = global:register_name(test1, Pid3), + ?line yes = global:register_name(test2, Pid4, {global, notify_all_name}), + ?line yes = global:register_name(test3, Pid5, {global, random_notify_name}), + Resolve = fun(Name, Pid1, Pid2) -> + Parent ! {resolve_called, Name, node()}, + {Min, Max} = minmax(Pid1, Pid2), + exit(Min, kill), + Max + end, + ?line yes = global:register_name(test4, Pid6, Resolve). + + + +collect_resolves() -> cr(0). +cr(Res) -> + receive + {resolve_called, Name, Node} -> + io:format("resolve called: ~w ~w~n", [Name, Node]), + cr(Res+1) + after + 0 -> Res + end. + +minmax(P1,P2) -> + if node(P1) < node(P2) -> {P1, P2}; true -> {P2, P1} end. + +fix_basic_name(name03, Pid1, Pid2) -> + case atom_to_list(node(Pid1)) of + [$c, $p, $3|_] -> exit(Pid2, kill), Pid1; + _ -> exit(Pid1, kill), Pid2 + end; +fix_basic_name(name12, Pid1, Pid2) -> + case atom_to_list(node(Pid1)) of + [$c, $p, $2|_] -> exit(Pid2, kill), Pid1; + _ -> exit(Pid1, kill), Pid2 + end. + +start_proc() -> + Pid = spawn(?MODULE, p_init, [self()]), + receive + Pid -> Pid + end. + + +start_proc(Name) -> + Pid = spawn(?MODULE, p_init, [self(), Name]), + receive + {Pid, Res} -> {Pid, Res} + end. + +start_proc2(Name) -> + Pid = spawn(?MODULE, p_init2, [self(), Name]), + receive + Pid -> Pid + end. + +start_proc3(Name) -> + Pid = spawn(?MODULE, p_init, [self()]), + register(Name, Pid), + receive + Pid -> Pid + end. + +start_proc4(Name) -> + Pid = spawn(?MODULE, p_init, [self()]), + yes = global:register_name(Name, Pid), + receive + Pid -> Pid + end. + +start_proc_basic(Name) -> + Pid = spawn(?MODULE, init_proc_basic, [self(), Name]), + receive + {Pid, Res} -> {Pid, Res} + end. + +init_proc_basic(Parent, Name) -> + X = global:register_name(Name, self(), {?MODULE, fix_basic_name}), + Parent ! {self(),X}, + loop(). + +single_node(Time, Node, Config) -> + exit(erlang:whereis(user), kill), + lists:foreach(fun(N) -> _ = erlang:disconnect_node(N) end, nodes()), + ?UNTIL(get_known(node()) =:= [node()]), + spawn(?MODULE, init_2, []), + test_server:sleep(Time - msec()), + net_adm:ping(Node). + +init_2() -> + register(single_name, self()), + yes = global:register_name(single_name, self()), + loop_2(). + +loop_2() -> + receive + die -> ok + end. + +msec() -> + msec(now()). + +msec(T) -> + element(1,T)*1000000000 + element(2,T)*1000 + element(3,T) div 1000. + +assert_pid(Pid) -> + if + is_pid(Pid) -> true; + true -> exit({not_a_pid, Pid}) + end. + +check_same([H|T]) -> check_same(T, H). + +check_same([H|T], H) -> check_same(T, H); +check_same([], _H) -> ok. + +check_same_p([H|T]) -> check_same_p(T, H). + +check_same_p([H|T], H) -> check_same_p(T, H); +check_same_p([], _H) -> true; +check_same_p(_, _) -> false. + +p_init(Parent) -> + Parent ! self(), + loop(). + +p_init(Parent, Name) -> + X = global:register_name(Name, self()), + Parent ! {self(),X}, + loop(). + +p_init2(Parent, Name) -> + _ = global:re_register_name(Name, self()), + Parent ! self(), + loop(). + +req(Pid, Msg) -> + Pid ! Msg, + receive X -> X end. + +sreq(Pid, Msg) -> + Ref = make_ref(), + Pid ! {Msg, Ref}, + receive {Ref, X} -> X end. + +alone(N1, N2) -> + lists:foreach(fun(Node) -> true = erlang:disconnect_node(Node) end, + nodes()), + test_server:sleep(12000), + net_adm:ping(N1), + net_adm:ping(N2), + yes = global:register_name(test5, self()). + +crash(Time) -> + test_server:sleep(Time), + erlang:halt(). + +loop() -> + receive + {ping, From} -> + From ! {pong, node()}, + loop(); + {del_lock, Id} -> + global:del_lock({Id, self()}), + loop(); + {del_lock_sync, Id, From} -> + global:del_lock({Id, self()}), + From ! true, + loop(); + {del_lock, Id, Nodes} -> + global:del_lock({Id, self()}, Nodes), + loop(); + {del_lock2, Id, From} -> + global:del_lock(Id), + From ! true, + loop(); + {del_lock2, Id, From, Nodes} -> + global:del_lock(Id, Nodes), + From ! true, + loop(); + {set_lock, Id, From} -> + Res = global:set_lock({Id, self()}, ?NODES, 1), + From ! Res, + loop(); + {set_lock, Id, From, Nodes} -> + Res = global:set_lock({Id, self()}, Nodes, 1), + From ! Res, + loop(); + {set_lock_loop, Id, From} -> + true = global:set_lock({Id, self()}, ?NODES), + From ! {got_lock, self()}, + loop(); + {set_lock2, Id, From} -> + Res = global:set_lock(Id, ?NODES, 1), + From ! Res, + loop(); + {{got_notify, From}, Ref} -> + receive + X when element(1, X) =:= global_name_conflict -> + From ! {Ref, yes} + after + 0 -> From ! {Ref, no} + end, + loop(); + die -> + exit(normal); + drop_dead -> + exit(drop_dead) + end. + +-ifdef(unused). +pr_diff(Str, T0, T1) -> + Diff = begin + {_, {H,M,S}} = calendar:time_difference(T0, T1), + ((H*60+M)*60)+S + end, + test_server:format(1,"~13s: ~w (diff: ~w)",[Str, T1, Diff]), + if + Diff > 100 -> + test_server:format(1,"~s: ** LARGE DIFF ~w~n", [Str, Diff]); + true -> + ok + end. +-endif. + +now_diff({A1,B1,C1},{A2,B2,C2}) -> + C1-C2 + 1000000*((B1-B2) + 1000000*(A1-A2)). + +start_node_boot(Name, Config, Boot) -> + Pa = filename:dirname(code:which(?MODULE)), + Res = test_server:start_node(Name, peer, [{args, " -pa " ++ Pa ++ + " -config " ++ Config ++ + " -boot " ++ atom_to_list(Boot)}]), + record_started_node(Res). + +%% Increase the timeout for when an upcoming connection is teared down +%% again (default is 7 seconds, and can be exceeded by some tests). +%% The default remains in effect for the test_server node itself, though. +start_node(Name, Config) -> + start_node(Name, slave, Config). + +start_hidden_node(Name, Config) -> + start_node(Name, slave, "-hidden", Config). + +start_non_connecting_node(Name, Config) -> + start_node(Name, slave, "-connect_all false +W i", Config). + +start_peer_node(Name, Config) -> + start_node(Name, peer, Config). + +start_node(Name, How, Config) -> + start_node(Name, How, "", Config). + +start_node(Name0, How, Args, Config) -> + Name = node_name(Name0, Config), + Pa = filename:dirname(code:which(?MODULE)), + R = test_server:start_node(Name, How, [{args, + Args ++ " " ++ + "-kernel net_setuptime 100 " +% "-noshell " + "-pa " ++ Pa}, + {linked, false} +]), + %% {linked,false} only seems to work for slave nodes. +% test_server:sleep(1000), + record_started_node(R). + +start_node_rel(Name0, Rel, Config) -> + Name = node_name(Name0, Config), + {Release, Compat} = case Rel of + this -> + {[this], "+R8"}; + Rel when is_atom(Rel) -> + {[{release, atom_to_list(Rel)}], ""}; + RelList -> + {RelList, ""} + end, + Env = case Rel of + r11b -> + [{env, [{"ERL_R11B_FLAGS", []}]}]; + _ -> + [] + end, + Pa = filename:dirname(code:which(?MODULE)), + Res = test_server:start_node(Name, peer, + [{args, + Compat ++ + " -kernel net_setuptime 100 " + " -pa " ++ Pa}, + {erl, Release}] ++ Env), + record_started_node(Res). + +record_started_node({ok, Node}) -> + case erase(?nodes_tag) of + undefined -> ok; + Nodes -> put(?nodes_tag, [Node | Nodes]) + end, + {ok, Node}; +record_started_node(R) -> + R. + +node_names(Names, Config) -> + [node_name(Name, Config) || Name <- Names]. + +%% simple_resolve assumes that the node name comes first. +node_name(Name, Config) -> + U = "_", + {{Y,M,D}, {H,Min,S}} = calendar:now_to_local_time(now()), + Date = io_lib:format("~4w_~2..0w_~2..0w__~2..0w_~2..0w_~2..0w", + [Y,M,D, H,Min,S]), + L = lists:flatten(Date), + lists:concat([Name,U,?testcase,U,U,L]). + +stop_nodes(Nodes) -> + lists:foreach(fun(Node) -> stop_node(Node) end, Nodes). + +stop_node(Node) -> + ?line ?t:stop_node(Node). + + +stop() -> + lists:foreach(fun(Node) -> + ?t:stop_node(Node) + end, nodes()). + +dbg_logs(Name) -> dbg_logs(Name, ?NODES). + +dbg_logs(Name, Nodes) -> + lists:foreach(fun(N) -> + F = lists:concat([Name, ".log.", N, ".txt"]), + ?line ok = sys:log_to_file({global_name_server, N}, F) + end, Nodes). + + +global_lost_nodes(suite) -> + []; +global_lost_nodes(doc) -> + ["Tests that locally loaded nodes do not loose contact with other nodes."]; +global_lost_nodes(Config) when is_list(Config) -> + Timeout = 60, + Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + + ?line {ok, Node1} = start_node(node1, Config), + ?line {ok, Node2} = start_node(node2, Config), + + ?line wait_for_ready_net(Config), + + ?line io:format("Nodes: ~p", [nodes()]), + ?line io:format("Nodes at node1: ~p", + [rpc:call(Node1, erlang, nodes, [])]), + ?line io:format("Nodes at node2: ~p", + [rpc:call(Node2, erlang, nodes, [])]), + + ?line rpc_cast(Node1, ?MODULE, global_load, [node_1,Node2,node_2]), + ?line rpc_cast(Node2, ?MODULE, global_load, [node_2,Node1,node_1]), + + lost_nodes_waiter(Node1, Node2), + + write_high_level_trace(Config), + ?line stop_node(Node1), + ?line stop_node(Node2), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +global_load(MyName, OtherNode, OtherName) -> + ?line yes = global:register_name(MyName, self()), + io:format("Registered ~p",[MyName]), + global_load1(OtherNode, OtherName, 0). + +global_load1(_OtherNode, _OtherName, 2) -> + io:format("*** ~p giving up. No use.", [node()]), + init:stop(); +global_load1(OtherNode, OtherName, Fails) -> + test_server:sleep(1000), + ?line case catch global:whereis_name(OtherName) of + Pid when is_pid(Pid) -> + io:format("~p says: ~p is still there.", + [node(),OtherName]), + global_load1(OtherNode, OtherName, Fails); + Other -> + io:format("~p says: ~p is lost (~p) Pinging.", + [ node(), OtherName, Other]), + case net_adm:ping(OtherNode) of + pong -> + io:format("Re-established contact to ~p", + [OtherName]); + pang -> + io:format("PANIC! Other node is DEAD.", []), + init:stop() + end, + global_load1(OtherNode, OtherName, Fails+1) + end. + +lost_nodes_waiter(N1, N2) -> + ?line net_kernel:monitor_nodes(true), + receive + {nodedown, Node} when Node =:= N1 ; Node =:= N2 -> + io:format("~p went down!",[Node]), + ?line ?t:fail("Node went down.") + after 10000 -> + ok + end, + ok. + + + +mass_death(suite) -> + []; +mass_death(doc) -> + ["Tests the simultaneous death of many processes with registered names"]; +mass_death(Config) when is_list(Config) -> + Timeout = 90, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line OrigNames = global:registered_names(), + %% Start nodes + ?line Cps = [cp1,cp2,cp3,cp4,cp5], + ?line Nodes = [begin {ok, Node} = start_node(Cp, Config), Node end || + Cp <- Cps], + ?line io:format("Nodes: ~p~n", [Nodes]), + ?line Ns = lists:seq(1, 40), + %% Start processes with globally registered names on the nodes + ?line {Pids,[]} = rpc:multicall(Nodes, ?MODULE, mass_spawn, [Ns]), + ?line io:format("Pids: ~p~n", [Pids]), + %% Wait... + ?line test_server:sleep(10000), + %% Check the globally registered names + ?line NewNames = global:registered_names(), + ?line io:format("NewNames: ~p~n", [NewNames]), + ?line Ndiff = lists:sort(NewNames--OrigNames), + ?line io:format("Ndiff: ~p~n", [Ndiff]), + ?line Ndiff = lists:sort(mass_names(Nodes, Ns)), + %% + %% Kill the root pids + ?line lists:foreach(fun (Pid) -> Pid ! drop_dead end, Pids), + %% Start probing and wait for all registered names to disappear + {YYYY,MM,DD} = date(), + {H,M,S} = time(), + io:format("Started probing: ~.4.0w-~.2.0w-~.2.0w ~.2.0w:~.2.0w:~.2.0w~n", + [YYYY,MM,DD,H,M,S]), + wait_mass_death(Dog, Nodes, OrigNames, erlang:now(), Config). + +wait_mass_death(Dog, Nodes, OrigNames, Then, Config) -> + ?line Names = global:registered_names(), + ?line + case Names--OrigNames of + [] -> + ?line T = now_diff(erlang:now(), Then) div 1000, + ?line lists:foreach( + fun (Node) -> + stop_node(Node) + end, Nodes), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + {comment,lists:flatten(io_lib:format("~.3f s~n", [T/1000.0]))}; + Ndiff -> + ?line io:format("Ndiff: ~p~n", [Ndiff]), + ?line test_server:sleep(1000), + ?line wait_mass_death(Dog, Nodes, OrigNames, Then, Config) + end. + +mass_spawn([]) -> + ok; +mass_spawn([N|T]) -> + Parent = self(), + Pid = + spawn_link( + fun () -> + Name = mass_name(node(), N), + yes = global:register_name(Name, self()), + mass_spawn(T), + Parent ! self(), + loop() + end), + receive Pid -> Pid end. + +mass_names([], _) -> + []; +mass_names([Node|T],Ns) -> + [mass_name(Node, N) || N <- Ns] ++ mass_names(T, Ns). + +mass_name(Node, N) -> + list_to_atom(atom_to_list(Node)++"_"++integer_to_list(N)). + + + +start_nodes(L, How, Config) -> + start_nodes2(L, How, 0, Config), + Nodes = collect_nodes(0, length(L)), + ?line ?UNTIL([] =:= Nodes -- nodes()), + put(?nodes_tag, Nodes), + %% Pinging doesn't help, we have to wait too, for nodes() to become + %% correct on the other node. + lists:foreach(fun(E) -> + net_adm:ping(E) + end, + Nodes), + verify_nodes(Nodes, Config), + Nodes. + +%% Not used? +start_nodes_serially([], _, _Config) -> + []; +start_nodes_serially([Name | Rest], How, Config) -> + {ok, R} = start_node(Name, How, Config), + [R | start_nodes_serially(Rest, How, Config)]. + +verify_nodes(Nodes, Config) -> + verify_nodes(Nodes, lists:sort([node() | Nodes]), Config). + +verify_nodes([], _N, _Config) -> + []; +verify_nodes([Node | Rest], N, Config) -> + ?line ?UNTIL( + case rpc:call(Node, erlang, nodes, []) of + Nodes when is_list(Nodes) -> + case N =:= lists:sort([Node | Nodes]) of + true -> + true; + false -> + lists:foreach(fun(Nd) -> + rpc:call(Nd, net_adm, ping, + [Node]) + end, + nodes()), + false + end; + _ -> + false + end + ), + verify_nodes(Rest, N, Config). + + +start_nodes2([], _How, _, _Config) -> + []; +start_nodes2([Name | Rest], How, N, Config) -> + Self = self(), + spawn(fun() -> + erlang:display({starting, Name}), + {ok, R} = start_node(Name, How, Config), + erlang:display({started, Name, R}), + Self ! {N, R}, + %% sleeping is necessary, or with peer nodes, they will + %% go down again, despite {linked, false}. + test_server:sleep(100000) + end), + start_nodes2(Rest, How, N+1, Config). + +collect_nodes(N, N) -> + []; +collect_nodes(N, Max) -> + receive + {N, Node} -> + [Node | collect_nodes(N+1, Max)] + end. + +only_element(_E, []) -> + true; +only_element(E, [E|R]) -> + only_element(E, R); +only_element(_E, _) -> + false. + +exit_p(Pid) -> + Ref = erlang:monitor(process, Pid), + Pid ! die, + receive + {'DOWN', Ref, process, Pid, _Reason} -> + ok + end. + +wait_for_exit(Pid) -> + Ref = erlang:monitor(process, Pid), + receive + {'DOWN', Ref, process, Pid, _Reason} -> + ok + end. + +wait_for_exit_fast(Pid) -> + Ref = erlang:monitor(process, Pid), + receive + {'DOWN', Ref, process, Pid, _Reason} -> + ok + end. + +check_everywhere(Nodes, Name, Config) -> + ?UNTIL(begin + case rpc:multicall(Nodes, global, whereis_name, [Name]) of + {Ns1, []} -> + check_same_p(Ns1); + _R -> + false + end + end). + +init_condition(Config) -> + io:format("globally registered names: ~p~n", [global:registered_names()]), + io:format("nodes: ~p~n", [nodes()]), + io:format("known: ~p~n", [get_known(node()) -- [node()]]), + io:format("Info ~p~n", [setelement(11, global:info(), trace)]), + _ = [io:format("~s: ~p~n", [TN, ets:tab2list(T)]) || + {TN, T} <- [{"Global Names (ETS)", global_names}, + {"Global Names Ext (ETS)", global_names_ext}, + {"Global Locks (ETS)", global_locks}, + {"Global Pid Names (ETS)", global_pid_names}, + {"Global Pid Ids (ETS)", global_pid_ids}]], + ?UNTIL([test_server] =:= global:registered_names()), + ?UNTIL([] =:= nodes()), + ?UNTIL([node()] =:= get_known(node())), + ok. + +mk_node(N, H) when is_list(N), is_list(H) -> + list_to_atom(N ++ "@" ++ H). + +remove_gg_pub_type([]) -> + []; +remove_gg_pub_type([{GG, Nodes}|Rest]) -> + [{GG, Nodes}|remove_gg_pub_type(Rest)]; +remove_gg_pub_type([{GG, _, Nodes}|Rest]) -> + [{GG, Nodes}|remove_gg_pub_type(Rest)]. + +%% Send garbage message to all processes that are linked to global. +%% Better do this in a slave node. +%% (The transition from links to monitors does not affect this case.) + +garbage_messages(suite) -> + []; +garbage_messages(Config) when is_list(Config) -> + Timeout = 25, + ?line Dog = test_server:timetrap({seconds,Timeout}), + init_high_level_trace(Timeout), + ?line init_condition(Config), + ?line [Slave] = start_nodes([garbage_messages], slave, Config), + Fun = fun() -> + {links,L} = process_info(whereis(global_name_server), links), + lists:foreach(fun(Pid) -> Pid ! {garbage,to,you} end, L), + receive + _Any -> ok + end + end, + ?line Pid = spawn_link(Slave, erlang, apply, [Fun,[]]), + ?t:sleep(2000), + ?line Global = rpc:call(Slave, erlang, whereis, [global_name_server]), + ?line {registered_name,global_name_server} = + rpc:call(Slave, erlang, process_info, [Global,registered_name]), + ?line true = unlink(Pid), + write_high_level_trace(Config), + ?line stop_node(Slave), + ?line init_condition(Config), + ?line test_server:timetrap_cancel(Dog), + ok. + +wait_for_ready_net(Config) -> + wait_for_ready_net(?NODES, Config). + +wait_for_ready_net(Nodes0, Config) -> + Nodes = lists:sort(Nodes0), + ?t:format("wait_for_ready_net ~p~n", [Nodes]), + ?UNTIL(begin + lists:all(fun(N) -> Nodes =:= get_known(N) end, Nodes) and + lists:all(fun(N) -> + LNs = rpc:call(N, erlang, nodes, []), + Nodes =:= lists:sort([N | LNs]) + end, Nodes) + end). + +get_known(Node) -> + case catch gen_server:call({global_name_server,Node},get_known,infinity) of + {'EXIT', _} -> + [list, without, nodenames]; + Known when is_list(Known) -> + lists:sort([Node | Known]) + end. + +quite_a_few_nodes(Max) -> + N = try + ulimit("ulimit -u") + catch _:_ -> + ulimit("ulimit -p") % can fail... + end, + lists:min([(N - 40) div 3, Max]). + +ulimit(Cmd) -> + N0 = os:cmd(Cmd), + N1 = lists:reverse(N0), + N2 = lists:dropwhile(fun($\r) -> true; + ($\n) -> true; + (_) -> false + end, N1), + case lists:reverse(N2) of + "unlimited" -> 10000; + N -> list_to_integer(N) + end. + +%% To make it less probable that some low-level problem causes +%% problems, the receiving node is ping:ed. +rpc_cast(Node, Module, Function, Args) -> + {_,pong,Node}= {node(),net_adm:ping(Node),Node}, + rpc:cast(Node, Module, Function, Args). + +rpc_cast(Node, Module, Function, Args, File) -> + case net_adm:ping(Node) of + pong -> + rpc:cast(Node, Module, Function, Args); + Else -> + append_to_file(File, {now(), {rpc_cast, Node, Module, Function, + Args, Else}}) + %% Maybe we should crash, but it probably doesn't matter. + end. + +%% The emulator now ensures that the node has been removed from +%% nodes(). +rpc_disconnect_node(Node, DisconnectedNode, _Config) -> + True = rpc:call(Node, erlang, disconnect_node, [DisconnectedNode]), + False = lists:member(DisconnectedNode, rpc:call(Node, erlang, nodes, [])), + {true, false} = {True, False}. + +%%% +%%% Utility +%%% + +%% It is a bit awkward to collect data from different nodes. One way +%% of doing is to use a named tracer process on each node. Interesting +%% data is banged to the tracer and when the test is finished data is +%% collected on some node by sending messages to the tracers. One +%% cannot do this if the net has been set up to be less than fully +%% connected. One can also prepare other modules, such as 'global', by +%% inserting lines like +%% trace_message({node(), {at,?LINE}, {tag, message}) +%% where appropriate. + +start_tracer() -> + Pid = spawn(fun() -> tracer([]) end), + case catch register(my_tracer, Pid) of + {'EXIT', _} -> + ?t:fail(re_register_my_tracer); + _ -> + ok + end. + +tracer(L) -> + receive + % {save, Term} -> + % tracer([{now(),Term} | L]); + {get, From} -> + From ! {trace, lists:reverse(L)}, + tracer([]); + stop -> + exit(normal); + Term -> + tracer([{now(),Term} | L]) + end. + +stop_tracer() -> + trace_message(stop). + +get_trace() -> + trace_message({get, self()}), + receive {trace, L} -> + L + end. + +collect_tracers(Nodes) -> + Traces0 = [rpc:call(N, ?MODULE, get_trace, []) || N <- Nodes], + Traces = [L || L <- Traces0, is_list(L)], + try begin + Stamped = lists:keysort(1, lists:append(Traces)), + NotStamped = [T || {_, T} <- Stamped], + {Stamped, NotStamped} + end + catch _:_ -> {[], []} + end. + +trace_message(M) -> + case catch my_tracer ! M of + {'EXIT', _} -> + ?t:fail(my_tracer_not_registered); + _ -> + ok + end. + +%%----------------------------------------------------------------- +%% The error_logger handler used for OTP-6931. +%%----------------------------------------------------------------- +init(Tester) -> + {ok, Tester}. + +handle_event({_, _GL, {_Pid,_String,[{nodeup,fake_node}=Msg]}}, Tester) -> + Tester ! Msg, + {ok, Tester}; +handle_event(_Event, State) -> + {ok, State}. + +handle_info(_Info, State) -> + {ok, State}. + +handle_call(_Query, State) -> {ok, {error, bad_query}, State}. + +terminate(_Reason, State) -> + State. + diff --git a/lib/kernel/test/global_SUITE_data/global_trace.erl b/lib/kernel/test/global_SUITE_data/global_trace.erl new file mode 100644 index 0000000000..4f253baac4 --- /dev/null +++ b/lib/kernel/test/global_SUITE_data/global_trace.erl @@ -0,0 +1,1023 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2009. 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(global_trace). + +%%% +%%% Inspection of High Level Trace created by global.erl. +%%% + +%%% A few handy functions when running the test_server +%%% + +d() -> + lists:foreach(fun(F) -> dd(F, []) end, last()). + +d(Testcase) -> + d(Testcase, []). + +%% Skip "global_" from T. +d(Testcase, Options) -> + [Filename] = tmp_files(Testcase), + dd(Filename, Options). + +dd(Filename, Options) -> + io:format("\n======= ~s \n", [Filename]), + t(Filename, Options). + +last() -> + tmp_files("*"). + +%% global_groups_change: one node is restarted +%% global_mass_death: nodes are stopped +%% global_lock_die: two spurious (trying to remove locks taken by other pid) +%% global_otp_5640: 4 spurious (names registered again &c) +tmp_files(A) when is_atom(A) -> + tmp_files(atom_to_list(A)); +tmp_files(T) when is_list(T) -> + Logs = logdir(), + Dir = lists:last(filelib:wildcard(filename:join(Logs, "*"))), + filelib:wildcard(filename:join([Dir, log_private, "global_" ++ T])). + +%logdir() -> +% "/net/yoshi/ldisk/daily_build/otp_norel_linux_r11b.2007-02-18_19/" +% "test/test_server/global_SUITE.logs"; +%logdir() -> +% "/ldisk/daily_build/otp_norel_linux_suse_r11b.2007-02-07_19/test/" +% "test_server/global_SUITE.logs"; +logdir() -> + "/tmp/tests/test_server/global_SUITE.logs". + + + +%%% The contents of this file is by no means fixed; the printouts are +%%% updated depending on the problems at hand. Not everything has been +%%% designed very carefully :) +%%% +%%% For one thing, the trace from all nodes are written onto the file +%%% as one single term. One term per node would be better. &c. + +-compile(export_all). + +-record(state, {connect_all, known = [], synced = [], + resolvers = [], syncers = [], node_name = node(), + the_locker, the_deleter, the_registrar, trace = [], + global_lock_down + }). + +%% Compatible with different versions. +state(#state{}=S) -> + S; +state({state, ConnectAll, Known, Synced, LockersResolvers, Syncers, + NodeName, TheLocker, TheDeleter}) -> + %% r10b: Lockers, r10b_patched, r11b: Resolvers + #state{connect_all = ConnectAll, known = Known, synced = Synced, + resolvers = LockersResolvers, syncers = Syncers, + node_name = NodeName, the_locker = TheLocker, + the_deleter = TheDeleter, the_registrar = undefined, trace = []}; +state({state, ConnectAll, Known, Synced, Resolvers, Syncers, + NodeName, TheLocker, TheDeleter, Trace}) -> + %% r11b, some time before r11b-3 + #state{connect_all = ConnectAll, known = Known, synced = Synced, + resolvers = Resolvers, syncers = Syncers, + node_name = NodeName, the_locker = TheLocker, + the_deleter = TheDeleter, the_registrar = undefined, + trace = Trace}; +state({state, ConnectAll, Known, Synced, Resolvers, Syncers, + NodeName, TheLocker, TheDeleter, TheRegistrar, Trace}) -> + %% r11b, some time after r11b-3 + #state{connect_all = ConnectAll, known = Known, synced = Synced, + resolvers = Resolvers, syncers = Syncers, + node_name = NodeName, the_locker = TheLocker, + the_deleter = TheDeleter, the_registrar = TheRegistrar, + trace = Trace, global_lock_down = false}; +state(Else) -> + Else. + +%%% Trace tuples look like {Node, Now, Message, Nodes, Extra}. +%%% Nodes is the list as returned by nodes(). +%%% Extra is [] most of the time. +%%% +%%% init +%%% {nodedown,DownNode} +%%% {extra_nodedown,DownNode} +%%% {nodeup, UpNode} +%%% {added,AddedNodes}, Extra = [{new_nodes, NewNodes}, +%%% {abcast, Known}, +%%% {ops,Ops}] +%%% NewKnown = Known ++ AddedNodes +%%% AddedNodes = NewNodes -- Known +%%% NewNodes �r h�r den man f�rhandlat med plus de noder den k�nner till. +%%% {added, AddedNodes}, Extra = [{ops,Ops}] +%%% NewKnown = Known ++ AddedNodes +%%% Den (passiva) noden f�r Nodes som �r NewNodes +%%% hos den f�rhandlande. Sedan: AddedNodes = (Nodes -- Known) -- [node()]. +%%% Det �r som hos f�rhandlaren. +%%% {nodes_changed, {New,Old}} +%%% Every now and then the list [node() | nodes()] is checked for updates. +%%% New are the nodes that global does not know of (yet). +%%% {new_node_name, NewNode} +%%% Ignored. Someone changes the nodename dynamically. +%%% {ins_name, Node}, Extra = [Name, Pid] +%%% Node = node(Pid) +%%% {ins_name_ext, Node}, Extra = [Name, Pid] +%%% Node = node(Pid) +%%% {del_name, Node}, Extra = [Name, Pid] +%%% Node = node(Pid) +%%% {ins_lock, Node}, Extra = [Id, Pid] +%%% Node = node(Pid) +%%% {rem_lock, Node}, Extra = [Id, Pid] +%%% Node = node(Pid) +%%% {locker_succeeded, node()}, Extra = {First, Known} +%%% {locker_failed, node()}, Extra = {Tried, SoFar} +%%% The nodes in SoFar have been locked, could not lock Tried. +%%% +%%% Also trace of the creation and deletion of resolvers +%%% (this kind of resolvers are created when nodeup arrives from +%%% unknown nodes (there are also name resolvers...)). +%%% {new_resolver, Node}, Extra = [Tag, ResolverPid] +%%% {kill_resolver, Node}, Extra = [Tag, ResolverPid] +%%% {exit_resolver, Node}, Extra = [Tag] + +-record(node, { + node, + known = [], % #state.known (derived) + nodes = [], % nodes() + locks = [], % [{Id, [Pid, node(Pid)]}] (derived) + names = [], % [{Name, Pid, node(Pid)}] (derived) + resolvers = [], % [{Node, Tag, ResolverPid}] + n_locks = {0, % OK + 0, % Tried to lock the boss + 0, % Tried to lock other boss + 0}, % Tried to lock known + rejected = 0 % Lock OK, but later rejected + }). + +-record(w, {nodes = [], % [#node{}] + n = []}). + +t(File) -> + t(File, []). + +%%% What to search for in the output of t/2? +%%% - 'NEGOTIATIONS': this is a list of the name negotiations +%%% (the big picture); +%%% - '###' signals a possibly strange event; +%%% - 'spurious' is used for "tagging" such events; +%%% - 'resol ' could mean that some resolver process has not been removed; +%%% ... + +%% Options: +%% {show_state, From, To} +%% From = To = integer() | {integer(), integer()} +%% Examples: {7, 8} (show states between seconds 7.0 and 8.0); +%% {{1,431234},{2,432}} (between 1.431234 and 2.000432) +%% The state of a node includes locks, names, nodes, known, ... +%% Default is {{0,0}, {0,0}}, that is, do not show state. +%% show_state +%% same as {show_state, 0, 1 bsl 28}, that is, show every state +%% {show_trace, bool() +%% Show the complete trace as one list and per node pair. +%% Default is true. +t(File, Options) -> + {StateFun, ShowTrace} = + case options(Options, [show_state, show_trace]) of + [{From,To}, ST] -> + {fun(T, S) -> + Time = element(2, T), + if + Time >= From, Time =< To -> + io:format("===> ~p~n", [T]), + display_nodes("After", Time, S#w.nodes, T); + true -> + ok + end + end, ST}; + _ -> + erlang:error(badarg, [File, Options]) + end, + D1 = try + %% All nodes' trace is put on the file as one binary. + %% This could (and should?) be improved upon. + {ok, Bin} = file:read_file(File), + io:format("Size of trace file is ~p bytes~n", [size(Bin)]), + binary_to_term(Bin) + catch _:_ -> + {ok, [D0]} = file:consult(File), + D0 + end, + {D2, End} = case D1 of + {high_level_trace, ET, D3} -> + {D3, ET}; + _ -> + {D1, now()} + end, + D = adjust_nodes(D2), + {NodeNodeTrace, _NodeTrace, Trace, Base} = get_trace(D, End), + messages(D, Base, End), + + %io:format("NET~n ~p~n", [net_kernel_nodes(NodeTrace)]), + + io:format("NEGOTIATIONS:~n ~p~n", [negotiations(Trace)]), + + io:format("*** Complete trace ***~n"), + if + ShowTrace -> + show_trace(Trace), + io:format("--- End of complete trace ---~n"), + lists:map(fun({{Node,ActionNode},Ts}) -> + io:format("*** Trace for ~p on node ~p ***~n", + [ActionNode, Node]), + show_trace(lists:keysort(2, Ts)), + io:format("--- End of trace for ~p on node ~p ---~n", + [ActionNode, Node]) + end, NodeNodeTrace); + true -> ok + end, + io:format("*** Evaluation ***~n"), + {Fini, Spurious} = eval(Trace, StateFun), + io:format("*** End of evaluation ***~n"), + show_spurious(NodeNodeTrace, Spurious), + display_nodes("FINI", '', Fini), + ok. + +% show_trace(Trace) -> +% lists:foreach(fun({Node, {S,Mu}, Message, Nodes, Extra}) -> +% io:format("~2w.~6..0w ~w~n", [S, Mu, Node]), +% io:format(" ~p~n", [Message]), +% io:format(" Nodes: ~p~n", [Nodes]), +% case Extra of +% [] -> ok; +% _ -> io:format(" Extra: ~p~n", [Extra]) +% end +% end, Trace); +show_trace(Trace) -> + lists:map(fun(T) -> io:format("~p~n", [T]) end, Trace). + +get_trace(D, EndTime0) -> + NodeTrace0 = [{Node,lists:keysort(2, (state(State))#state.trace)} || + {Node,{info,State}} <- D, + case state(State) of + #state{trace = no_trace} -> + io:format("No trace for ~p~n", [Node]), + false; + #state{} -> + true; + Else -> + io:format("Bad state for ~p: ~p~n", + [Node, Else]), + false + end], + Trace0 = lists:keysort(2, lists:append([T || {_Node, T} <- NodeTrace0])), + Trace1 = sort_nodes(Trace0), + {Base, Trace2} = adjust_times(Trace1), + EndTime = adjust_time(EndTime0, Base), + io:format("The trace was generated at ~p~n", [EndTime]), + Trace = [T || T <- Trace2, element(2, T) < EndTime], + NodeTrace = [{Node, adjust_times(Ts, Base)} || + {Node, Ts} <- NodeTrace0], + NodeNodeTrace = + [{{Node,ActionNode}, T} || {Node, Ts} <- NodeTrace, + T <- Ts, + ActionNode <- action_nodes(T)], + {family(NodeNodeTrace), NodeTrace, Trace, Base}. + +adjust_nodes([E | Es]) -> + [adjust_nodes(E) | adjust_nodes(Es)]; +adjust_nodes(T) when is_tuple(T) -> + list_to_tuple(adjust_nodes(tuple_to_list(T))); +adjust_nodes(A) when is_atom(A) -> + adjust_node(A); +adjust_nodes(E) -> + E. + +sort_nodes(Ts) -> + [setelement(4, T, lists:sort(element(4, T))) || T <- Ts]. + +adjust_times([]) -> + {0, []}; +adjust_times([T1 | _]=Ts) -> + Base = element(2, T1), + {Base, adjust_times(Ts, Base)}. + +adjust_times(Ts, Base) -> + [setelement(2, adj_tag(T, Base), adjust_time(element(2, T), Base)) || + T <- Ts]. + +adj_tag({Node, Time, {M, Node2}, Nodes, Extra}=T, Base) -> + if + M =:= new_resolver; + M =:= kill_resolver; + M =:= exit_resolver -> + {Node, Time, {M, Node2}, Nodes, + [adjust_time(hd(Extra), Base) | tl(Extra)]}; + true -> + T + end. + +adjust_time(Time, Base) -> + musec2sec(timer:now_diff(Time, Base)). + +action_nodes({_Node, _Time, {_, Nodes}, _, _}) when is_list(Nodes) -> + Nodes; +action_nodes({_Node, _Time, {_, Node}, _, _}) -> + [Node]. + +%% Some of the names in global_SUITE.erl are recognized. +adjust_node(Node) -> + case atom_to_list(Node) of + "cp" ++ L -> + list_to_atom([$c, $p | lists:takewhile(fun is_digit/1, L)]); + "test_server" ++ _ -> + test_server; + "a_2" ++ _ -> + a_2; + "n_1" ++ _ -> + n_1; + "n_2" ++ _ -> + n_2; + "z_2" ++ _ -> + z_2; + "z_" ++ _ -> + z; + "b_" ++ _ -> + b; + "c_external_nodes" ++ _ -> + c_external_nodes; + _ -> + Node + end. + +is_digit(C) -> + (C >= $0) and (C =< $9). + +eval(Trace, Fun) -> + eval(Trace, {0, 0}, #w{}, Fun). + +eval([T | Ts], Time0, S0, Fun) -> + Time1 = element(2, T), + case is_fresh(S0#w.nodes) of + true -> + io:format("~p ***************** FRESH *****************~n", + [Time1]); + false -> + ok + end, + case time_diff(Time1, Time0) > 0 of + true -> + display_nodes("PAUS", Time1, S0#w.nodes, T); + false -> + ok + end, + S = eval_trace(T, S0), + Fun(T, S), + eval(Ts, Time1, S, Fun); +eval([], _, S, _Fun) -> + {S#w.nodes, lists:usort(S#w.n)}. + +%% Old. +eval_trace({Node, Time, {added,Added}, _Nodes, [_NewNodes,_Abc]}, S0) -> + added(Node, Added, Time, S0); +eval_trace({Node, Time, {added,Added}, _Nodes, []}, S0) -> + added(Node, Added, Time, S0); + + +eval_trace({Node, Time, {init, Node}, Nodes, []}, S0) -> + init(Node, Nodes, Time, S0); +eval_trace({Node, Time, {nodedown, DownNode}, Nodes, []}, S0) -> + node_down(Node, DownNode, Nodes, Time, S0); +eval_trace({Node, Time, {extra_nodedown, DownNode}, Nodes, []}, S0) -> + node_down(Node, DownNode, Nodes, Time, S0); +eval_trace({Node, Time, {nodeup, UpNode}, Nodes, []}, S0) -> + node_up(Node, UpNode, Nodes, Time, S0); +eval_trace({Node, Time, {added,Added}, _Nodes, [_NewNodes,_Abc,_Ops]}, S0) -> + added(Node, Added, Time, S0); +eval_trace({Node, Time, {added,Added}, _Nodes, [_Ops]}, S0) -> + added(Node, Added, Time, S0); +eval_trace({Node, Time, {nodes_changed, {New,Old}}, _Nodes, []}, S0) -> + nodes_changed(Node, New, Old, Time, S0); +eval_trace({Node, Time, {ins_name, PNode}, _Nodes, [Name, Pid]}, S0) -> + insert_name(Node, PNode, Time, Name, Pid, S0); +eval_trace({Node, Time, {del_name, PNode}, _Nodes, [Name, Pid]}, S0) -> + delete_name(Node, PNode, Time, Name, Pid, S0); +eval_trace({Node, Time, {ins_name_ext, PNode}, _Nodes, [Name, Pid]}, S0) -> + insert_external_name(Node, PNode, Time, Name, Pid, S0); +eval_trace({Node, Time, {ins_lock, PNode}, _Nodes, [Id, Pid]}, S0) -> + insert_lock(Node, PNode, Time, Id, Pid, S0); +eval_trace({Node, Time, {rem_lock, PNode}, _Nodes, [Id, Pid]}, S0) -> + remove_lock(Node, PNode, Time, Id, Pid, S0); +eval_trace({Node, Time, {locker_succeeded, _}, _Nodes,{_First,_Known}}, S0) -> + locker_succeeded(Node, Time, S0); +eval_trace({Node, Time, {lock_rejected, _}, _Nodes, Known}, S0) -> + lock_rejected(Node, Time, Known, S0); +eval_trace({Node, Time, {locker_failed, _}, _Nodes, {Tried,SoFar}}, S0) -> + locker_failed(Node, Time, Tried, SoFar, S0); +eval_trace({Node, Time, {new_resolver, RNode}, _Nodes, [Tag, ResPid]}, S0) -> + new_resolver(Node, Time, RNode, Tag, ResPid, S0); +eval_trace({Node, Time, {kill_resolver, RNode}, _Nodes, [Tag,_ResPid]}, S0) -> + stop_resolver(Node, Time, RNode, Tag, kill, S0); +eval_trace({Node, Time, {exit_resolver, RNode}, _Nodes, [Tag]}, S0) -> + stop_resolver(Node, Time, RNode, Tag, exit, S0); +eval_trace(_Ignored, S) -> +io:format("ignored ~p~n", [_Ignored]), + S. + +init(_Node, [], _Time, S) -> + S; +init(Node, NodesList, Time, S) -> + io:format("### ~p ~p: already in nodes(): ~p~n", [Node, Time, NodesList]), + S. + +node_down(Node, DownNode, NodesList, Time, S0) -> + case get_node(Node, S0) of + {ok, #node{known = Known, nodes = Nodes}=N} -> + case lists:member(DownNode, Nodes) of + true -> + S1 = case lists:member(DownNode, Known) of + true -> + S0; + false -> + io:format("### ~p ~p:~n " + "nodedown but unknown ~p~n", + [Node, Time, DownNode]), + case lists:member(DownNode, Nodes) of + true -> + io:format("(but note that ~p" + " is member of nodes())~n", + [DownNode]); + false -> + ok + end, + add_spurious(Node, DownNode, S0, Time) + end, + NewKnown = lists:delete(DownNode, Known), + NewNodes = lists:delete(DownNode, Nodes), + put_node(N#node{known = NewKnown, nodes = NewNodes}, S1); + false -> + io:format("### ~p ~p:~n spurious nodedown from ~p~n " + "~p~n", [Node, Time, DownNode, NodesList]), + NewKnown = lists:delete(DownNode, Known), + S1 = put_node(N#node{known = NewKnown,nodes = Nodes}, S0), + add_spurious(Node, DownNode, S1, Time) + end; + not_ok -> + io:format("### ~p ~p:~n unknown node got nodedown from ~p~n", + [Node, Time, DownNode]), + add_spurious(Node, DownNode, S0, Time) + end. + +node_up(Node, UpNode, NodesList, Time, S) -> + case get_node(Node, S) of + {ok, #node{nodes = Nodes}=N} -> + case lists:member(UpNode, Nodes) of + true -> + io:format("### ~p ~p:~n spurious nodeup from ~p~n " + "~p~n", [Node, Time, UpNode, NodesList]), + add_spurious(Node, UpNode, S, Time); + false -> + put_node(N#node{nodes = lists:sort([UpNode | Nodes])}, S) + end; + not_ok -> + S#w{nodes = [#node{node = Node, nodes = [UpNode]} | S#w.nodes]} + end. + +added(Node, Added, Time, S0) -> + case get_node(Node, S0) of + {ok, #node{known = Known, nodes = Nodes}=N} -> + case Known -- (Known -- Added) of + [] -> + S1 = put_node(N#node{known = lists:sort(Added ++ Known), + nodes = Nodes}, S0), + case lists:member(Node, Added) of + true -> + io:format("### ~p ~p:~n adding node()" + " to known (~p)~n", [Node, Time,Added]), + add_spurious(Node, Added, S1, Time); + false -> + S1 + end; + AK -> + io:format("### ~p ~p:~n added already known ~p~n", + [Node, Time, AK]), + S1 = put_node(N#node{known = lists:usort(Added ++ Known), + nodes = Nodes}, S0), + add_spurious(Node, AK, S1, Time) + end; + not_ok -> + io:format("### ~p ~p:~n unknown node got added ~p~n", + [Node, Time, Added]), + S1 = S0#w{nodes = [#node{node = Node, known = Added} | + S0#w.nodes]}, + add_spurious(Node, Added, S1, Time) + end. + +nodes_changed(Node, New, Old, Time, S) -> + io:format("### ~p ~p:~n nodes changed, new are ~p, old are ~p~n", + [Node, Time, New, Old]), + S. + +insert_external_name(Node, PNode, Time, Name, Pid, S) -> + insert_name(Node, PNode, Time, Name, Pid, S). + +insert_name(Node, PNode, Time, Name, Pid, S0) -> + RegName = {Name, Pid, PNode}, + case get_node(Node, S0) of + {ok, #node{names = Names}=N} -> + case lists:keysearch(Name, 1, Names) of + {value, {Name, OldPid, OldPNode}} -> + io:format("### ~p ~p:~n name ~p already registered " + "for ~p on ~p~n", + [Node, Time, Name, OldPid, OldPNode]), + add_spurious(Node, [PNode], S0, Time); + false -> + case lists:keysearch(Pid, 2, Names) of + {value, {OldName, Pid, OldPNode}} -> + io:format("### ~p ~p:~n pid ~p already " + "registered as ~p on ~p~n", + [Node, Time, Pid, OldName, OldPNode]), + add_spurious(Node, [PNode], S0, Time); + false -> + put_node(N#node{names = [RegName | Names]}, S0) + end + end; + not_ok -> + io:format("### ~p ~p:~n unknown node registered ~p for ~p " + "on ~p~n", [Node, Time, Name, Pid, PNode]), + Known = add_to_known(Node, PNode, []), + N = #node{node = Node, known = Known, names = [RegName]}, + S1 = S0#w{nodes = [N | S0#w.nodes]}, + add_spurious(Node, [PNode], S1, Time) + end. + +delete_name(Node, PNode, Time, Name, Pid, S0) -> + case get_node(Node, S0) of + {ok, #node{names = Names}=N} -> + case lists:keysearch(Name, 1, Names) of + {value, {Name, Pid, PNode}} -> + NewNames = lists:keydelete(Name, 1, Names), + put_node(N#node{names = NewNames}, S0); + {value, {Name, Pid2, PNode2}} -> % bad log + io:format("### ~p ~p:~n name ~p not registered " + "for ~p on ~p but for ~p on ~p~n", + [Node, Time, Name, Pid, PNode, Pid2, PNode2]), + add_spurious(Node, [PNode], S0, Time); + false -> + io:format("### ~p ~p:~n name ~p not registered " + "for ~p on ~p~n", + [Node, Time, Name, Pid, PNode]), + add_spurious(Node, [PNode], S0, Time) + end; + not_ok -> + io:format("### ~p ~p:~n unknown node deleted ~p for ~p on ~p~n", + [Node, Time, Name, Pid, PNode]), + Known = add_to_known(Node, PNode, []), + N = #node{node = Node, known = Known}, + S1 = S0#w{nodes = [N | S0#w.nodes]}, + add_spurious(Node, [PNode], S1, Time) + end. + +insert_lock(Node, PNode, Time, Id, Pid, S0) -> + Lock = {Pid, PNode}, + case get_node(Node, S0) of + {ok, #node{locks = NLocks}=N} -> + case lists:keysearch(Id, 1, NLocks) of + {value, {Id, OldLocks}} -> + case lists:member(Lock, OldLocks) of + true -> + io:format("### ~p ~p:~n lock ~p already set " + "for ~p on ~p~n", + [Node, Time, Id, Pid, PNode]), + %% This is not so strange, actually. + add_spurious(Node, [PNode], S0, Time); + false -> + NewLocks = {Id, [Lock | OldLocks]}, + Ls = lists:keyreplace(Id, 1, NLocks, NewLocks), + put_node(N#node{locks = Ls}, S0) + end; + false -> + put_node(N#node{locks = [{Id,[Lock]}|N#node.locks]}, S0) + end; + not_ok -> + Known = add_to_known(Node, PNode, []), + N = #node{node = Node, known = Known, locks = [{Id, [Lock]}]}, + S1 = S0#w{nodes = [N | S0#w.nodes]}, + if + Node =/= PNode -> + io:format("### ~p ~p:~n unknown pid ~p locked ~p on " + "~p~n", [Node, Time, Pid, Id, PNode]), + add_spurious(Node, [PNode], S1, Time); + true -> + S1 + end + end. + +remove_lock(Node, PNode, Time, Id, Pid, S0) -> + Lock = {Pid, PNode}, + case get_node(Node, S0) of + {ok, #node{locks = NLocks}=N} -> + case lists:keysearch(Id, 1, NLocks) of + {value, {Id, OldLocks}} -> + case lists:member(Lock, OldLocks) of + true -> + NewLocks = lists:delete(Lock, OldLocks), + Ls = case NewLocks of + [] -> + lists:keydelete(Id, 1, NLocks); + _ -> + lists:keyreplace(Id, 1, NLocks, + {Id, NewLocks}) + end, + put_node(N#node{locks = Ls}, S0); + false -> + io:format("### ~p ~p:~n lock ~p not set " + "by ~p on ~p~n", + [Node, Time, Id, Pid, PNode]), + add_spurious(Node, [PNode], S0, Time) + end; + false -> + io:format("### ~p ~p:~n lock ~p not set " + "by ~p on ~p~n", + [Node, Time, Id, Pid, PNode]), + add_spurious(Node, [PNode], S0, Time) + end; + not_ok -> + io:format("### ~p ~p:~n ~p unlocked ~p on unknown node ~p~n", + [Node, Time, Pid, Id, PNode]), + Known = add_to_known(Node, PNode, []), + N = #node{node = Node, known = Known}, + S1 = S0#w{nodes = [N | S0#w.nodes]}, + add_spurious(Node, [PNode], S1, Time) + end. + +%% This is just statistics... +locker_succeeded(Node, Time, S0) -> + case get_node(Node, S0) of + {ok, #node{n_locks = {Ok,Boss,NodeX,Bad}}=N} -> + put_node(N#node{n_locks = {Ok+1,Boss,NodeX,Bad}}, S0); + not_ok -> + io:format("### ~p ~p:~n unknown node's locker succeeded~n", + [Node, Time]), + add_spurious(Node, [Node], S0, Time) + end. + +lock_rejected(Node, Time, _Known, S0) -> + case get_node(Node, S0) of + {ok, #node{rejected = Rej}=N} -> + put_node(N#node{rejected = Rej+1}, S0); + not_ok -> + io:format("### ~p ~p:~n unknown node's lock rejected~n", + [Node, Time]), + add_spurious(Node, [Node], S0, Time) + end. + +locker_failed(Node, Time, Tried, SoFar, S0) -> + case get_node(Node, S0) of + {ok, #node{known = Known, n_locks = {Ok,Boss,NodeX,Bad}}=N} -> + TheBoss = lists:max([Node | Known]), + Cheap = (Tried =:= [TheBoss]), + RatherCheap = ((SoFar -- [Node, TheBoss]) =:= []) and + ((Tried -- [Node, TheBoss]) =/= []), + if + Cheap -> + put_node(N#node{n_locks = {Ok,Boss+1,NodeX,Bad}}, S0); + RatherCheap -> + put_node(N#node{n_locks = {Ok,Boss,NodeX+1,Bad}}, S0); + true -> + put_node(N#node{n_locks = {Ok,Boss,NodeX,Bad+1}}, S0) + end; + not_ok -> + io:format("### ~p ~p:~n unknown node's locker failed~n", + [Node, Time]), + add_spurious(Node, [Node], S0, Time) + end. + +new_resolver(Node, Time, ResNode, Tag, ResPid, S0) -> + case get_node(Node, S0) of + {ok, #node{resolvers = Rs}=N} -> + put_node(N#node{resolvers = [{ResNode, Tag, ResPid} | Rs]}, S0); + not_ok -> + io:format("### ~p ~p:~n resolver created for unknown node~n", + [Node, Time]), + add_spurious(Node, [Node], S0, Time) + end. + +stop_resolver(Node, Time, ResNode, Tag, How, S0) -> + case get_node(Node, S0) of + {ok, #node{resolvers = Rs}=N} -> + case lists:keysearch(Tag, 2, Rs) of + {value, {ResNode, Tag, _ResPid}} -> + NewRs = lists:keydelete(Tag, 2, Rs), + put_node(N#node{resolvers = NewRs}, S0); + false -> + case lists:keysearch(ResNode, 1, Rs) of + {value, {ResNode, _Tag2, _ResPid2}} -> + NewRs = lists:keydelete(ResNode, 1, Rs), + put_node(N#node{resolvers = NewRs}, S0); + false when How =:= exit -> + io:format("### ~p ~p:~n there is no resolver " + "with tag ~p on node ~p~n", + [Node, Time, Tag, ResNode]), + add_spurious(Node, [ResNode], S0, Time); + false when How =:= kill -> + S0 + end + end; + not_ok -> + io:format("### ~p ~p:~n resolver stopped for unknown node~n", + [Node, Time]), + add_spurious(Node, [Node], S0, Time) + end. + +add_to_known(Node, NodeToAdd, Known) -> + if + Node =:= NodeToAdd -> + Known; + true -> + lists:sort([NodeToAdd | Known]) + end. + +get_node(Node, S) -> + case lists:keysearch(Node, #node.node, S#w.nodes) of + {value, N} -> + {ok, N}; + false -> + not_ok + end. + +put_node(#node{node = Node, known = [], nodes = [], locks = [], names = [], + n_locks = {0,0,0,0}}, + S) -> + S#w{nodes = lists:keydelete(Node, #node.node, S#w.nodes)}; +put_node(N, S) -> + S#w{nodes = lists:keyreplace(N#node.node, #node.node, S#w.nodes, N)}. + +is_fresh(#node{known = [], nodes = [], locks = [], names = []}) -> + true; +is_fresh(#node{}) -> + false; +is_fresh([]) -> + true; +is_fresh([N | Ns]) -> + is_fresh(N) andalso is_fresh(Ns). + +add_spurious(Node, ActionNodes, S, Time) when is_list(ActionNodes) -> + S#w{n = [{{Node,N},Time}|| N <- ActionNodes] ++ S#w.n}; +add_spurious(Node, ActionNode, S, Time) -> + add_spurious(Node, [ActionNode], S, Time). + +messages(D, Base, End) -> + messages1(no_info(D), no_info), + messages1(resolvers(D, Base, End), resolvers), + messages1(syncers(D), syncers). + +messages1(M, ST) -> + [foo || {Node, T} <- M, + ok =:= io:format(ms(ST), [Node, T])]. + +ms(no_info) -> + "~p: ~p~n"; +ms(resolvers) -> + "~p: resolvers ~p~n"; +ms(syncers) -> + "~p: syncers ~p~n". + +no_info(D) -> + [{Node,no_info} || {Node, no_info} <- D]. + +resolvers(D, Base, End) -> + [{Node, + [{N,adjust_time(T, Base),P} || {N, T, P} <- Rs, T < End]} || + {Node, {info,State}} <- D, + is_record(State, state), + [] =/= (Rs = (state(State))#state.resolvers)]. + +syncers(D) -> + [{Node,Ss} || {Node, {info,State}} <- D, + is_record(State, state), + [] =/= (Ss = (state(State))#state.syncers)]. + +net_kernel_nodes(NodeTrace) -> + [{Node, nkn(Trace, [])} || {Node, Trace} <- NodeTrace]. + +nkn([], _Nodes) -> + []; +nkn([{Node, Time, _Message, Ns, _X} | Ts], Nodes) -> + {NewS, _, OldS} = sofs:symmetric_partition(sofs:set(Ns), sofs:set(Nodes)), + New = sofs:to_external(NewS), + Old = sofs:to_external(OldS), + [{Node, Time, {newnode, N}, []} || N <- New] ++ + [{Node, Time, {oldnode, N}, []} || N <- Old] ++ + nkn(Ts, (Nodes -- Old) ++ New). + +negotiations(Trace) -> + Ns = [{Node,T,Added,X} || + {Node,T,{added,Added},_Nodes,X} <- Trace], + Pass = [{passive,Node,T,Added} || + {Node,T,Added,[_Ops]} <- Ns], + Act = [{active,Node,T,Other,Added,NewNodes} || + {Node,T,Added,[{new_nodes,[Other|_]=NewNodes},_Abcast,_Ops]} <- Ns], + Act ++ Pass. + +show_spurious(NodeTrace, Spurious) -> + Pairs = [{Node,ActionNode} || {{Node,ActionNode}, _Time} <- Spurious], + S = sofs:restriction(sofs:relation(NodeTrace), sofs:set(Pairs)), + [foo || + {{{Node,ANode},Times}, + {{Node,ANode},Ts}} <- lists:zip(family(Spurious), + sofs:to_external(S)), + show_spurious(Node, ANode, Times, lists:keysort(2, Ts))]. + +show_spurious(Node, ActionNode, Times, Ts) -> + io:format("** Actions for ~p on node ~p **~n", [ActionNode, Node]), + lists:map(fun(T) -> spurious(Node, T, Times) end, Ts), + io:format("-- End of actions for ~p on node ~p --~n", [ActionNode, Node]), + true. + +spurious(Node, Trace, Times) -> + As = case Trace of + {Node, _T0, {init, Node}, _Nodes, _} -> + init; % should not happen, I guess + {Node, _T0, {nodedown, _ActionNode}, _Nodes, _} -> + nodedown; + {Node, _T0, {extra_nodedown, _ActionNode}, _Nodes, _} -> + extra_nodedown; + {Node, _T0, {nodeup, _ActionNode}, _Nodes, _} -> + nodeup; + {Node, _T0, {added, Added}, _Nodes, [_Ops]} -> + {passive, Added}; + {Node, _T0, {added, Added}, _Nodes, [_NewNodes,_AbCast,_Ops]} -> + {negotiator, Added}; + {Node, _T0, {ins_lock, PNode}, _Nodes, [Id, Pid]} -> + {insert_lock, [Id, Pid, PNode]}; + {Node, _T0, {rem_lock, PNode}, _Nodes, [Id, Pid]} -> + {remove_lock, [Id, Pid, PNode]}; + {Node, _T0, {ins_name, PNode}, _Nodes, [Name, Pid]} -> + {insert_name, [Name, Pid, PNode]}; + {Node, _T0, {del_name, PNode}, _Nodes, [Name, Pid]} -> + {insert_name, [Name, Pid, PNode]}; + {Node, _T0, {nodes_changed, CNode}, _Nodes, []} -> + {nodes_changed, [CNode]}; + {Node, _T0, {Any, Some}, _Nodes, X} -> + {Any, [Some | X]} + end, + T = element(2, Trace), + _Nodes2 = element(4, Trace), + TS = ["(spurious)" || lists:member(T, Times)], + io:format("~p: ~p ~s~n", [T, As, TS]), +% io:format(" ~w~n", [_Nodes2]), + ok. + +display_nodes(Why, Time, Nodes) -> + display_nodes(Why, Time, Nodes, none). + +display_nodes(Why, Time, Nodes, LastTrace) -> + io:format("~p **** ~s ****~n", [Time, Why]), + {OkL, BossL, NodeXL, BadL} = unzip4([L || #node{n_locks = L} <- Nodes]), + [NOk, NBoss, NNodeX, NBad] = + [lists:sum(L) || L <- [OkL, BossL, NodeXL, BadL]], + Rejected = lists:sum([Rej || #node{rejected = Rej} <- Nodes]), + io:format("Locks: (~w+~w+~w=~w)/~w, ~w of ~w rejected~n", + [NOk, NBoss, NNodeX, NOk+NBoss+NNodeX, NOk+NBoss+NNodeX+NBad, + Rejected, NOk]), + lists:foreach(fun(#node{node = Node, known = Known, nodes = Ns, + locks = Locks, names = Names, + n_locks = {Ok, Boss, NodeX, Bad}, + resolvers = Resolvers0, + rejected = Rej}) -> + NodeL = io_lib:format("~p: ",[Node]), + io:format("~sknown ~p~n", [NodeL, Known]), + Sp = spaces(NodeL), + case Ns =:= Known of + true -> ok; + false -> display_list(Sp, nodes, Ns) + end, + display_list(Sp, locks, Locks), + display_list(Sp, names, lists:sort(Names)), + Resolvers = lists:sort(Resolvers0), + _ResNs = [R || {R,_,_} <- Resolvers], + %% Should check trace on this node (Node) only: + New = [N || {_,_,{nodeup,N},_,_} <- [LastTrace]], + _ResAllowed = (Ns -- New) -- Known, +%% Displays too much junk. +% case ResAllowed =:= ResNs of +% true -> ok; +% false -> display_list(Sp, resol, Resolvers) +% end, + %% This is less bulky: + case Known =:= Ns of + true -> display_list(Sp, resol, Resolvers); + false -> ok + end, + case {Ok, Boss, NodeX, Bad} of + {0, 0, 0, 0} -> ok; + _ -> io:format("~slocks (~w+~w+~w=~w)/~w, " + "~w of ~w rejected~n", + [Sp, Ok, Boss, NodeX, + Ok+Boss+NodeX,Ok+Boss+NodeX+Bad, + Rej, Ok]) + end + end, lists:keysort(#node.node, Nodes)), + io:format("\n"). + +display_list(_S, _What, []) -> + ok; +display_list(S, What, L) -> + io:format("~s~p ~p~n", [S, What, L]). + +spaces(Iolist) -> + lists:duplicate(iolist_size(Iolist), $\s). + +family(R) -> + sofs:to_external(sofs:relation_to_family(sofs:relation(R))). + +time_diff({S1,MyS1}, {S0,MyS0}) -> + ((S1*1000000+MyS1) - (S0*1000000+MyS0)) div 1000000. + +musec2sec(T) -> + S = T div 1000000, + M = (T - S * 1000000), + {S, M}. + +%%% Options + +options(Options, Keys) when is_list(Options) -> + options(Options, Keys, []); +options(Option, Keys) -> + options([Option], Keys, []). + +options(Options0, [Key | Keys], L) when is_list(Options0) -> + Options = case lists:member(Key, Options0) of + true -> + [atom_option(Key) | lists:delete(Key, Options0)]; + false -> + Options0 + end, + V = case lists:keysearch(Key, 1, Options) of + {value, {show_state, From, To}} when is_integer(From), From >= 0, + is_integer(To), To >= From -> + {ok, {{From,0}, {To,0}}}; + {value, {show_state, {From, FromMusec}, + {To, ToMusec}}} when is_integer(From), + From >= 0, + is_integer(To), + To >= From, + FromMusec >= 0, + FromMusec =< 999999, + ToMusec >= 0, + ToMusec =< 999999 -> + {ok, {{From,FromMusec}, {To,ToMusec}}}; + {value, {show_state, false}} -> + {value, default_option(show_state)}; + {value, {show_trace, Bool}} when Bool; not Bool -> + {ok, Bool}; + {value, {Key, _}} -> + badarg; + false -> + Default = default_option(Key), + {ok, Default} + end, + case V of + badarg -> + badarg; + {ok, Value} -> + NewOptions = lists:keydelete(Key, 1, Options), + options(NewOptions, Keys, [Value | L]) + end; +options([], [], L) -> + lists:reverse(L); +options(_Options, _, _L) -> + badarg. + +default_option(show_state) -> {{0,0}, {0,0}}; +default_option(show_trace) -> true. + +atom_option(show_state) -> + {show_state, 0, 1 bsl 28}; +atom_option(show_trace) -> + {show_trace, true}; +atom_option(_) -> + erlang:error(program_error, []). + +unzip4(Ts) -> unzip4(Ts, [], [], [], []). + +unzip4([{X, Y, Z, W} | Ts], Xs, Ys, Zs, Ws) -> + unzip4(Ts, [X | Xs], [Y | Ys], [Z | Zs], [W | Ws]); +unzip4([], Xs, Ys, Zs, Ws) -> + {lists:reverse(Xs), lists:reverse(Ys), + lists:reverse(Zs), lists:reverse(Ws)}. + diff --git a/lib/kernel/test/global_group_SUITE.erl b/lib/kernel/test/global_group_SUITE.erl new file mode 100644 index 0000000000..a8b87390eb --- /dev/null +++ b/lib/kernel/test/global_group_SUITE.erl @@ -0,0 +1,1415 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(global_group_SUITE). + +-export([all/1]). +-export([start_gg_proc/1, no_gg_proc/1, no_gg_proc_sync/1, compatible/1, + one_grp/1, one_grp_x/1, two_grp/1, hidden_groups/1, test_exit/1]). +-export([init/1, init/2, init2/2, start_proc/1, start_proc_rereg/1]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +%-compile(export_all). + +-include("test_server.hrl"). + +-define(NODES, [node()|nodes()]). + +-define(UNTIL(Seq), loop_until_true(fun() -> Seq end)). + +all(suite) -> + [start_gg_proc, no_gg_proc, no_gg_proc_sync, + compatible, one_grp, one_grp_x, two_grp, test_exit, + hidden_groups]. + +-define(TESTCASE, testcase_name). +-define(testcase, ?config(?TESTCASE, Config)). + +init_per_testcase(Case, Config) when atom(Case), list(Config) -> + Dog=?t:timetrap(?t:minutes(5)), + [{?TESTCASE, Case}, {watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +%%----------------------------------------------------------------- +%% Test suites for global groups. +%% Should be started in a CC view with: +%% erl -sname XXX -rsh ctrsh where XXX not in [cp1 .. cpN] +%%----------------------------------------------------------------- + + +start_gg_proc(suite) -> []; +start_gg_proc(doc) -> ["Check that the global_group processes are started automatically. "]; +start_gg_proc(Config) when list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(120)), + + ?line Dir = ?config(priv_dir, Config), + ?line File = filename:join(Dir, "global_group.config"), + ?line {ok, Fd}=file:open(File, write), + [Ncp1,Ncp2,Ncp3] = node_names([cp1, cp2, cp3], Config), + ?line config(Fd, Ncp1, Ncp2, Ncp3, "cpx", "cpy", "cpz", "cpq"), + + ?line Cp1nn = node_at(Ncp1), + ?line Cp2nn = node_at(Ncp2), + ?line Cp3nn = node_at(Ncp3), + + ?line {ok, Cp1} = start_node(Ncp1, Config), + ?line {ok, Cp2} = start_node(Ncp2, Config), + ?line {ok, Cp3} = start_node(Ncp3, Config), + + ?line [] = rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}]), + ?line [] = rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}]), + ?line [] = rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}]), + + % stop the nodes, and make sure names are released. + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + + ?line ?UNTIL(undefined =:= global:whereis_name(test)), + ?line test_server:timetrap_cancel(Dog), + ok. + + + +no_gg_proc(suite) -> []; +no_gg_proc(doc) -> ["Start a system without global groups. Nodes are not " + "synced at start (sync_nodes_optional is not defined)"]; +no_gg_proc(Config) when list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(200)), + + ?line Dir = ?config(priv_dir, Config), + ?line File = filename:join(Dir, "no_global_group.config"), + ?line {ok, Fd} = file:open(File, write), + ?line config_no(Fd), + + ?line NN = node_name(atom_to_list(node())), + ?line Cp1nn = list_to_atom("cp1@" ++ NN), + ?line Cp2nn = list_to_atom("cp2@" ++ NN), + ?line Cp3nn = list_to_atom("cp3@" ++ NN), + ?line Cpxnn = list_to_atom("cpx@" ++ NN), + ?line Cpynn = list_to_atom("cpy@" ++ NN), + ?line Cpznn = list_to_atom("cpz@" ++ NN), + + ?line {ok, Cp1} = start_node_no(cp1, Config), + ?line {ok, Cp2} = start_node_no(cp2, Config), + ?line {ok, Cp3} = start_node_no(cp3, Config), + ?line {ok, Cpx} = start_node_no(cpx, Config), + ?line {ok, Cpy} = start_node_no(cpy, Config), + ?line {ok, Cpz} = start_node_no(cpz, Config), + + %% let the nodes know of each other + ?line pong = rpc:call(Cp1, net_adm, ping, [Cp2nn]), + ?line pong = rpc:call(Cp2, net_adm, ping, [Cp3nn]), + ?line pong = rpc:call(Cp3, net_adm, ping, [Cpxnn]), + ?line pong = rpc:call(Cpx, net_adm, ping, [Cpynn]), + ?line pong = rpc:call(Cpy, net_adm, ping, [Cpznn]), + + ?line wait_for_ready_net(), + + ?line [test_server] = rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}]), + ?line [test_server] = rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}]), + ?line [test_server] = rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}]), + ?line [test_server] = rpc:call(Cp1, global_group, registered_names, [{node, Cpxnn}]), + ?line [test_server] = rpc:call(Cp2, global_group, registered_names, [{node, Cpynn}]), + ?line [test_server] = rpc:call(Cp3, global_group, registered_names, [{node, Cpznn}]), + + + % start a proc and register it + ?line {Pid2, yes} = rpc:call(Cp2, ?MODULE, start_proc, [test2]), + + ?line RegNames = lists:sort([test2,test_server]), + + ?line RegNames = + lists:sort( + rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp1, global_group, registered_names, [{node, Cpxnn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp2, global_group, registered_names, [{node, Cpynn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp3, global_group, registered_names, [{node, Cpznn}])), + + + ?line undefined = rpc:call(Cp3, global_group, global_groups, []), + + ?line Own_nodes_should = [node(), Cp1nn, Cp2nn, Cp3nn, + Cpxnn, Cpynn, Cpznn], + ?line Own_nodes = rpc:call(Cp3, global_group, own_nodes, []), + ?line true = (Own_nodes -- Own_nodes_should) =:= [], + ?line true = (Own_nodes_should -- Own_nodes) =:= [], + + ?line Pid2 = rpc:call(Cp1, global_group, send, [test2, {ping, self()}]), + ?line receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + ?line Pid2 = rpc:call(Cp2, global_group, send, [test2, {ping, self()}]), + ?line receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout3) + end, + ?line Pid2 = rpc:call(Cpz, global_group, send, [test2, {ping, self()}]), + ?line receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout4) + end, + + + % start a proc and register it + ?line {PidX, yes} = rpc:call(Cpx, ?MODULE, start_proc, [test]), + + + %%------------------------------------ + %% Test monitor nodes + %%------------------------------------ + ?line Pid2 = rpc:call(Cp1, global_group, send, [{node, Cp2nn}, test2, monitor]), + ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, monitor]), + + + % Kill node Cp1 + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodedown, Cp1}]), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodedown, Cp1}]), + ?line test_server:sleep(100), + ?line stop_node(Cp1), + ?line test_server:sleep(1000), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + + % Kill node Cpz + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodedown, Cpz}]), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodedown, Cpz}]), + ?line test_server:sleep(100), + ?line stop_node(Cpz), + ?line test_server:sleep(1000), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + + % Restart node Cp1 + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodeup, Cp1}]), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodeup, Cp1}]), + ?line {ok, Cp1} = start_node_no(cp1, Config), + ?line pong = rpc:call(Cp2, net_adm, ping, [Cp1nn]), + ?line pong = rpc:call(Cpx, net_adm, ping, [Cp1nn]), + ?line wait_for_ready_net(), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + + % Restart node Cpz + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodeup, Cpz}]), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodeup, Cpz}]), + ?line {ok, Cpz} = start_node_no(cpz, Config), + ?line pong = rpc:call(Cp2, net_adm, ping, [Cpznn]), + ?line pong = rpc:call(Cpx, net_adm, ping, [Cpznn]), + ?line wait_for_ready_net(), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + + % stop the nodes, and make sure names are released. + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + stop_node(Cpx), + stop_node(Cpy), + stop_node(Cpz), + + ?line ?UNTIL(undefined =:= global:whereis_name(test)), + ?line test_server:timetrap_cancel(Dog), + ok. + + + + +no_gg_proc_sync(suite) -> []; +no_gg_proc_sync(doc) -> + ["Start a system without global groups, but syncing the nodes by using " + "sync_nodes_optional."]; +no_gg_proc_sync(Config) when list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(200)), + + ?line Dir = ?config(priv_dir, Config), + ?line File = filename:join(Dir, "no_global_group_sync.config"), + ?line {ok, Fd} = file:open(File, write), + + [Ncp1,Ncp2,Ncp3,Ncpx,Ncpy,Ncpz] = + node_names([cp1,cp2,cp3,cpx,cpy,cpz], Config), + ?line config_sync(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz), + + ?line Cp1nn = node_at(Ncp1), + ?line Cp2nn = node_at(Ncp2), + ?line Cp3nn = node_at(Ncp3), + ?line Cpxnn = node_at(Ncpx), + ?line Cpynn = node_at(Ncpy), + ?line Cpznn = node_at(Ncpz), + + ?line {ok, Cp1} = start_node_no2(Ncp1, Config), + ?line {ok, Cp2} = start_node_no2(Ncp2, Config), + ?line {ok, Cp3} = start_node_no2(Ncp3, Config), + ?line {ok, Cpx} = start_node_no2(Ncpx, Config), + ?line {ok, Cpy} = start_node_no2(Ncpy, Config), + ?line {ok, Cpz} = start_node_no2(Ncpz, Config), + + %% let the nodes know of each other + ?line pong = rpc:call(Cp1, net_adm, ping, [Cp2nn]), + ?line pong = rpc:call(Cp2, net_adm, ping, [Cp3nn]), + ?line pong = rpc:call(Cp3, net_adm, ping, [Cpxnn]), + ?line pong = rpc:call(Cpx, net_adm, ping, [Cpynn]), + ?line pong = rpc:call(Cpy, net_adm, ping, [Cpznn]), + + ?line wait_for_ready_net(), + + ?line [test_server] = rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}]), + ?line [test_server] = rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}]), + ?line [test_server] = rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}]), + ?line [test_server] = rpc:call(Cp1, global_group, registered_names, [{node, Cpxnn}]), + ?line [test_server] = rpc:call(Cp2, global_group, registered_names, [{node, Cpynn}]), + ?line [test_server] = rpc:call(Cp3, global_group, registered_names, [{node, Cpznn}]), + + + % start a proc and register it + ?line {Pid2, yes} = rpc:call(Cp2, ?MODULE, start_proc, [test2]), + + ?line RegNames = lists:sort([test2,test_server]), + + ?line RegNames = + lists:sort( + rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp1, global_group, registered_names, [{node, Cpxnn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp2, global_group, registered_names, [{node, Cpynn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp3, global_group, registered_names, [{node, Cpznn}])), + + + ?line undefined = rpc:call(Cp3, global_group, global_groups, []), + + ?line Own_nodes_should = [node(), Cp1nn, Cp2nn, Cp3nn, + Cpxnn, Cpynn, Cpznn], + ?line Own_nodes = rpc:call(Cp3, global_group, own_nodes, []), + ?line true = (Own_nodes -- Own_nodes_should) =:= [], + ?line true = (Own_nodes_should -- Own_nodes) =:= [], + + ?line Pid2 = rpc:call(Cp1, global_group, send, [test2, {ping, self()}]), + ?line receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + ?line Pid2 = rpc:call(Cp2, global_group, send, [test2, {ping, self()}]), + ?line receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout3) + end, + ?line Pid2 = rpc:call(Cpz, global_group, send, [test2, {ping, self()}]), + ?line receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout4) + end, + + + % start a proc and register it + ?line {PidX, yes} = rpc:call(Cpx, ?MODULE, start_proc, [test]), + + + %%------------------------------------ + %% Test monitor nodes + %%------------------------------------ + ?line Pid2 = rpc:call(Cp1, global_group, send, [{node, Cp2nn}, test2, monitor]), + ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, monitor]), + + + % Kill node Cp1 + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodedown, Cp1}]), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodedown, Cp1}]), + ?line test_server:sleep(100), + ?line stop_node(Cp1), + ?line test_server:sleep(1000), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + + % Kill node Cpz + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodedown, Cpz}]), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodedown, Cpz}]), + ?line test_server:sleep(100), + ?line stop_node(Cpz), + ?line test_server:sleep(1000), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + + % Restart node Cp1 + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodeup, Cp1}]), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodeup, Cp1}]), + ?line {ok, Cp1} = start_node_no2(Ncp1, Config), + ?line pong = rpc:call(Cp2, net_adm, ping, [Cp1nn]), + ?line pong = rpc:call(Cpx, net_adm, ping, [Cp1nn]), + ?line wait_for_ready_net(), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + + % Restart node Cpz + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodeup, Cpz}]), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodeup, Cpz}]), + ?line {ok, Cpz} = start_node_no2(Ncpz, Config), + ?line pong = rpc:call(Cp2, net_adm, ping, [Cpznn]), + ?line pong = rpc:call(Cpx, net_adm, ping, [Cpznn]), + ?line wait_for_ready_net(), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + + % stop the nodes, and make sure names are released. + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + stop_node(Cpx), + stop_node(Cpy), + stop_node(Cpz), + + ?line ?UNTIL(undefined =:= global:whereis_name(test)), + ?line test_server:timetrap_cancel(Dog), + ok. + + + + +compatible(suite) -> []; +compatible(doc) -> + ["Check that a system without global groups is compatible with the old R4 system."]; +compatible(Config) when list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(200)), + + ?line Dir = ?config(priv_dir, Config), + ?line File = filename:join(Dir, "global_group_comp.config"), + ?line {ok, Fd} = file:open(File, write), + + [Ncp1,Ncp2,Ncp3,Ncpx,Ncpy,Ncpz] = + node_names([cp1,cp2,cp3,cpx,cpy,cpz], Config), + ?line config_comp(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz), + + ?line Cp1nn = node_at(Ncp1), + ?line Cp2nn = node_at(Ncp2), + ?line Cp3nn = node_at(Ncp3), + ?line Cpxnn = node_at(Ncpx), + ?line Cpynn = node_at(Ncpy), + ?line Cpznn = node_at(Ncpz), + + ?line {ok, Cp1} = start_node_comp(Ncp1, Config), + ?line {ok, Cp2} = start_node_comp(Ncp2, Config), + ?line {ok, Cp3} = start_node_comp(Ncp3, Config), + ?line {ok, Cpx} = start_node_comp(Ncpx, Config), + ?line {ok, Cpy} = start_node_comp(Ncpy, Config), + ?line {ok, Cpz} = start_node_comp(Ncpz, Config), + + %% let the nodes know of each other + ?line pong = rpc:call(Cp1, net_adm, ping, [Cp2nn]), + ?line pong = rpc:call(Cp2, net_adm, ping, [Cp3nn]), + ?line pong = rpc:call(Cp3, net_adm, ping, [Cpxnn]), + ?line pong = rpc:call(Cpx, net_adm, ping, [Cpynn]), + ?line pong = rpc:call(Cpy, net_adm, ping, [Cpznn]), + + ?line wait_for_ready_net(), + + ?line [test_server] = rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}]), + ?line [test_server] = rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}]), + ?line [test_server] = rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}]), + ?line [test_server] = rpc:call(Cp1, global_group, registered_names, [{node, Cpxnn}]), + ?line [test_server] = rpc:call(Cp2, global_group, registered_names, [{node, Cpynn}]), + ?line [test_server] = rpc:call(Cp3, global_group, registered_names, [{node, Cpznn}]), + + + % start a proc and register it + ?line {Pid2, yes} = rpc:call(Cp2, ?MODULE, start_proc, [test2]), + + ?line RegNames = lists:sort([test2,test_server]), + + ?line RegNames = + lists:sort( + rpc:call(Cp1, global_group, registered_names, [{node, Cp1nn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp2, global_group, registered_names, [{node, Cp2nn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp3, global_group, registered_names, [{node, Cp3nn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp1, global_group, registered_names, [{node, Cpxnn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp2, global_group, registered_names, [{node, Cpynn}])), + ?line RegNames = + lists:sort( + rpc:call(Cp3, global_group, registered_names, [{node, Cpznn}])), + + + ?line undefined = rpc:call(Cp3, global_group, global_groups, []), + + ?line Own_nodes_should = [node(), Cp1nn, Cp2nn, Cp3nn, + Cpxnn, Cpynn, Cpznn], + ?line Own_nodes = rpc:call(Cp3, global_group, own_nodes, []), + ?line true = (Own_nodes -- Own_nodes_should) =:= [], + ?line true = (Own_nodes_should -- Own_nodes) =:= [], + + ?line Pid2 = rpc:call(Cp1, global_group, send, [test2, {ping, self()}]), + ?line receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + ?line Pid2 = rpc:call(Cp2, global_group, send, [test2, {ping, self()}]), + ?line receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout3) + end, + ?line Pid2 = rpc:call(Cpz, global_group, send, [test2, {ping, self()}]), + ?line receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout4) + end, + + + % start a proc and register it + ?line {PidX, yes} = rpc:call(Cpx, ?MODULE, start_proc, [test]), + + + %%------------------------------------ + %% Test monitor nodes + %%------------------------------------ + ?line Pid2 = rpc:call(Cp1, global_group, send, [{node, Cp2nn}, test2, monitor]), + ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, monitor]), + + + % Kill node Cp1 + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodedown, Cp1}]), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodedown, Cp1}]), + ?line test_server:sleep(100), + ?line stop_node(Cp1), + ?line test_server:sleep(1000), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + + % Kill node Cpz + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodedown, Cpz}]), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodedown, Cpz}]), + ?line test_server:sleep(100), + ?line stop_node(Cpz), + ?line test_server:sleep(1000), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + + % Restart node Cp1 + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodeup, Cp1}]), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodeup, Cp1}]), + ?line {ok, Cp1} = start_node_comp(Ncp1, Config), + ?line pong = rpc:call(Cp2, net_adm, ping, [Cp1nn]), + ?line pong = rpc:call(Cpx, net_adm, ping, [Cp1nn]), + ?line wait_for_ready_net(), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + + % Restart node Cpz + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, {wait_nodeup, Cpz}]), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, {wait_nodeup, Cpz}]), + ?line {ok, Cpz} = start_node_comp(Ncpz, Config), + ?line pong = rpc:call(Cp2, net_adm, ping, [Cpznn]), + ?line pong = rpc:call(Cpx, net_adm, ping, [Cpznn]), + ?line wait_for_ready_net(), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + + % stop the nodes, and make sure names are released. + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + stop_node(Cpx), + stop_node(Cpy), + stop_node(Cpz), + + ?line ?UNTIL(undefined =:= global:whereis_name(test)), + ?line test_server:timetrap_cancel(Dog), + ok. + + + + +one_grp(suite) -> []; +one_grp(doc) -> ["Test a system with only one global group. "]; +one_grp(Config) when list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(120)), + + ?line Dir = ?config(priv_dir, Config), + ?line File = filename:join(Dir, "global_group.config"), + ?line {ok, Fd} = file:open(File, write), + [Ncp1,Ncp2,Ncp3] = node_names([cp1, cp2, cp3], Config), + ?line config(Fd, Ncp1, Ncp2, Ncp3, "cpx", "cpy", "cpz", "cpq"), + + ?line {ok, Cp1} = start_node(Ncp1, Config), + ?line {ok, Cp2} = start_node(Ncp2, Config), + ?line {ok, Cp3} = start_node(Ncp3, Config), + + % sleep a while to make the global_group to sync... + test_server:sleep(1000), + + % start a proc and register it + ?line {Pid, yes} = rpc:call(Cp1, ?MODULE, start_proc, [test]), + + % test that it is registered at all nodes + ?line Pid = rpc:call(Cp1, global, whereis_name, [test]), + ?line Pid = rpc:call(Cp2, global, whereis_name, [test]), + ?line Pid = rpc:call(Cp3, global, whereis_name, [test]), + + % try to register the same name + ?line no = rpc:call(Cp1, global, register_name, [test, self()]), + + % let process exit, check that it is unregistered automatically + Pid ! die, + ?line + ?UNTIL(begin + (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and + (undefined =:= rpc:call(Cp2, global, whereis_name, [test])) and + (undefined =:= rpc:call(Cp3, global, whereis_name, [test])) + end), + + % test re_register + ?line {Pid2, yes} = rpc:call(Cp1, ?MODULE, start_proc, [test]), + ?line Pid2 = rpc:call(Cp3, global, whereis_name, [test]), + Pid3 = rpc:call(Cp3, ?MODULE, start_proc_rereg, [test]), + ?line Pid3 = rpc:call(Cp3, global, whereis_name, [test]), + + % test sending + rpc:call(Cp1, global, send, [test, {ping, self()}]), + receive + {pong, Cp3} -> ok + after + 2000 -> test_server:fail(timeout1) + end, + + rpc:call(Cp3, global, send, [test, {ping, self()}]), + receive + {pong, Cp3} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + + ?line rpc:call(Cp3, global, unregister_name, [test]), + ?line undefined = rpc:call(Cp1, global, whereis_name, [test]), + ?line undefined = rpc:call(Cp2, global, whereis_name, [test]), + ?line undefined = rpc:call(Cp3, global, whereis_name, [test]), + + Pid3 ! die, + ?line ?UNTIL(undefined =:= rpc:call(Cp3, global, whereis_name, [test])), + + % register a proc + ?line {_, yes} = rpc:call(Cp3, ?MODULE, start_proc, [test]), + + % stop the nodes, and make sure names are released. + stop_node(Cp3), + + ?line ?UNTIL(undefined =:= rpc:call(Cp1, global, whereis_name, [test])), + Pid2 ! die, + + stop_node(Cp1), + stop_node(Cp2), + + ?line test_server:timetrap_cancel(Dog), + ok. + + + + + +one_grp_x(suite) -> []; +one_grp_x(doc) -> ["Check a system with only one global group. " + "Start the nodes with different time intervals. "]; +one_grp_x(Config) when list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(120)), + + ?line Dir = ?config(priv_dir, Config), + ?line File = filename:join(Dir, "global_group.config"), + ?line {ok, Fd} = file:open(File, write), + [Ncp1,Ncp2,Ncp3] = node_names([cp1, cp2, cp3], Config), + ?line config(Fd, Ncp1, Ncp2, Ncp3, "cpx", "cpy", "cpz", "cpq"), + + ?line {ok, Cp1} = start_node(Ncp1, Config), + % sleep a while to make the global_group to sync... + test_server:sleep(1000), + + % start a proc and register it + ?line {Pid, yes} = rpc:call(Cp1, ?MODULE, start_proc, [test]), + + ?line {ok, Cp2} = start_node(Ncp2, Config), + % sleep a while to make the global_group to sync... + test_server:sleep(1000), + + % test that it is registered at all nodes + ?line Pid = rpc:call(Cp1, global, whereis_name, [test]), + ?line Pid = rpc:call(Cp2, global, whereis_name, [test]), + + ?line {ok, Cp3} = start_node(Ncp3, Config), + % sleep a while to make the global_group to sync... + test_server:sleep(1000), + + ?line Pid = rpc:call(Cp3, global, whereis_name, [test]), + + % try to register the same name + ?line no = rpc:call(Cp1, global, register_name, [test, self()]), + + % let process exit, check that it is unregistered automatically + Pid ! die, + ?line + ?UNTIL(begin + (undefined =:= rpc:call(Cp1, global, whereis_name, [test])) and + (undefined =:= rpc:call(Cp2, global, whereis_name, [test])) and + (undefined =:= rpc:call(Cp3, global, whereis_name, [test])) + end), + + % test re_register + ?line {Pid2, yes} = rpc:call(Cp1, ?MODULE, start_proc, [test]), + ?line Pid2 = rpc:call(Cp3, global, whereis_name, [test]), + + Pid2 ! die, + + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + + ?line test_server:timetrap_cancel(Dog), + ok. + + + + + + +two_grp(suite) -> []; +two_grp(doc) -> ["Test a two global group system. "]; +two_grp(Config) when list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(200)), + + ?line Dir = ?config(priv_dir, Config), + ?line File = filename:join(Dir, "global_group.config"), + ?line {ok, Fd} = file:open(File, write), + + [Ncp1,Ncp2,Ncp3,Ncpx,Ncpy,Ncpz,Ncpq] = + node_names([cp1,cp2,cp3,cpx,cpy,cpz,cpq], Config), + ?line config(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz, Ncpq), + + ?line Cp1nn = node_at(Ncp1), + ?line Cp2nn = node_at(Ncp2), + ?line Cp3nn = node_at(Ncp3), + ?line Cpxnn = node_at(Ncpx), + ?line Cpynn = node_at(Ncpy), + ?line Cpznn = node_at(Ncpz), + + ?line {ok, Cp1} = start_node(Ncp1, Config), + ?line {ok, Cp2} = start_node(Ncp2, Config), + ?line {ok, Cp3} = start_node(Ncp3, Config), + ?line {ok, Cpx} = start_node(Ncpx, Config), + ?line {ok, Cpy} = start_node(Ncpy, Config), + ?line {ok, Cpz} = start_node(Ncpz, Config), + + %% The groups (cpq not started): + %% [{nc1, [cp1,cp2,cp3]}, {nc2, [cpx,cpy,cpz]}, {nc3, [cpq]}] + + % sleep a while to make the global_groups to sync... + test_server:sleep(1000), + + % check the global group names + ?line {nc1, [nc2, nc3]} = rpc:call(Cp1, global_group, global_groups, []), + ?line {nc1, [nc2, nc3]} = rpc:call(Cp2, global_group, global_groups, []), + ?line {nc1, [nc2, nc3]} = rpc:call(Cp3, global_group, global_groups, []), + ?line {nc2, [nc1, nc3]} = rpc:call(Cpx, global_group, global_groups, []), + ?line {nc2, [nc1, nc3]} = rpc:call(Cpy, global_group, global_groups, []), + ?line {nc2, [nc1, nc3]} = rpc:call(Cpz, global_group, global_groups, []), + + % check the global group nodes + ?line [Cp1nn, Cp2nn, Cp3nn] = rpc:call(Cp1, global_group, own_nodes, []), + ?line [Cp1nn, Cp2nn, Cp3nn] = rpc:call(Cp2, global_group, own_nodes, []), + ?line [Cp1nn, Cp2nn, Cp3nn] = rpc:call(Cp3, global_group, own_nodes, []), + ?line [Cpxnn, Cpynn, Cpznn] = rpc:call(Cpx, global_group, own_nodes, []), + ?line [Cpxnn, Cpynn, Cpznn] = rpc:call(Cpy, global_group, own_nodes, []), + ?line [Cpxnn, Cpynn, Cpznn] = rpc:call(Cpz, global_group, own_nodes, []), + + + % start a proc and register it + ?line {Pid1, yes} = rpc:call(Cp1, ?MODULE, start_proc, [test]), + + ?line Pid1 = rpc:call(Cp1, global_group, send, [test, {io, from_cp1}]), + ?line Pid1 = rpc:call(Cpx, global_group, send, [test, {io, from_cpx}]), + ?line Pid1 = rpc:call(Cp1, global_group, send, [{group,nc1}, test, + {io, from_cp1}]), + ?line [test] = + rpc:call(Cpx, global_group, registered_names, [{node, Cp1nn}]), + ?line [test] = + rpc:call(Cpx, global_group, registered_names, [{group, nc1}]), + ?line [] = rpc:call(Cpx, global_group, registered_names, [{node, Cpxnn}]), + ?line [] = rpc:call(Cpx, global_group, registered_names, [{group, nc2}]), + ?line Pid1 = rpc:call(Cpx, global_group, send, [{group,nc1}, test, + {io, from_cp1}]), + ?line {badarg,{test,{io,from_cpx}}} = + rpc:call(Cp1, global_group, send, [{group,nc2}, test, {io, from_cpx}]), + ?line {badarg,{test,{io,from_cpx}}} = + rpc:call(Cpx, global_group, send, [{group,nc2}, test, {io, from_cpx}]), + + + + % test that it is registered at all nodes + ?line Pid1 = rpc:call(Cp1, global, whereis_name, [test]), + ?line Pid1 = rpc:call(Cp2, global, whereis_name, [test]), + ?line Pid1 = rpc:call(Cp3, global, whereis_name, [test]), + ?line undefined = rpc:call(Cpx, global, whereis_name, [test]), + ?line undefined = rpc:call(Cpy, global, whereis_name, [test]), + ?line undefined = rpc:call(Cpz, global, whereis_name, [test]), + + % start a proc and register it + ?line {PidX, yes} = rpc:call(Cpx, ?MODULE, start_proc, [test]), + + % test that it is registered at all nodes + ?line Pid1 = rpc:call(Cp1, global, whereis_name, [test]), + ?line Pid1 = rpc:call(Cp2, global, whereis_name, [test]), + ?line Pid1 = rpc:call(Cp3, global, whereis_name, [test]), + ?line PidX = rpc:call(Cpx, global, whereis_name, [test]), + ?line PidX = rpc:call(Cpy, global, whereis_name, [test]), + ?line PidX = rpc:call(Cpz, global, whereis_name, [test]), + + Pid1 ! die, + %% If we don't wait for global on other nodes to have updated its + %% tables, 'test' may still be defined at the point when it is + %% tested a few lines below. + ?line + ?UNTIL(begin + Pid = rpc:call(Cp2, global, whereis_name, [test]), + undefined =:= Pid + end), + + % start a proc and register it + ?line {Pid2, yes} = rpc:call(Cp2, ?MODULE, start_proc, [test2]), + + % test that it is registered at all nodes + ?line Pid2 = rpc:call(Cp1, global, whereis_name, [test2]), + ?line Pid2 = rpc:call(Cp2, global, whereis_name, [test2]), + ?line Pid2 = rpc:call(Cp3, global, whereis_name, [test2]), + ?line PidX = rpc:call(Cpx, global, whereis_name, [test]), + ?line PidX = rpc:call(Cpy, global, whereis_name, [test]), + ?line PidX = rpc:call(Cpz, global, whereis_name, [test]), + + ?line undefined = rpc:call(Cp1, global, whereis_name, [test]), + ?line undefined = rpc:call(Cp2, global, whereis_name, [test]), + ?line undefined = rpc:call(Cp3, global, whereis_name, [test]), + ?line undefined = rpc:call(Cpx, global, whereis_name, [test2]), + ?line undefined = rpc:call(Cpy, global, whereis_name, [test2]), + ?line undefined = rpc:call(Cpz, global, whereis_name, [test2]), + + + ?line Pid2 = rpc:call(Cp1, global_group, send, [test2, {ping, self()}]), + receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + ?line Pid2 = rpc:call(Cp2, global_group, send, [test2, {ping, self()}]), + receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + ?line Pid2 = rpc:call(Cp3, global_group, send, [test2, {ping, self()}]), + receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + + ?line PidX = rpc:call(Cpx, global_group, send, [test, {ping, self()}]), + receive + {pong, Cpx} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + ?line PidX = rpc:call(Cpy, global_group, send, [test, {ping, self()}]), + receive + {pong, Cpx} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + ?line PidX = rpc:call(Cpz, global_group, send, [test, {ping, self()}]), + receive + {pong, Cpx} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + + ?line Pid2 = rpc:call(Cpx, global_group, send, [{node, Cp1nn}, test2, + {ping, self()}]), + receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + ?line Pid2 = rpc:call(Cpy, global_group, send, [{node, Cp2nn}, test2, + {ping, self()}]), + receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + ?line Pid2 = rpc:call(Cpz, global_group, send, [{node, Cp3nn}, test2, + {ping, self()}]), + receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + + ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpznn}, test, + {ping, self()}]), + receive + {pong, Cpx} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + ?line PidX = rpc:call(Cpy, global_group, send, [{node, Cpxnn}, test, + {ping, self()}]), + receive + {pong, Cpx} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + ?line PidX = rpc:call(Cpz, global_group, send, [{node, Cpynn}, test, + {ping, self()}]), + receive + {pong, Cpx} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + + ?line Pid2 = rpc:call(Cpx, global_group, send, [{group, nc1}, test2, + {ping, self()}]), + receive + {pong, Cp2} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + ?line PidX = rpc:call(Cpy, global_group, send, [{group, nc2}, test, + {ping, self()}]), + receive + {pong, Cpx} -> ok + after + 2000 -> test_server:fail(timeout2) + end, + + %%------------------------------------ + %% Test monitor nodes + %%------------------------------------ + ?line Pid2 = + rpc:call(Cp1, global_group, send, [{node, Cp2nn}, test2, monitor]), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, monitor]), + + + % Kill node Cp1 + ?line Pid2 = rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, + {wait_nodedown, Cp1}]), + ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, + {wait_nodedown, Cp1}]), + ?line test_server:sleep(100), + ?line stop_node(Cp1), + ?line test_server:sleep(1000), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop_nodedown), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, to_loop]), + + % Kill node Cpz + ?line Pid2 = rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, + {wait_nodedown, Cpz}]), + ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, + {wait_nodedown, Cpz}]), + ?line test_server:sleep(100), + ?line stop_node(Cpz), + ?line test_server:sleep(1000), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop_nodedown), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, to_loop]), + + % Restart node Cp1 + ?line [Cp1nn, Cp2nn, Cp3nn] = rpc:call(Cp2, global_group, own_nodes, []), + ?line Pid2 = rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, + {wait_nodeup, Cp1}]), + ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, + {wait_nodeup, Cp1}]), + ?line test_server:sleep(100), + ?line {ok, Cp1} = start_node(Ncp1, Config), + ?line test_server:sleep(5000), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop_nodeup), + ?line PidX = + rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, to_loop]), + + + % Restart node Cpz + ?line Pid2 = rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, + {wait_nodeup, Cpz}]), + ?line PidX = rpc:call(Cpx, global_group, send, [{node, Cpxnn}, test, + {wait_nodeup, Cpz}]), + ?line test_server:sleep(100), + ?line {ok, Cpz} = start_node(Ncpz, Config), + ?line test_server:sleep(5000), + + ?line ok = assert_loop(Cp2, Cp2nn, test2, Pid2, loop_nodeup), + ?line ok = assert_loop(Cpx, Cpxnn, test, PidX, loop), + ?line Pid2 = + rpc:call(Cp2, global_group, send, [{node, Cp2nn}, test2, to_loop]), + + + Pid2 ! die, + PidX ! die, + + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + stop_node(Cpx), + stop_node(Cpy), + stop_node(Cpz), + + ?line test_server:timetrap_cancel(Dog), + ok. + + + +hidden_groups(suite) -> []; +hidden_groups(doc) -> ["Test hidden global groups."]; +hidden_groups(Config) when list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(200)), + + ?line Dir = ?config(priv_dir, Config), + ?line File = filename:join(Dir, "global_group.config"), + ?line {ok, Fd} = file:open(File, write), + + [Ncp1,Ncp2,Ncp3,Ncpx,Ncpy,Ncpz,Ncpq] = + node_names([cp1,cp2,cp3,cpx,cpy,cpz,cpq], Config), + ?line config_hidden(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz, Ncpq), + + ?line {ok, Cp1} = start_node(Ncp1, Config), + ?line {ok, Cp2} = start_node(Ncp2, Config), + ?line {ok, Cp3} = start_node(Ncp3, Config), + ?line {ok, Cpx} = start_node(Ncpx, Config), + ?line {ok, Cpy} = start_node(Ncpy, Config), + ?line {ok, Cpz} = start_node(Ncpz, Config), + ?line {ok, Cpq} = start_node(Ncpq, Config), + + % sleep a while to make the global_groups to sync... + test_server:sleep(1000), + + % check the global group names + ?line {nc1, [nc2, nc3]} = rpc:call(Cp1, global_group, global_groups, []), + ?line {nc1, [nc2, nc3]} = rpc:call(Cp2, global_group, global_groups, []), + ?line {nc1, [nc2, nc3]} = rpc:call(Cp3, global_group, global_groups, []), + ?line {nc2, [nc1, nc3]} = rpc:call(Cpx, global_group, global_groups, []), + ?line {nc2, [nc1, nc3]} = rpc:call(Cpy, global_group, global_groups, []), + ?line {nc2, [nc1, nc3]} = rpc:call(Cpz, global_group, global_groups, []), + + % check the global group nodes + ?line [Cp1, Cp2, Cp3] = rpc:call(Cp1, global_group, own_nodes, []), + ?line [Cp1, Cp2, Cp3] = rpc:call(Cp2, global_group, own_nodes, []), + ?line [Cp1, Cp2, Cp3] = rpc:call(Cp3, global_group, own_nodes, []), + ?line [Cpx, Cpy, Cpz] = rpc:call(Cpx, global_group, own_nodes, []), + ?line [Cpx, Cpy, Cpz] = rpc:call(Cpy, global_group, own_nodes, []), + ?line [Cpx, Cpy, Cpz] = rpc:call(Cpz, global_group, own_nodes, []), + ?line [Cpq] = rpc:call(Cpq, global_group, own_nodes, []), + + % Make some inter group connections + ?line pong = rpc:call(Cp1, net_adm, ping, [Cpx]), + ?line pong = rpc:call(Cpy, net_adm, ping, [Cp2]), + ?line pong = rpc:call(Cp3, net_adm, ping, [Cpx]), + ?line pong = rpc:call(Cpz, net_adm, ping, [Cp3]), + ?line pong = rpc:call(Cpq, net_adm, ping, [Cp1]), + ?line pong = rpc:call(Cpz, net_adm, ping, [Cpq]), + + % Check that no inter group connections are visible + NC1Nodes = lists:sort([Cp1, Cp2, Cp3]), + NC2Nodes = lists:sort([Cpx, Cpy, Cpz]), + ?line NC1Nodes = lists:sort([Cp1|rpc:call(Cp1, erlang, nodes, [])]), + ?line NC1Nodes = lists:sort([Cp2|rpc:call(Cp2, erlang, nodes, [])]), + ?line NC1Nodes = lists:sort([Cp3|rpc:call(Cp3, erlang, nodes, [])]), + ?line NC2Nodes = lists:sort([Cpx|rpc:call(Cpx, erlang, nodes, [])]), + ?line NC2Nodes = lists:sort([Cpy|rpc:call(Cpy, erlang, nodes, [])]), + ?line NC2Nodes = lists:sort([Cpz|rpc:call(Cpz, erlang, nodes, [])]), + NC12Nodes = lists:append(NC1Nodes, NC2Nodes), + ?line false = lists:any(fun(N) -> lists:member(N, NC12Nodes) end, + rpc:call(Cpq, erlang, nodes, [])), + + + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + stop_node(Cpx), + stop_node(Cpy), + stop_node(Cpz), + stop_node(Cpq), + + ?line test_server:timetrap_cancel(Dog), + ok. + + +test_exit(suite) -> []; +test_exit(doc) -> ["Checks when the search process exits. "]; +test_exit(Config) when list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(120)), + + ?line NN = node_name(atom_to_list(node())), + ?line Cp1nn = list_to_atom("cp1@" ++ NN), + + ?line {ok, Cp1} = start_node(cp1, Config), + ?line {ok, Cp2} = start_node(cp2, Config), + ?line {ok, Cp3} = start_node(cp3, Config), + + test_server:sleep(1000), + + ?line {error, illegal_function_call} = + rpc:call(Cp1, global_group, registered_names_test, [{node, Cp1nn}]), + ?line {badarg,_} = + rpc:call(Cp1, global_group, send, [king, "The message"]), + ?line undefined = rpc:call(Cp1, global_group, whereis_name, [king]), + + % stop the nodes, and make sure names are released. + stop_node(Cp1), + stop_node(Cp2), + stop_node(Cp3), + + % sleep to let the nodes die + test_server:sleep(1000), + + ?line test_server:timetrap_cancel(Dog), + ok. + + +start_node(Name, Config) -> + Pa=filename:dirname(code:which(?MODULE)), + Dir=?config(priv_dir, Config), + ConfFile = " -config " ++ filename:join(Dir, "global_group"), + test_server:start_node(Name, slave, [{args, "-pa " ++ Pa ++ ConfFile}]). + +start_node_no(Name, Config) -> + Pa=filename:dirname(code:which(?MODULE)), + Dir=?config(priv_dir, Config), + ConfFile = " -config " ++ filename:join(Dir, "no_global_group"), + test_server:start_node(Name, slave, [{args, "-pa " ++ Pa ++ ConfFile}]). + +start_node_no2(Name, Config) -> + Pa=filename:dirname(code:which(?MODULE)), + Dir=?config(priv_dir, Config), + ConfFile = " -config " ++ filename:join(Dir, "no_global_group_sync"), + test_server:start_node(Name, slave, [{args, "-pa " ++ Pa ++ ConfFile}]). + +start_node_comp(Name, Config) -> + Pa=filename:dirname(code:which(?MODULE)), + Dir=?config(priv_dir, Config), + ConfFile = " -config " ++ filename:join(Dir, "global_group_comp"), + test_server:start_node(Name, slave, [{args, "-pa " ++ Pa ++ ConfFile}]). + +node_names(Names, Config) -> + [node_name(Name, Config) || Name <- Names]. + +node_name(Name, Config) -> + U = "_", + Pid = os:getpid(), + {{Y,M,D}, {H,Min,S}} = calendar:now_to_local_time(now()), + Date = io_lib:format("~4w_~2..0w_~2..0w__~2..0w_~2..0w_~2..0w", + [Y,M,D, H,Min,S]), + L = lists:flatten(Date), + lists:concat([Name,U,?testcase,U,Pid,U,U,L]). + +stop_node(Node) -> + ?t:stop_node(Node). + + +wait_for_ready_net() -> + Nodes = lists:sort(?NODES), + ?UNTIL(begin + lists:all(fun(N) -> Nodes =:= get_known(N) end, Nodes) and + lists:all(fun(N) -> + LNs = rpc:call(N, erlang, nodes, []), + Nodes =:= lists:sort([N | LNs]) + end, Nodes) + end). + +get_known(Node) -> + Known = gen_server:call({global_name_server,Node}, get_known), + lists:sort([Node | Known]). + +config_hidden(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz, Ncpq) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s', " + " '~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, 1000}," + "{global_groups, [{nc1, hidden, ['~s@~s','~s@~s','~s@~s']}, " + "{nc2, hidden, ['~s@~s','~s@~s','~s@~s']}, " + "{nc3, normal, ['~s@~s']}]} ] }]. ~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + Ncpx, M, Ncpy, M, Ncpz, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncpx, M, Ncpy, M, Ncpz, M, + Ncpq, M]). + +config(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz, Ncpq) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s', " + " '~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, 1000}," + "{global_groups, [{nc1, ['~s@~s','~s@~s','~s@~s']}, " + " {nc2, ['~s@~s','~s@~s','~s@~s']}, " + "{nc3, ['~s@~s']}]} ] }]. ~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + Ncpx, M, Ncpy, M, Ncpz, M, + Ncp1, M, Ncp2, M, Ncp3, M, + Ncpx, M, Ncpy, M, Ncpz, M, + Ncpq, M]). + +config_no(Fd) -> + io:format(Fd, "[{kernel, [{global_groups, []}]}]. ~n",[]). + +config_sync(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s', " + " '~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, 1000}," + "{global_groups, []} ] }] .~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + Ncpx, M, Ncpy, M, Ncpz, M]). + + +config_comp(Fd, Ncp1, Ncp2, Ncp3, Ncpx, Ncpy, Ncpz) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, ['~s@~s','~s@~s','~s@~s', " + " '~s@~s','~s@~s','~s@~s']}," + "{sync_nodes_timeout, 1000} ] }] .~n", + [Ncp1, M, Ncp2, M, Ncp3, M, + Ncpx, M, Ncpy, M, Ncpz, M]). + +node_at(N) -> + NN = node_name(atom_to_list(node())), + list_to_atom(lists:concat([N, "@", NN])). + +node_name(L) -> + from($@, L). + +from(H, [H | T]) -> T; +from(H, [_ | T]) -> from(H, T); +from(_, []) -> []. + + +start_proc(Name) -> + Pid = spawn(?MODULE, init, [self(), Name]), + receive + {Pid, Res} -> {Pid, Res} + end. + +start_proc_rereg(Name) -> + Pid = spawn(?MODULE, init2, [self(), Name]), + receive + Pid -> Pid + end. + + + + + + + +init(Parent) -> + Parent ! self(), + loop(). + +init(Parent, Name) -> + X = global:register_name(Name, self()), + Parent ! {self(),X}, + loop(). + +init2(Parent, Name) -> + global:re_register_name(Name, self()), + Parent ! self(), + loop(). + +loop() -> + receive + monitor -> + global_group:monitor_nodes(true), + loop(); + stop_monitor -> + global_group:monitor_nodes(false), + loop(); + {wait_nodeup, Node} -> + loop_nodeup(Node); + {wait_nodedown, Node} -> + loop_nodedown(Node); + {io, _Msg} -> + loop(); + {ping, From} -> + From ! {pong, node()}, + loop(); + {del_lock, Id} -> + global:del_lock({Id, self()}), + loop(); + {del_lock, Id, Nodes} -> + global:del_lock({Id, self()}, Nodes), + loop(); + {set_lock, Id, From} -> + Res = global:set_lock({Id, self()}, ?NODES, 1), + From ! Res, + loop(); + {set_lock, Id, From, Nodes} -> + Res = global:set_lock({Id, self()}, Nodes, 1), + From ! Res, + loop(); + {set_lock_loop, Id, From} -> + global:set_lock({Id, self()}, ?NODES), + From ! {got_lock, self()}, + loop(); + {{got_notify, From}, Ref} -> + receive + X when element(1, X) == global_name_conflict -> + From ! {Ref, yes} + after + 0 -> From ! {Ref, no} + end, + loop(); + {which_loop, From} -> + From ! loop, + loop(); + die -> + exit(normal) + end. + + +loop_nodeup(Node) -> + receive + {nodeup, Node} -> + loop(); + to_loop -> + loop(); + {which_loop, From} -> + From ! loop_nodeup, + loop_nodeup(Node); + die -> + exit(normal) + end. + + +loop_nodedown(Node) -> + receive + {nodedown, Node} -> + loop(); + to_loop -> + loop(); + {which_loop, From} -> + From ! loop_nodedown, + loop_nodedown(Node); + die -> + exit(normal) + end. + +assert_loop(Cp, CpName, Name, NamePid, Loop) -> + M = {which_loop, self()}, + NamePid = rpc:call(Cp, global_group, send, [{node, CpName}, Name, M]), + receive + Loop -> + ok; + Other1 -> + test_server:fail(Other1) + after 5000 -> + test_server:fail(timeout) + end. + +loop_until_true(Fun) -> + case Fun() of + true -> + ok; + _ -> + loop_until_true(Fun) + end. + diff --git a/lib/kernel/test/global_group_SUITE_data/.gitignore b/lib/kernel/test/global_group_SUITE_data/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/kernel/test/global_group_SUITE_data/.gitignore diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl new file mode 100644 index 0000000000..b06244db3c --- /dev/null +++ b/lib/kernel/test/heart_SUITE.erl @@ -0,0 +1,460 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. 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(heart_SUITE). + +-include("test_server.hrl"). + +-export([all/1, ostype/1, start/1, restart/1, reboot/1, set_cmd/1, clear_cmd/1, + dont_drop/1, kill_pid/1, fini/1]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +-export([start_heart_stress/1, mangle/1, suicide_by_heart/0]). + +-define(DEFAULT_TIMEOUT_SECS, 120). + +init_per_testcase(_Func, Config) -> + Dog=test_server:timetrap(test_server:seconds(?DEFAULT_TIMEOUT_SECS)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Nodes = nodes(), + lists:foreach(fun(X) -> + NNam = list_to_atom(hd(string:tokens(atom_to_list(X),"@"))), + case NNam of + heart_test -> + ?t:format(1, "WARNING: Killed ~p~n", [X]), + rpc:cast(X, erlang, halt, []); + _ -> + ok + end + end, Nodes), + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog). + +%%----------------------------------------------------------------- +%% Test suite for heart. +%% Should be started in a CC view with: +%% erl -sname master -rsh ctrsh +%%----------------------------------------------------------------- +all(suite) -> + [{conf, ostype, [start, restart, reboot, + set_cmd, clear_cmd, kill_pid], fini}]. + +ostype(Config) when is_list(Config) -> + case os:type() of + {win32, windows} -> + {skipped, "No use to run on Windows 95/98"}; + _ -> + Config + end. +fini(Config) when is_list(Config) -> + Config. + +start_check(Type, Name) -> + Args = case ?t:os_type() of + {win32,_} -> "-heart -env HEART_COMMAND no_reboot"; + _ -> "-heart" + end, + {ok, Node} = case Type of + loose -> + loose_node:start(Name, Args, ?DEFAULT_TIMEOUT_SECS); + _ -> + ?t:start_node(Name, Type, [{args, Args}]) + end, + erlang:monitor_node(Node, true), + case rpc:call(Node, erlang, whereis, [heart]) of + Pid when pid(Pid) -> + ok; + _ -> + test_server:fail(heart_not_started) + end, + {ok, Node}. + +start(doc) -> []; +start(suite) -> {req, [{time, 10}]}; +start(Config) when is_list(Config) -> + ?line {ok, Node} = start_check(slave, heart_test), + ?line rpc:call(Node, init, reboot, []), + receive + {nodedown, Node} -> + ok + after 2000 -> + test_server:fail(node_not_closed) + end, + test_server:sleep(5000), + ?line case net_adm:ping(Node) of + pang -> + ok; + _ -> + test_server:fail(node_rebooted) + end, + test_server:stop_node(Node). + +%% Also test fixed bug in R1B (it was not possible to +%% do init:stop/0 on a restarted system before) +%% Slave executes erlang:halt() on master nodedown. +%% Therefore the slave process has to be killed +%% before restart. +restart(doc) -> []; +restart(suite) -> + case ?t:os_type() of + {Fam, _} when Fam == unix; Fam == win32 -> + {req, [{time,10}]}; + _ -> + {skip, "Only run on unix and win32"} + end; +restart(Config) when is_list(Config) -> + ?line {ok, Node} = start_check(loose, heart_test), + ?line rpc:call(Node, init, restart, []), + receive + {nodedown, Node} -> + ok + after 2000 -> + test_server:fail(node_not_closed) + end, + test_server:sleep(5000), + + ?line case net_adm:ping(Node) of + pong -> + erlang:monitor_node(Node, true), + ?line rpc:call(Node, init, stop, []), + receive + {nodedown, Node} -> + ok + after 2000 -> + test_server:fail(node_not_closed2) + end, + ok; + _ -> + test_server:fail(node_not_restarted) + end, + loose_node:stop(Node). + +reboot(doc) -> []; +reboot(suite) -> {req, [{time, 10}]}; +reboot(Config) when is_list(Config) -> + {ok, Node} = start_check(slave, heart_test), + + ?line ok = rpc:call(Node, heart, set_cmd, + [atom_to_list(lib:progname()) ++ + " -noshell -heart " ++ name(Node) ++ "&"]), + ?line rpc:call(Node, init, reboot, []), + receive + {nodedown, Node} -> + ok + after 2000 -> + test_server:fail(node_not_closed) + end, + test_server:sleep(5000), + ?line case net_adm:ping(Node) of + pong -> + erlang:monitor_node(Node, true), + ?line rpc:call(Node, init, reboot, []), + receive + {nodedown, Node} -> + ok + after 2000 -> + test_server:fail(node_not_closed2) + end, + ok; + _ -> + test_server:fail(node_not_rebooted) + end, + ok. + +%% Only tests bad command, correct behaviour is tested in reboot/1. +set_cmd(suite) -> []; +set_cmd(Config) when is_list(Config) -> + ?line {ok, Node} = start_check(slave, heart_test), + Cmd = wrong_atom, + ?line {error, {bad_cmd, Cmd}} = rpc:call(Node, heart, set_cmd, [Cmd]), + Cmd1 = lists:duplicate(2047, $a), + ?line {error, {bad_cmd, Cmd1}} = rpc:call(Node, heart, set_cmd, [Cmd1]), + Cmd2 = lists:duplicate(28, $a), + ?line ok = rpc:call(Node, heart, set_cmd, [Cmd2]), + Cmd3 = lists:duplicate(2000, $a), + ?line ok = rpc:call(Node, heart, set_cmd, [Cmd3]), + stop_node(Node), + ok. + +clear_cmd(suite) -> {req,[{time,15}]}; +clear_cmd(Config) when is_list(Config) -> + ?line {ok, Node} = start_check(slave, heart_test), + ?line ok = rpc:call(Node, heart, set_cmd, + [atom_to_list(lib:progname()) ++ + " -noshell -heart " ++ name(Node) ++ "&"]), + ?line rpc:call(Node, init, reboot, []), + receive + {nodedown, Node} -> + ok + after 2000 -> + test_server:fail(node_not_closed) + end, + test_server:sleep(5000), + ?line case net_adm:ping(Node) of + pong -> + erlang:monitor_node(Node, true); + _ -> + test_server:fail(node_not_rebooted) + end, + ?line ok = rpc:call(Node, heart, set_cmd, + ["erl -noshell -heart " ++ name(Node) ++ "&"]), + ?line ok = rpc:call(Node, heart, clear_cmd, []), + ?line rpc:call(Node, init, reboot, []), + receive + {nodedown, Node} -> + ok + after 2000 -> + test_server:fail(node_not_closed) + end, + test_server:sleep(5000), + ?line case net_adm:ping(Node) of + pang -> + ok; + _ -> + test_server:fail(node_rebooted) + end, + ok. + +dont_drop(suite) -> +%%% Removed as it may crash epmd/distribution in colourful +%%% ways. While we ARE finding out WHY, it would +%%% be nice for others to be able to run the kernel test suite +%%% without "exploding machines", so thats why I removed it for now. + []; +dont_drop(doc) -> + ["Tests that the heart command does not get dropped when ", + "set just before halt on very high I/O load."]; +dont_drop(Config) when is_list(Config) -> + %%% Have to do it some times to make it happen... + case os:type() of + vxworks -> + {comment, "No use to run with slaves on other nodes..."}; + _ -> + [ok,ok,ok,ok,ok,ok,ok,ok,ok,ok] = do_dont_drop(Config,10), + ok + end. + +do_dont_drop(_,0) -> + []; +do_dont_drop(Config,N) -> + %% Name of first slave node + ?line NN1 = atom_to_list(?MODULE) ++ "slave_1", + %% Name of node started by heart on failure + ?line NN2 = atom_to_list(?MODULE) ++ "slave_2", + %% Name of node started by heart on success + ?line NN3 = atom_to_list(?MODULE) ++ "slave_3", + ?line Host = hd(tl(string:tokens(atom_to_list(node()),"@"))), + %% The initial heart command + ?line FirstCmd = erl() ++ name(NN2 ++ "@" ++ Host), + %% Separated the parameters to start_node_run for clarity... + ?line Name = list_to_atom(NN1), + ?line Env = [{"HEART_COMMAND", FirstCmd}], + ?line Func = "start_heart_stress", + ?line Arg = NN3 ++ "@" ++ Host ++ " " ++ + filename:join(?config(data_dir, Config), "simple_echo"), + ?line start_node_run(Name,Env,Func,Arg), + ?line case wait_for_any_of(list_to_atom(NN2 ++ "@" ++ Host), + list_to_atom(NN3 ++ "@" ++ Host)) of + 2 -> + ?line [ok | do_dont_drop(Config,N-1)]; + _ -> + ?line false + end. + +wait_for_any_of(N1,N2) -> + ?line wait_for_any_of(N1,N2,45). + +wait_for_any_of(_N1,_N2,0) -> + ?line false; + +wait_for_any_of(N1,N2,Times) -> + ?line receive + after 1000 -> + ?line ok + end, + ?line case net_adm:ping(N1) of + pang -> + ?line case net_adm:ping(N2) of + pang -> + ?line wait_for_any_of(N1,N2,Times - 1); + pong -> + ?line rpc:call(N2,init,stop,[]), + ?line 2 + end; + pong -> + ?line rpc:call(N1,init,stop,[]), + ?line 1 + end. + + +kill_pid(suite) -> + []; +kill_pid(doc) -> + ["Tests that heart kills the old erlang node before executing ", + "heart command."]; +kill_pid(Config) when is_list(Config) -> + %%% Have to do it some times to make it happen... + case os:type() of + vxworks -> + {comment, "No use to run with slaves on other nodes..."}; + _ -> + ok = do_kill_pid(Config) + end. + +do_kill_pid(_Config) -> + Name = heart_test, + Env = [{"HEART_COMMAND", "nickeNyfikenFarEttJobb"}], + {ok,Node} = start_node_run(Name,Env,suicide_by_heart,[]), + ok = wait_for_node(Node,15), + erlang:monitor_node(Node, true), + receive + {nodedown,Node} -> + ok + after 30000 -> + false + end. + +wait_for_node(_,0) -> + false; +wait_for_node(Node,N) -> + receive + after 1000 -> + ok + end, + case net_adm:ping(Node) of + pong -> + ok; + pang -> + wait_for_node(Node,N-1) + end. + +erl() -> + case os:type() of + {win32,_} -> + "werl "; + _ -> + "erl " + end. + +name(Node) when is_list(Node) -> name(Node,[]); +name(Node) when atom(Node) -> name(atom_to_list(Node),[]). + +name([$@|Node], Name) -> + case lists:member($., Node) of + true -> + "-name " ++ lists:reverse(Name); + _ -> + "-sname " ++ lists:reverse(Name) + end; +name([H|T], Name) -> + name(T, [H|Name]). + + +atom_conv(A) when atom(A) -> + atom_to_list(A); +atom_conv(A) when is_list(A) -> + A. + +env_conv([]) -> + []; +env_conv([{X,Y}|T]) -> + atom_conv(X) ++ " \"" ++ atom_conv(Y) ++ "\" " ++ env_conv(T). + +%%% +%%% Starts a node and runs a function in this +%%% module. +%%% Name is the node name as either atom or string, +%%% Env is a list of Tuples containing name-value pairs. +%%% Function is the function to run in this module +%%% Argument is the argument(s) to send through erl -s +%%% +start_node_run(Name, Env, Function, Argument) -> + ?line PA = filename:dirname(code:which(?MODULE)), + ?line Params = "-heart -env " ++ env_conv(Env) ++ " -pa " ++ PA ++ + " -s " ++ + atom_conv(?MODULE) ++ " " ++ atom_conv(Function) ++ " " ++ + atom_conv(Argument), + ?line start_node(Name, Params). + +start_node(Name, Param) -> + test_server:start_node(Name, slave, [{args, Param}]). + +stop_node(Node) -> + test_server:stop_node(Node). + + +%%% This code is run in a slave node to ensure that +%%% A heart command really gets set syncronously +%%% and cannot get "dropped". + +send_to(_,_,0) -> + ok; +send_to(Port,D,N) -> + Port ! {self(),{command,D}}, + send_to(Port,D,N-1). + +receive_from(_,_,0) -> + ok; + +receive_from(Port,D,N) -> + receive + {Port, {data,{eol,_Data}}} -> + receive_from(Port,D,N-1); + X -> + io:format("Got garbage ~p~n",[X]) + end. + +mangle(PP) when is_list(PP) -> + Port = open_port({spawn,PP},[{line,100}]), + mangle(Port); + +mangle(Port) -> + send_to(Port, "ABCDEFGHIJ" ++ io_lib:nl(),1), + receive_from(Port,"ABCDEFGHIJ",1), + mangle(Port). + + + +explode(0,_) -> + ok; +explode(N,PP) -> + spawn(?MODULE,mangle,[PP]), + explode(N-1,PP). + +start_heart_stress([NewName,PortProgram]) -> + explode(10,atom_to_list(PortProgram)), + NewCmd = erl() ++ name(NewName), + %%io:format("~p~n",[NewCmd]), + receive + after 10000 -> + heart:set_cmd(NewCmd), + halt() + end. + +suicide_by_heart() -> + %%io:format("Suicide starting...~n"), + open_port({spawn,"heart -ht 11 -pid "++os:getpid()},[{packet,2}]), + receive X -> X end, + %% Just hang and wait for heart to timeout + receive + {makaronipudding} -> + sallad + end. diff --git a/lib/kernel/test/heart_SUITE_data/Makefile.src b/lib/kernel/test/heart_SUITE_data/Makefile.src new file mode 100644 index 0000000000..f48506235f --- /dev/null +++ b/lib/kernel/test/heart_SUITE_data/Makefile.src @@ -0,0 +1,14 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROGS = simple_echo@exe@ + +all: $(PROGS) + +simple_echo@exe@: simple_echo@obj@ + $(LD) $(CROSSLDFLAGS) -o simple_echo simple_echo@obj@ @LIBS@ + +simple_echo@obj@: simple_echo.c + $(CC) -c -o simple_echo@obj@ $(CFLAGS) simple_echo.c diff --git a/lib/kernel/test/heart_SUITE_data/simple_echo.c b/lib/kernel/test/heart_SUITE_data/simple_echo.c new file mode 100644 index 0000000000..0093dbce9b --- /dev/null +++ b/lib/kernel/test/heart_SUITE_data/simple_echo.c @@ -0,0 +1,17 @@ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> + +#ifdef VXWORKS +int simple_echo(void){ +#else +int main(void){ +#endif + int x; + while((x = getchar()) != EOF){ + putchar(x); + fflush(stdout); + } + return 0; +} + diff --git a/lib/kernel/test/inet_SUITE.erl b/lib/kernel/test/inet_SUITE.erl new file mode 100644 index 0000000000..cf33e8b27f --- /dev/null +++ b/lib/kernel/test/inet_SUITE.erl @@ -0,0 +1,735 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. 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(inet_SUITE). + +-include("test_server.hrl"). +-include_lib("kernel/include/inet.hrl"). +-include_lib("kernel/src/inet_dns.hrl"). + +-export([all/1, t_gethostbyaddr/1, t_getaddr/1, t_gethostbyname/1, + t_gethostbyaddr_v6/1, t_getaddr_v6/1, t_gethostbyname_v6/1, + ipv4_to_ipv6/1, host_and_addr/1, parse/1, t_gethostnative/1, + gethostnative_parallell/1, cname_loop/1, + gethostnative_soft_restart/1,gethostnative_debug_level/1,getif/1]). + +-export([get_hosts/1, get_ipv6_hosts/1, parse_hosts/1, + kill_gethost/0, parallell_gethost/0]). +-export([init_per_testcase/2, end_per_testcase/2]). + + +all(suite) -> + [t_gethostbyaddr, t_gethostbyname, t_getaddr, + t_gethostbyaddr_v6, t_gethostbyname_v6, t_getaddr_v6, + ipv4_to_ipv6, host_and_addr, parse,t_gethostnative, + gethostnative_parallell, cname_loop, + gethostnative_debug_level,gethostnative_soft_restart, + getif]. + +init_per_testcase(_Func, Config) -> + Dog = test_server:timetrap(test_server:seconds(60)), + [{watchdog,Dog}|Config]. + +end_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog). + + +t_gethostbyaddr(doc) -> "Test the inet:gethostbyaddr/1 function."; +t_gethostbyaddr(Config) when is_list(Config) -> + ?line {Name,FullName,IPStr,IP,Aliases,_,_} = ?config(test_host_ipv4_only, Config), + ?line {ok,HEnt} = inet:gethostbyaddr(IPStr), + ?line {ok,HEnt} = inet:gethostbyaddr(IP), + ?line {error,Error} = inet:gethostbyaddr(Name), + ?line ok = io:format("Failure reason: ~p: ~s", + [error,inet:format_error(Error)]), + ?line HEnt_ = HEnt#hostent{h_addrtype = inet, + h_length = 4, + h_addr_list = [IP]}, + ?line HEnt_ = HEnt, + case {os:type(),os:version()} of + {{unix,freebsd},{5,0,0}} -> + %% The alias list seems to be buggy in FreeBSD 5.0.0. + ?line check_elems([{HEnt#hostent.h_name,[Name,FullName]}]), + io:format("Buggy alias list: ~p", [HEnt#hostent.h_aliases]), + ok; + _ -> + ?line check_elems([{HEnt#hostent.h_name,[Name,FullName]}, + {HEnt#hostent.h_aliases,[[],Aliases]}]) + end, + + ?line {_DName, _DFullName, DIPStr, DIP, _, _, _} = + ?config(test_dummy_host, Config), + ?line {error,nxdomain} = inet:gethostbyaddr(DIPStr), + ?line {error,nxdomain} = inet:gethostbyaddr(DIP), + ok. + +t_gethostbyaddr_v6(doc) -> "Test the inet:gethostbyaddr/1 inet6 function."; +t_gethostbyaddr_v6(Config) when is_list(Config) -> + ?line {Name6, FullName6, IPStr6, IP6, Aliases6} = + ?config(test_host_ipv6_only, Config), + + ?line case inet:gethostbyaddr(IPStr6) of + %% Even if IPv6 is not supported, the native resolver may succeed + %% looking up the host. DNS lookup will probably fail. + {error,nxdomain} -> + {skip, "IPv6 test fails! IPv6 not supported on this host!?"}; + {ok,HEnt6} -> + ?line {ok,HEnt6} = inet:gethostbyaddr(IP6), + ?line {error,Error6} = inet:gethostbyaddr(Name6), + ?line ok = io:format("Failure reason: ~p: ~s", + [Error6, inet:format_error(Error6)]), + ?line HEnt6_ = HEnt6#hostent{h_addrtype = inet6, + h_length = 16, + h_addr_list = [IP6]}, + ?line HEnt6_ = HEnt6, + ?line check_elems([{HEnt6#hostent.h_name,[Name6,FullName6]}, + {HEnt6#hostent.h_aliases,[[],Aliases6]}]), + + ?line {_DName6, _DFullName6, DIPStr6, DIP6, _} = + ?config(test_dummy_ipv6_host, Config), + ?line {error,nxdomain} = inet:gethostbyaddr(DIPStr6), + ?line {error,nxdomain} = inet:gethostbyaddr(DIP6), + ok + end. + +t_gethostbyname(doc) -> "Test the inet:gethostbyname/1 function."; +t_gethostbyname(suite) -> []; +t_gethostbyname(Config) when is_list(Config) -> + ?line {Name,FullName,IPStr,IP,Aliases,IP_46_Str,_} = + ?config(test_host_ipv4_only, Config), + ?line {ok,_} = inet:gethostbyname(IPStr), + ?line {ok,HEnt} = inet:gethostbyname(Name), + ?line {ok,HEnt} = inet:gethostbyname(list_to_atom(Name)), + ?line HEnt_ = HEnt#hostent{h_addrtype = inet, + h_length = 4, + h_addr_list = [IP]}, + ?line HEnt_ = HEnt, + ?line check_elems([{HEnt#hostent.h_name,[Name,FullName]}, + {HEnt#hostent.h_aliases,[[],Aliases]}]), + + ?line {ok,HEntF} = inet:gethostbyname(FullName), + ?line HEntF_ = HEntF#hostent{h_name = FullName, + h_addrtype = inet, + h_length = 4, + h_addr_list = [IP]}, + ?line HEntF_ = HEntF, + ?line check_elems([{HEnt#hostent.h_aliases,[[],Aliases]}]), + + ?line {DName, _DFullName, _DIPStr, _DIP, _, _, _} = + ?config(test_dummy_host, Config), + ?line {error,nxdomain} = inet:gethostbyname(DName), + ?line {error,nxdomain} = inet:gethostbyname(IP_46_Str). + +t_gethostbyname_v6(doc) -> "Test the inet:gethostbyname/1 inet6 function."; +t_gethostbyname_v6(suite) -> []; +t_gethostbyname_v6(Config) when is_list(Config) -> + ?line {Name, _, _, _,Aliases,IP_46_Str,IP_46} = + ?config(test_host_ipv4_only, Config), + + case {inet:gethostbyname(IP_46_Str, inet6), + inet:gethostbyname(Name, inet6)} of + {{ok,HEnt46},{ok,_}} -> + ?line HEnt46_ = HEnt46#hostent{h_name = IP_46_Str, + h_addrtype = inet6, + h_length = 16, + h_addr_list = [IP_46]}, + ?line HEnt46_ = HEnt46, + ?line check_elems([{HEnt46#hostent.h_aliases,[[],Aliases]}]), + + ?line {Name6, FullName6, IPStr6, IP6, Aliases6} = + ?config(test_host_ipv6_only, Config), + ?line {ok,_} = inet:gethostbyname(IPStr6, inet6), + ?line {ok,HEnt6} = inet:gethostbyname(Name6, inet6), + ?line {ok,HEnt6} = inet:gethostbyname(list_to_atom(Name6), inet6), + ?line case HEnt6#hostent.h_addr_list of + [IP6] -> % ipv6 ok + ?line HEnt6_ = HEnt6#hostent{h_addrtype = inet6, + h_length = 16, + h_addr_list = [IP6]}, + ?line HEnt6_ = HEnt6, + ?line check_elems([{HEnt6#hostent.h_name,[Name6,FullName6]}, + {HEnt6#hostent.h_aliases,[[],Aliases6]}]); + _ -> % ipv4 compatible addr + ?line {ok,HEnt4} = inet:gethostbyname(Name6, inet), + ?line [IP4] = HEnt4#hostent.h_addr_list, + ?line {ok,IP46_2} = + inet_parse:ipv6_address("::ffff:"++inet_parse:ntoa(IP4)), + ?line HEnt6_ = HEnt6#hostent{h_addrtype = inet6, + h_length = 16, + h_addr_list = [IP46_2]}, + ?line HEnt6_ = HEnt6, + ?line check_elems([{HEnt6#hostent.h_name,[Name6,FullName6]}]) + end, + + ?line {ok,HEntF6} = inet:gethostbyname(FullName6, inet6), + ?line case HEntF6#hostent.h_addr_list of + [IP6] -> % ipv6 ok + ?line HEntF6_ = HEntF6#hostent{h_name = FullName6, + h_addrtype = inet6, + h_length = 16, + h_addr_list = [IP6]}, + ?line HEntF6_ = HEntF6, + ?line check_elems([{HEntF6#hostent.h_aliases,[[],Aliases6]}]); + _ -> % ipv4 compatible addr + ?line {ok,HEntF4} = inet:gethostbyname(FullName6, inet), + ?line [IPF4] = HEntF4#hostent.h_addr_list, + ?line {ok,IPF46_2} = + inet_parse:ipv6_address("::ffff:"++inet_parse:ntoa(IPF4)), + ?line HEntF6_ = HEntF6#hostent{h_addrtype = inet6, + h_length = 16, + h_addr_list = [IPF46_2]}, + ?line HEntF6_ = HEntF6, + ?line check_elems([{HEntF6#hostent.h_name,[Name6,FullName6]}]) + end, + + ?line {DName6, _DFullName6, _DIPStr6, _DIP6, _} = + ?config(test_dummy_ipv6_host, Config), + ?line {error,nxdomain} = inet:gethostbyname(DName6, inet6), + ok; + {_,_} -> + {skip, "IPv6 is not supported on this host"} + end. + +check_elems([{Val,Tests} | Elems]) -> + check_elem(Val, Tests, Tests), + check_elems(Elems); +check_elems([]) -> ok. + +check_elem(Val, [Val|_], _) -> ok; +check_elem(Val, [_|Tests], Tests0) -> + check_elem(Val, Tests, Tests0); +check_elem(Val, [], Tests0) -> + ?t:fail({no_match,Val,Tests0}). + + +t_getaddr(doc) -> "Test the inet:getaddr/2 function."; +t_getaddr(suite) -> []; +t_getaddr(Config) when is_list(Config) -> + ?line {Name,FullName,IPStr,IP,_,IP_46_Str,IP46} = + ?config(test_host_ipv4_only, Config), + ?line {ok,IP} = inet:getaddr(list_to_atom(Name), inet), + ?line {ok,IP} = inet:getaddr(Name, inet), + ?line {ok,IP} = inet:getaddr(FullName, inet), + ?line {ok,IP} = inet:getaddr(IP, inet), + ?line {ok,IP} = inet:getaddr(IPStr, inet), + ?line {error,nxdomain} = inet:getaddr(IP_46_Str, inet), + ?line {error,eafnosupport} = inet:getaddr(IP46, inet), + + ?line {DName, DFullName, DIPStr, DIP, _, _, _} = ?config(test_dummy_host, Config), + ?line {error,nxdomain} = inet:getaddr(DName, inet), + ?line {error,nxdomain} = inet:getaddr(DFullName, inet), + ?line {ok,DIP} = inet:getaddr(DIPStr, inet), + ?line {ok,DIP} = inet:getaddr(DIP, inet). + +t_getaddr_v6(doc) -> "Test the inet:getaddr/2 function."; +t_getaddr_v6(suite) -> []; +t_getaddr_v6(Config) when is_list(Config) -> + ?line {Name,FullName,IPStr,_IP,_,IP_46_Str,IP46} = + ?config(test_host_ipv4_only, Config), + case {inet:getaddr(IP_46_Str, inet6),inet:getaddr(Name, inet6)} of + {{ok,IP46},{ok,_}} -> + %% Since we suceeded in parsing an IPv6 address string and + %% look up the name, this computer fully supports IPv6. + ?line {ok,IP46} = inet:getaddr(IP46, inet6), + ?line {ok,IP46} = inet:getaddr(Name, inet6), + ?line {ok,IP46} = inet:getaddr(FullName, inet6), + ?line IP4toIP6 = inet:getaddr(IPStr, inet6), + ?line case IP4toIP6 of + {ok,IP46} -> % only native can do this + ?line true = lists:member(native, + inet_db:res_option(lookup)); + {error,nxdomain} -> + ok + end, + ?line {Name6, FullName6, IPStr6, IP6, _} = + ?config(test_host_ipv6_only, Config), + ?line {ok,_} = inet:getaddr(list_to_atom(Name6), inet6), + ?line {ok,_} = inet:getaddr(Name6, inet6), + ?line {ok,_} = inet:getaddr(FullName6, inet6), + ?line {ok,IP6} = inet:getaddr(IP6, inet6), + ?line {ok,IP6} = inet:getaddr(IPStr6, inet6), + + ?line {DName6, DFullName6, DIPStr6, DIP6, _} = + ?config(test_dummy_ipv6_host, Config), + ?line {error,nxdomain} = inet:getaddr(DName6, inet6), + ?line {error,nxdomain} = inet:getaddr(DFullName6, inet6), + ?line {ok,DIP6} = inet:getaddr(DIPStr6, inet6), + ?line {ok,DIP6} = inet:getaddr(DIP6, inet6), + ok; + {_,_} -> + {skip, "IPv6 is not supported on this host"} + end. + +ipv4_to_ipv6(doc) -> "Test if IPv4 address is converted to IPv6 address."; +ipv4_to_ipv6(suite) -> []; +ipv4_to_ipv6(Config) when is_list(Config) -> + %% Test what happens if an IPv4 address is looked up in an IPv6 context. + %% If the native resolver succeeds to look it up, an IPv4 compatible + %% address should be returned. If no IPv6 support on this host, an + %% error should beturned. + ?line {_Name,_FullName,IPStr,_IP,Aliases,IP_46_Str,IP_46} = + ?config(test_host_ipv4_only, Config), + ?line IP4to6Res = + case inet:getaddr(IPStr, inet6) of + {ok,IP_46} -> + io:format("IPv4->IPv6: success~n"), + true; + E = {error,nxdomain} -> + io:format("IPv4->IPv6: nxdomain~n"), + E; + E = {error,eafnosupport} -> + io:format("IPv6->IPv4: eafnosupport~n"), + E; + Other -> + ?line ?t:fail({ipv4_to_ipv6_lookup_failed,Other}) + end, + ?line case {IP4to6Res,inet:gethostbyname(IPStr, inet6)} of + {true,{ok,HEnt}} -> + ?line true = lists:member(native, inet_db:res_option(lookup)), + ?line HEnt_ = HEnt#hostent{h_addrtype = inet6, + h_length = 16, + h_addr_list = [IP_46]}, + ?line HEnt_ = HEnt, + ?line check_elems([{HEnt#hostent.h_name,[IP_46_Str,IPStr]}, + {HEnt#hostent.h_aliases,[[],Aliases]}]); + {_,IP4to6Res} -> ok + end, + ok. + +host_and_addr(doc) -> ["Test looking up hosts and addresses. Use 'ypcat hosts' ", + "or the local eqivalent to find all hosts."]; +host_and_addr(suite) -> []; +host_and_addr(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:minutes(5)), + + ?line lists:foreach(fun try_host/1, get_hosts(Config)), + ?line test_server:timetrap_cancel(Dog), + ok. + +try_host({Ip0, Host}) -> + ?line {ok,Ip} = inet:getaddr(Ip0, inet), + ?line {ok,{hostent, _, _, inet, _, Ips1}} = inet:gethostbyaddr(Ip), + ?line {ok,{hostent, _, _, inet, _, _Ips2}} = inet:gethostbyname(Host), + ?line true = lists:member(Ip, Ips1), + ok. + +%% Get all hosts from the system using 'ypcat hosts' or the local +%% equvivalent. + +get_hosts(Config) -> + case os:type() of + {unix, _} -> + List = lists:map(fun(X) -> + atom_to_list(X)++" " + end, ?config(test_hosts, Config)), + Cmd = "ypmatch "++List++" hosts.byname", + HostFile = os:cmd(Cmd), + get_hosts(HostFile, [], [], []); + _ -> + ?config(hardcoded_hosts, Config) + end. + +get_ipv6_hosts(Config) -> + case os:type() of + {unix, _} -> + List = lists:map(fun(X) -> + atom_to_list(X)++" " + end, ?config(test_hosts, Config)), + Cmd = "ypmatch "++List++" ipnodes.byname", + HostFile = os:cmd(Cmd), + get_hosts(HostFile, [], [], []); + _ -> + ?config(hardcoded_ipv6_hosts, Config) + end. + +get_hosts([$\t|Rest], Cur, Ip, Result) when Ip /= [] -> + get_hosts(Rest, Cur, Ip, Result); +get_hosts([$\t|Rest], Cur, _Ip, Result) -> + get_hosts(Rest, [], lists:reverse(Cur), Result); +get_hosts([$\r|Rest], Cur, Ip, Result) -> + get_hosts(Rest, Cur, Ip, Result); +get_hosts([$\n|Rest], Cur, Ip, Result) -> + [First|_] = string:tokens(lists:reverse(Cur), " "), + Ips = string:tokens(Ip, ","), + Hosts = [{I, First} || I <- Ips], + get_hosts(Rest, [], [], Hosts++Result); +get_hosts([C|Rest], Cur, Ip, Result) -> + get_hosts(Rest, [C|Cur], Ip, Result); +get_hosts([], _, _, Result) -> + Result. + +parse(suite) -> [parse_hosts]; +parse(doc) -> ["Test that parsing of the hosts file or equivalent works,", + "and that erroneous lines are skipped"]. +parse_hosts(Config) when is_list(Config) -> + ?line DataDir = ?config(data_dir,Config), + ?line HostFile = filename:join(DataDir, "hosts"), + ?line inet_parse:hosts(HostFile), + ?line HostFileErr1 = filename:join(DataDir, "hosts_err1"), + ?line inet_parse:hosts(HostFileErr1), + ?line Resolv = filename:join(DataDir,"resolv.conf"), + ?line inet_parse:resolv(Resolv), + ?line ResolvErr1 = filename:join(DataDir,"resolv.conf.err1"), + ?line inet_parse:resolv(ResolvErr1). + +t_gethostnative(suite) ->[]; +t_gethostnative(doc) ->[]; +t_gethostnative(Config) when is_list(Config) -> +%% this will result in 26 bytes sent which causes problem in Windows +%% if the port-program has not assured stdin to be read in BINARY mode +%% OTP-2555 + case os:type() of + vxworks -> + {skipped, "VxWorks has no native gethostbyname()"}; + _ -> + ?line case inet_gethost_native:gethostbyname( + "a23456789012345678901234") of + {error,notfound} -> + ?line ok; + {error,no_data} -> + ?line ok + end + end. + +gethostnative_parallell(suite) -> + []; +gethostnative_parallell(doc) -> + ["Check that the emulator survives crashes in gethost_native"]; +gethostnative_parallell(Config) when is_list(Config) -> + ?line {ok,Hostname} = inet:gethostname(), + ?line {ok,_} = inet:gethostbyname(Hostname), + case whereis(inet_gethost_native) of + Pid when is_pid(Pid) -> + ?line do_gethostnative_parallell(); + _ -> + ?line {skipped, "Not running native gethostbyname"} + end. + +do_gethostnative_parallell() -> + ?line PA = filename:dirname(code:which(?MODULE)), + ?line {ok,Node} = ?t:start_node(gethost_parallell, slave, + [{args, "-pa " ++ PA}]), + ?line ok = rpc:call(Node, ?MODULE, parallell_gethost, []), + ?line receive after 10000 -> ok end, + ?line pong = net_adm:ping(Node), + ?line ?t:stop_node(Node), + ok. + +parallell_gethost() -> + {ok,Hostname} = inet:gethostname(), + process_flag(trap_exit,true), + parallell_gethost_loop(10, Hostname). + +parallell_gethost_loop(0, _) -> ok; +parallell_gethost_loop(N, Hostname) -> + case whereis(inet_gethost_native) of + Pid when is_pid(Pid) -> + true = exit(Pid,kill); + _ -> + ok + end, + + L = spawn_gethosters(Hostname, 10), + release_gethosters(L), + collect_gethosters(10), + parallell_gethost_loop(N-1, Hostname). + +spawn_gethosters(_, 0) -> + []; +spawn_gethosters(Hostname, N) -> + Collector = self(), + [spawn(fun() -> + receive + go -> + case (catch inet:gethostbyname(Hostname)) of + {ok,_} -> + Collector ! ok; + Else -> + Collector ! {error,Else} + end + end + end) | + spawn_gethosters(Hostname, N-1)]. + +release_gethosters([]) -> + ok; +release_gethosters([H|T]) -> + H ! go, + release_gethosters(T). + +collect_gethosters(0) -> + ok; +collect_gethosters(N) -> + receive + ok -> + collect_gethosters(N-1); + Else -> + {failed, {unexpected, Else}} + after 2000 -> + {failed, {missing, N}} + end. + +kill_gethost() -> + kill_gethost(20). + +kill_gethost(0) -> + ok; +kill_gethost(N) -> + put(kill_gethost_n,N), + Pid = wait_for_gethost(10), + true = exit(Pid,kill), + wait_for_dead_gethost(10), + kill_gethost(N-1). + +wait_for_dead_gethost(0) -> + exit({not_dead,inet_gethost_native}); +wait_for_dead_gethost(N) -> + case whereis(inet_gethost_native) of + Pid when is_pid(Pid) -> + receive after 1000 -> + ok + end, + wait_for_dead_gethost(N-1); + undefined -> + ok + end. + +wait_for_gethost(0) -> + exit(gethost_not_found); +wait_for_gethost(N) -> + {ok,Hostname} = inet:gethostname(), + case (catch inet:gethostbyname(Hostname)) of + {ok,_} -> + ok; + Otherwise -> + %% This is what I call an exit tuple :) + exit({inet,gethostbyname, returned, Otherwise, 'when', + 'N','=',N,'and','hostname','=',Hostname,'and', + kill_gethost_n,'=',get(kill_gethost_n)}) + end, + case whereis(inet_gethost_native) of + Pid when is_pid(Pid) -> + Pid; + _ -> + receive + after 1000 -> + ok + end, + wait_for_gethost(N-1) + end. + +cname_loop(suite) -> + []; +cname_loop(doc) -> + ["Check that the resolver handles a CNAME loop"]; +cname_loop(Config) when is_list(Config) -> + %% getbyname (hostent_by_domain) + ?line ok = inet_db:add_rr("mydomain.com", in, ?S_CNAME, ttl, "mydomain.com"), + ?line {error,nxdomain} = inet_db:getbyname("mydomain.com", ?S_A), + ?line ok = inet_db:del_rr("mydomain.com", in, ?S_CNAME, "mydomain.com"), + %% res_hostent_by_domain + RR = #dns_rr{domain = "mydomain.com", + class = in, + type = ?S_CNAME, + data = "mydomain.com"}, + Rec = #dns_rec{anlist = [RR]}, + ?line {error,nxdomain} = inet_db:res_hostent_by_domain("mydomain.com", ?S_A, Rec), + ok. + + + +%% These must be run in the whole suite since they need +%% the host list and require inet_gethost_native to be started. +%% +-record(gethostnative_control, {control_seq, + control_interval=100, + lookup_delay=10, + lookup_count=300, + lookup_processes=20}). + +gethostnative_soft_restart(suite) -> + []; +gethostnative_soft_restart(doc) -> + ["Check that no name lookups fails during soft restart " + "of inet_gethost_native"]; +gethostnative_soft_restart(Config) when is_list(Config) -> + ?line gethostnative_control(Config, + #gethostnative_control{ + control_seq=[soft_restart]}). + +gethostnative_debug_level(suite) -> + []; +gethostnative_debug_level(doc) -> + ["Check that no name lookups fails during debug level change " + "of inet_gethost_native"]; +gethostnative_debug_level(Config) when is_list(Config) -> + ?line gethostnative_control(Config, + #gethostnative_control{ + control_seq=[{debug_level,1}, + {debug_level,0}]}). + +gethostnative_control(Config, Optrec) -> + ?line case inet_db:res_option(lookup) of + [native] -> + case whereis(inet_gethost_native) of + Pid when is_pid(Pid) -> + ?line gethostnative_control_1(Config, Optrec); + _ -> + ?line {skipped, "Not running native gethostbyname"} + end; + _ -> + ?line {skipped, "Native not only lookup metod"} + end. + +gethostnative_control_1(Config, + #gethostnative_control{ + control_seq=Seq, + control_interval=Interval, + lookup_delay=Delay, + lookup_count=Cnt, + lookup_processes=N}) -> + ?line {ok, Hostname} = inet:gethostname(), + ?line {ok, _} = inet:gethostbyname(Hostname), + ?line Hosts = + [Hostname|[H || {_,H} <- get_hosts(Config)] + ++[H++D || H <- ["www.","www1.","www2.",""], + D <- ["erlang.org","erlang.se"]] + ++[H++"cslab.ericsson.net" || H <- ["morgoth.","hades.","styx."]]], + %% Spawn some processes to do parallel lookups while + %% I repeatedly do inet_gethost_native:control/1. + ?line TrapExit = process_flag(trap_exit, true), + ?line gethostnative_control_2([undefined], Interval, Delay, Cnt, N, Hosts), + ?line test_server:format( + "First intermission: now starting control sequence ~w\n", + [Seq]), + ?line erlang:display(first_intermission), + ?line gethostnative_control_2(Seq, Interval, Delay, Cnt, N, Hosts), + ?line erlang:display(second_intermission), + ?line test_server:format( + "Second intermission: now stopping control sequence ~w\n", + [Seq]), + ?line gethostnative_control_2([undefined], Interval, Delay, Cnt, N, Hosts), + ?line true = process_flag(trap_exit, TrapExit), + ?line ok. + +gethostnative_control_2(Seq, Interval, Delay, Cnt, N, Hosts) -> + ?line Tag = make_ref(), + ?line Parent = self(), + ?line Lookupers = + [spawn_link( + fun () -> + random:seed(), + lookup_loop(Hosts, Delay, Tag, Parent, Cnt, Hosts) + end) + || _ <- lists:seq(1, N)], + control_loop(Seq, Interval, Tag, Lookupers, Seq), + gethostnative_control_3(Tag, ok). + +gethostnative_control_3(Tag, Reason) -> + receive + {Tag,Error} -> + ?line gethostnative_control_3(Tag, Error) + after 0 -> + Reason + end. + +control_loop([], _Interval, _Tag, [], _Seq) -> + ok; +control_loop([], Interval, Tag, Lookupers, Seq) -> + control_loop(Seq, Interval, Tag, Lookupers, Seq); +control_loop([Op|Ops], Interval, Tag, Lookupers, Seq) -> + control_loop(Ops, Interval, Tag, + control_loop_1(Op, Interval, Tag, Lookupers), + Seq). + +control_loop_1(Op, Interval, Tag, Lookupers) -> + ?line + receive + {'EXIT',Pid,Reason} -> + ?line case Reason of + Tag -> % Done + ?line control_loop_1 + (Op, Interval, Tag, + lists:delete(Pid, Lookupers)); + _ -> + ?line io:format("Lookuper ~p died: ~p", + [Pid,Reason]), + ?line test_server:fail("Lookuper died") + end + after Interval -> + ?line if Op =/= undefined -> + ?line ok = inet_gethost_native:control(Op); + true -> + ?line ok + end, + ?line Lookupers + end. + +lookup_loop(_, _Delay, Tag, _Parent, 0, _Hosts) -> + exit(Tag); +lookup_loop([], Delay, Tag, Parent, Cnt, Hosts) -> + lookup_loop(Hosts, Delay, Tag, Parent, Cnt, Hosts); +lookup_loop([H|Hs], Delay, Tag, Parent, Cnt, Hosts) -> + case inet:gethostbyname(H) of + {ok,_Hent} -> ok; + {error,nxdomain} -> ok; + Error -> + ?line io:format("Name lookup error for ~p for ~p: ~p", + [self(),H,Error]), + Parent ! {Tag,Error} + end, + receive + after random:uniform(Delay) -> + lookup_loop(Hs, Delay, Tag, Parent, Cnt-1, Hosts) + end. + + + +getif(suite) -> + []; +getif(doc) -> + ["Tests basic functionality of getiflist, getif, and ifget"]; +getif(Config) when is_list(Config) -> + ?line {ok,Hostname} = inet:gethostname(), + ?line {ok,Address} = inet:getaddr(Hostname, inet), + ?line {ok,Loopback} = inet:getaddr("localhost", inet), + ?line {ok,Interfaces} = inet:getiflist(), + ?line Addresses = + lists:sort( + lists:foldl( + fun (I, Acc) -> + case inet:ifget(I, [addr]) of + {ok,[{addr,A}]} -> [A|Acc]; + {ok,[]} -> Acc + end + end, [], Interfaces)), + ?line {ok,Getif} = inet:getif(), + ?line Addresses = lists:sort([A || {A,_,_} <- Getif]), + ?line true = ip_member(Address, Addresses), + ?line true = ip_member(Loopback, Addresses), + ?line ok. + +%% Works just like lists:member/2, except that any {127,_,_,_} tuple +%% matches any other {127,_,_,_}. We do this to handle Linux systems +%% that use (for instance) 127.0.1.1 as the IP address for the hostname. + +ip_member({127,_,_,_}, [{127,_,_,_}|_]) -> true; +ip_member(K, [K|_]) -> true; +ip_member(K, [_|T]) -> ip_member(K, T); +ip_member(_, []) -> false. diff --git a/lib/kernel/test/inet_SUITE_data/hosts b/lib/kernel/test/inet_SUITE_data/hosts new file mode 100644 index 0000000000..64d1d54f9b --- /dev/null +++ b/lib/kernel/test/inet_SUITE_data/hosts @@ -0,0 +1,22 @@ +150.236.20.66 fingolfin +150.236.20.65 bingo +150.236.20.32 lw5 lw5d +150.236.14.81 jarzebiak +150.236.14.71 grolsch +150.236.14.68 napoleon +127.0.0.1 localhost +150.236.20.74 strider +150.236.20.72 elrond +150.236.20.78 aule +150.236.14.36 lw4 lw4d +150.236.14.16 super super-14 www-cslab ftp-cslab mail smtp pop loghost +150.236.14.251 router-14 +150.236.20.67 sam +150.236.20.86 mallor +150.236.20.251 router-20 +150.236.20.192 merry +150.236.14.247 nenya +150.236.20.193 beamish +150.236.20.16 gandalf-20 +150.236.14.18 news nntp +150.236.14.77 gordons diff --git a/lib/kernel/test/inet_SUITE_data/hosts_err1 b/lib/kernel/test/inet_SUITE_data/hosts_err1 new file mode 100644 index 0000000000..201141d252 --- /dev/null +++ b/lib/kernel/test/inet_SUITE_data/hosts_err1 @@ -0,0 +1,170 @@ +150.236.14.243 msvw +150.236.14.224 peps +150.236.14.217 150.236.14.217 +150.236.14.213 euasb05 +150.236.14.206 nubbe +rappakalja +150.236.14.164 legolas2 +150.236.14.200 apx_ether146 +150.236.14.135 jb +150.236.14.131 ruddles +150.236.14.106 guinness +150.236.20.66 fingolfin +150.236.20.65 bingo +150.236.20.32 lw5 lw5d +150.236.14.90 ballantines +150.236.14.81 jarzebiak +150.236.14.80 calvados +150.236.14.72 explorer +150.236.14.71 grolsch +150.236.14.68 napoleon +127.0.0.1 localhost +150.236.14.211 cp2 +150.236.14.199 booze +150.236.14.198 macscot +150.236.14.165 vb +150.236.14.111 randy +150.236.14.94 bacardi +150.236.14.85 platins +150.236.14.76 scotch +150.236.14.69 martell +150.236.21.242 lme-pc12 +150.236.21.240 lme-pc10 +150.236.21.234 lme-pc04 +150.236.14.248 vilya +150.236.14.219 four-roses +150.236.14.218 wasted +150.236.14.196 mac1 su-mac +150.236.14.195 besk +150.236.14.163 tall +150.236.14.157 nijmegen +150.236.14.151 skalman +150.236.20.79 balin +150.236.20.75 bifur +150.236.20.74 strider +150.236.20.72 elrond +150.236.14.98 katt +150.236.14.89 fbsd-install +150.236.14.32 pm1 +150.236.14.19 styx +150.236.20.196 sauron +150.236.14.246 narya +150.236.14.245 mspc +150.236.14.216 ester-clop +150.236.14.212 dp1 +150.236.14.210 cp1 +150.236.14.169 natasja +150.236.14.168 helga +150.236.14.167 sjuan +150.236.14.138 rioja +150.236.14.137 pluto +150.236.20.78 aule +150.236.20.18 super-20 +150.236.14.64 renat +150.236.14.36 lw4 lw4d +150.236.14.35 lwt +150.236.14.33 lw lwd lp-seb +150.236.14.16 super super-14 www-cslab ftp-cslab mail smtp pop loghost +150.236.21.241 lme-pc11 +150.236.21.235 lme-pc05 +150.236.14.251 router-14 +150.236.14.244 mslab +150.236.14.240 msepu +150.236.14.223 kosken +150.236.14.197 mac2 su-mac2 +150.236.14.162 merkurius +150.236.14.152 luthagen +150.236.14.148 baidarka +150.236.14.142 kurt +150.236.14.136 russell +150.236.14.132 elbereth +150.236.14.130 plato +150.236.20.71 faenor +150.236.20.69 tom +150.236.14.93 turkey +150.236.14.84 absolut +150.236.14.75 chivas +150.236.14.21 proxy +150.236.21.239 lme-pc09 +150.236.21.238 lme-pc08 +150.236.15.251 router-15 +150.236.14.221 rent +150.236.14.215 ester-spwb +150.236.14.207 mackinlays +150.236.14.203 egri +150.236.14.201 tinto +150.236.14.200 raki +150.236.14.156 force +150.236.14.144 halvan +150.236.14.140 spex +150.236.14.109 anna +150.236.14.103 catrin +150.236.20.77 orome +150.236.20.67 sam +150.236.14.99 heering +150.236.14.91 bourbon +150.236.14.82 tequila +150.236.14.73 strega +150.236.14.67 aalborg +150.236.14.34 lwc +150.236.21.251 router-21 +150.236.21.237 lme-pc07 +150.236.21.233 lme-pc03 +150.236.21.231 lme-pc01 +150.236.20.251 router-20 +150.236.20.192 merry +150.236.14.247 nenya +150.236.14.241 ms40 +150.236.14.161 marisa +150.236.14.154 al +150.236.14.150 bill +150.236.14.149 sundsvall +150.236.14.139 dans +150.236.14.133 campari +150.236.20.76 gimli +150.236.20.70 bilbo +150.236.20.68 gwaihir +150.236.14.92 vodka +150.236.14.83 punsch # unused +150.236.14.74 pernod +150.236.14.22 gandalf gandalf-14 +150.236.14.20 www-sarc +150.236.20.193 beamish +150.236.14.209 seagram +150.236.14.166 hine +150.236.14.160 plutt +150.236.14.158 granbom +150.236.14.147 findus +150.236.14.146 ture +150.236.14.129 ariadne +150.236.14.128 op-andersson helan +150.236.14.104 steinlager +150.236.14.102 morgan +150.236.20.73 legolas +150.236.20.16 gandalf-20 +150.236.14.18 news nntp +150.236.14.17 otp +150.236.20.195 thorin +150.236.14.220 jackd +150.236.14.214 ester-asm +150.236.14.202 hutt +150.236.14.145 fedra +150.236.14.141 jura +150.236.20.64 falco +150.236.14.96 bushmill +150.236.14.87 loranga +150.236.14.78 cointreau +150.236.14.70 dickel +150.236.14.66 gin +150.236.21.236 lme-pc06 +150.236.21.232 lme-pc02 +150.236.20.194 frodo +150.236.14.242 mssol +150.236.14.153 bubak +150.236.14.134 wyborowa +150.236.14.97 finlandia +150.236.14.95 finkel +150.236.14.88 macallan +150.236.14.86 unicum +150.236.14.79 skeppet +150.236.14.77 gordons diff --git a/lib/kernel/test/inet_SUITE_data/resolv.conf b/lib/kernel/test/inet_SUITE_data/resolv.conf new file mode 100644 index 0000000000..c09d88fd92 --- /dev/null +++ b/lib/kernel/test/inet_SUITE_data/resolv.conf @@ -0,0 +1,7 @@ +domain du.etx.ericsson.se +nameserver 150.236.14.16 +garbage x +nameserver 150.236.16.2 +nameserver 130.100.128.25 +search du.etx.ericsson.se etx.ericsson.se ericsson.se +lookup yp bind file diff --git a/lib/kernel/test/inet_SUITE_data/resolv.conf.err1 b/lib/kernel/test/inet_SUITE_data/resolv.conf.err1 new file mode 100644 index 0000000000..c8f164be92 --- /dev/null +++ b/lib/kernel/test/inet_SUITE_data/resolv.conf.err1 @@ -0,0 +1,7 @@ +domain du.etx.ericsson.se +nameserver 150.236.14.16 +nameserver kalle +nameserver 150.236.16.2 +nameserver 130.100.128.25 +search du.etx.ericsson.se etx.ericsson.se ericsson.se +lookup yp bind file diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl new file mode 100644 index 0000000000..659cfc5988 --- /dev/null +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -0,0 +1,418 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2009. 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(inet_res_SUITE). + +-include("test_server.hrl"). +-include("test_server_line.hrl"). + +-include_lib("kernel/include/inet.hrl"). +-include_lib("kernel/src/inet_dns.hrl"). + +-export([all/1, init_per_testcase/2, end_per_testcase/2]). +-export([basic/1, resolve/1, edns0/1, txt_record/1, files_monitor/1]). +-export([gethostbyaddr/1, gethostbyaddr_v6/1, + gethostbyname/1, gethostbyname_v6/1, + getaddr/1, getaddr_v6/1, ipv4_to_ipv6/1, host_and_addr/1]). + +-define(RUN_NAMED, "run-named"). + +all(suite) -> + [basic, resolve, edns0, txt_record, files_monitor, + gethostbyaddr, gethostbyaddr_v6, gethostbyname, gethostbyname_v6, + getaddr, getaddr_v6, ipv4_to_ipv6, host_and_addr]. + +zone_dir(basic) -> + otptest; +zone_dir(resolve) -> + otptest; +zone_dir(edns0) -> + otptest; +zone_dir(files_monitor) -> + otptest; +zone_dir(_) -> + undefined. + +init_per_testcase(Func, Config) -> + PrivDir = ?config(priv_dir, Config), + DataDir = ?config(data_dir, Config), + try ns_init(zone_dir(Func), PrivDir, DataDir) of + NsSpec -> + Lookup = inet_db:res_option(lookup), + inet_db:set_lookup([file,dns]), + case NsSpec of + {_,{IP,Port},_} -> + inet_db:ins_alt_ns(IP, Port); + _ -> ok + end, + Dog = test_server:timetrap(test_server:seconds(10)), + [{nameserver,NsSpec},{res_lookup,Lookup},{watchdog,Dog}|Config] + catch + SkipReason -> + {skip,SkipReason} + end. + +end_per_testcase(_Func, Config) -> + test_server:timetrap_cancel(?config(watchdog, Config)), + inet_db:set_lookup(?config(res_lookup, Config)), + NsSpec = ?config(nameserver, Config), + case NsSpec of + {_,{IP,Port},_} -> + inet_db:del_alt_ns(IP, Port); + _ -> ok + end, + ns_end(NsSpec, ?config(priv_dir, Config)). + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Nameserver control + +ns(Config) -> + {_ZoneDir,NS,_P} = ?config(nameserver, Config), + NS. + +ns_init(ZoneDir, PrivDir, DataDir) -> + case os:type() of + {unix,_} when ZoneDir =:= undefined -> undefined; + {unix,_} -> + {ok,S} = gen_udp:open(0, [{reuseaddr,true}]), + {ok,PortNum} = inet:port(S), + gen_udp:close(S), + RunNamed = filename:join(DataDir, ?RUN_NAMED), + NS = {{127,0,0,1},PortNum}, + P = erlang:open_port({spawn_executable,RunNamed}, + [{cd,PrivDir}, + {line,80}, + {args,["127.0.0.1", + integer_to_list(PortNum), + atom_to_list(ZoneDir)]}, + stderr_to_stdout, + eof]), + ns_start(ZoneDir, NS, P); + _ -> + throw("Only run on Unix") + end. + +ns_start(ZoneDir, NS, P) -> + case ns_collect(P) of + eof -> + erlang:error(eof); + "Running: "++_ -> + {ZoneDir,NS,P}; + "Error: "++Error -> + throw(Error); + _ -> + ns_start(ZoneDir, NS, P) + end. + +ns_end(undefined, _PrivDir) -> undefined; +ns_end({ZoneDir,_NS,P}, PrivDir) -> + port_command(P, ["quit",io_lib:nl()]), + ns_stop(P), + ns_printlog(filename:join([PrivDir,ZoneDir,"named.log"])), + ok. + +ns_stop(P) -> + case ns_collect(P) of + eof -> + erlang:port_close(P); + _ -> + ns_stop(P) + end. + +ns_collect(P) -> + ns_collect(P, []). +ns_collect(P, Buf) -> + receive + {P,{data,{eol,L}}} -> + Line = lists:flatten(lists:reverse(Buf, [L])), + io:format("~s", [Line]), + Line; + {P,{data,{noeol,L}}} -> + ns_collect(P, [L|Buf]); + {P,eof} -> + eof + end. + +ns_printlog(Fname) -> + io:format("Name server log file contents:~n", []), + case file:read_file(Fname) of + {ok,Bin} -> + io:format("~s~n", [Bin]); + _ -> + ok + end. + +%% +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +basic(doc) -> + ["Lookup an A record with different API functions"]; +basic(Config) when is_list(Config) -> + NS = ns(Config), + Name = "ns.otptest", + IP = {127,0,0,254}, + %% + %% nslookup + {ok,Msg1} = inet_res:nslookup(Name, in, a, [NS]), + io:format("~p~n", [Msg1]), + [RR1] = inet_dns:msg(Msg1, anlist), + IP = inet_dns:rr(RR1, data), + Bin1 = inet_dns:encode(Msg1), + %%io:format("Bin1 = ~w~n", [Bin1]), + {ok,Msg1} = inet_dns:decode(Bin1), + %% + %% resolve + {ok,Msg2} = inet_res:resolve(Name, in, a, [{nameservers,[NS]}]), + io:format("~p~n", [Msg2]), + [RR2] = inet_dns:msg(Msg2, anlist), + IP = inet_dns:rr(RR2, data), + Bin2 = inet_dns:encode(Msg2), + %%io:format("Bin2 = ~w~n", [Bin2]), + {ok,Msg2} = inet_dns:decode(Bin2), + %% + %% lookup + [IP] = inet_res:lookup(Name, in, a, [{nameservers,[NS]}]), + %% + %% gethostbyname + {ok,#hostent{h_addr_list=[IP]}} = inet_res:gethostbyname(Name), + %% + %% getbyname + {ok,#hostent{h_addr_list=[IP]}} = inet_res:getbyname(Name, a), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +resolve(doc) -> + ["Lookup different records using resolve/2..4"]; +resolve(Config) when is_list(Config) -> + NS = ns(Config), + Domain = "otptest", + RDomain4 = "0.0.127.in-addr.arpa", + RDomain6 = "0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa", + Name = "resolve."++Domain, + L = [{in,a,Name,[{127,0,0,28}],undefined}, + {in,aaaa,Name,[{0,0,0,0,0,0,32512,28}],undefined}, + {in,cname,"cname."++Name,[Name],undefined}, + {in,a,"cname."++Name,[Name,{127,0,0,28}],undefined}, + {in,ns,"ns."++Name,[],[Name]}, + {in,soa,Domain,[],[{"ns.otptest","lsa.otptest",1,60,10,300,30}]}, + %% WKS: protocol TCP (6), services (bits) TELNET (23) and SMTP (25) + {in,wks,"wks."++Name,[{{127,0,0,28},6,<<0,0,1,64>>}],undefined}, + {in,ptr,"28."++RDomain4,[Name],undefined}, + {in,ptr,"c.1.0.0.0.0.f.7."++RDomain6,[Name],undefined}, + {in,hinfo,Name,[{"BEAM","Erlang/OTP"}],undefined}, + {in,mx,RDomain4,[{10,"mx."++Domain}],undefined}, + {in,srv,"_srv._tcp."++Name,[{10,3,4711,Name}],undefined}, + {in,naptr,"naptr."++Name, + [{10,5,"s","http","","_srv._tcp."++Name}],undefined}, + {in,txt,"txt."++Name, + [["Hej ","du ","glade "],["ta ","en ","spade!"]],undefined}, + {in,mb,"mb."++Name,["mx."++Name],undefined}, + {in,mg,"mg."++Name,["lsa."++Domain],undefined}, + {in,mr,"mr."++Name,["lsa."++Domain],undefined}, + {in,minfo,"minfo."++Name, + [{"minfo-owner."++Name,"minfo-bounce."++Name}],undefined}, + {in,any,"cname."++Name,[Name],undefined}, + {in,any,Name,[{127,0,0,28}, + {0,0,0,0,0,0,32512,28}, + {"BEAM","Erlang/OTP"}],undefined} + ], + resolve([{edns,false},{nameservers,[NS]}], L), + resolve([{edns,0},{nameservers,[NS]}], L). + +resolve(_Opts, []) -> ok; +resolve(Opts, [{Class,Type,Name,Answers,Authority}=Q|Qs]) -> + io:format("Query: ~p~nOptions: ~p~n", [Q,Opts]), + {ok,Msg} = inet_res:resolve(Name, Class, Type, Opts), + if Answers =/= undefined -> + AnList = lists:sort(Answers), + AnList = lists:sort([inet_dns:rr(RR, data) || + RR <- inet_dns:msg(Msg, anlist)]); + true -> ok end, + if Authority =/= undefined -> + NsList = lists:sort(Authority), + NsList = lists:sort([inet_dns:rr(RR, data) || + RR <- inet_dns:msg(Msg, nslist)]); + true -> ok end, + Buf = inet_dns:encode(Msg), + {ok,Msg} = inet_dns:decode(Buf), + resolve(Opts, Qs). + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +edns0(doc) -> + ["Test EDNS and truncation"]; +edns0(Config) when is_list(Config) -> + NS = ns(Config), + Domain = "otptest", + Filler = "-5678901234567890123456789012345678.", + MXs = lists:sort([{10,"mx."++Domain}, + {20,"mx1"++Filler++Domain}, + {20,"mx2"++Filler++Domain}, + {20,"mx3"++Filler++Domain}, + {20,"mx4"++Filler++Domain}, + {20,"mx5"++Filler++Domain}, + {20,"mx6"++Filler++Domain}, + {20,"mx7"++Filler++Domain}]), + false = inet_db:res_option(edns), % ASSERT + true = inet_db:res_option(udp_payload_size) >= 1280, % ASSERT + %% These will fall back to TCP + MXs = lists:sort(inet_res:lookup(Domain, in, mx, [{nameservers,[NS]}])), + %% + {ok,#hostent{h_addr_list=As}} = inet_res:getbyname(Domain++".", mx), + MXs = lists:sort(As), + %% + {ok,Msg1} = inet_res:resolve(Domain, in, mx), + MXs = lists:sort(inet_res_filter(inet_dns:msg(Msg1, anlist), in, mx)), + %% There should be no OPT record in the answer + [] = [RR || RR <- inet_dns:msg(Msg1, arlist), + inet_dns:rr(RR, type) =:= opt], + Buf1 = inet_dns:encode(Msg1), + {ok,Msg1} = inet_dns:decode(Buf1), + %% + %% Use EDNS - should not need to fall back to TCP + %% there is no way to tell from the outside. + %% + {ok,Msg2} = inet_res:resolve(Domain, in, mx, [{edns,0}]), + MXs = lists:sort(inet_res_filter(inet_dns:msg(Msg2, anlist), in, mx)), + Buf2 = inet_dns:encode(Msg2), + {ok,Msg2} = inet_dns:decode(Buf2), + [OptRR] = [RR || RR <- inet_dns:msg(Msg2, arlist), + inet_dns:rr(RR, type) =:= opt], + io:format("~p~n", [inet_dns:rr(OptRR)]), + ok. + +inet_res_filter(Anlist, Class, Type) -> + [inet_dns:rr(RR, data) || RR <- Anlist, + inet_dns:rr(RR, type) =:= Type, + inet_dns:rr(RR, class) =:= Class]. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +txt_record(suite) -> + []; +txt_record(doc) -> + ["Tests TXT records"]; +txt_record(Config) when is_list(Config) -> + D1 = "cslab.ericsson.net", + D2 = "mail1.cslab.ericsson.net", + {ok,#dns_rec{anlist=[RR1]}} = + inet_res:nslookup(D1, in, txt), + io:format("~p~n", [RR1]), + {ok,#dns_rec{anlist=[RR2]}} = + inet_res:nslookup(D2, in, txt), + io:format("~p~n", [RR2]), + #dns_rr{domain=D1, class=in, type=txt, data=A1} = RR1, + #dns_rr{domain=D2, class=in, type=txt, data=A2} = RR2, + case [lists:flatten(A2)] of + A1 = [[_|_]] -> ok + end, + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +files_monitor(suite) -> + []; +files_monitor(doc) -> + ["Tests monitoring of /etc/hosts and /etc/resolv.conf, but not them"]; +files_monitor(Config) when is_list(Config) -> + HostsFile = inet_db:res_option(hosts_file), + ResolvConf = inet_db:res_option(resolv_conf), + Inet6 = inet_db:res_option(inet6), + try do_files_monitor(Config) + after + inet_db:res_option(resolv_conf, ResolvConf), + inet_db:res_option(hosts_file, HostsFile), + inet_db:res_option(inet6, Inet6) + end. + +do_files_monitor(Config) -> + Dir = ?config(priv_dir, Config), + {ok,Hostname} = inet:gethostname(), + FQDN = Hostname++"."++inet_db:res_option(domain), + HostsFile = filename:join(Dir, "files_monitor_hosts"), + ResolvConf = filename:join(Dir, "files_monitor_resolv.conf"), + ok = inet_db:res_option(resolv_conf, ResolvConf), + ok = inet_db:res_option(hosts_file, HostsFile), + [] = inet_db:res_option(search), + {ok,#hostent{h_name = Hostname, + h_addrtype = inet, + h_length = 4, + h_addr_list = [{127,0,0,1}]}} = inet:gethostbyname(Hostname), + {ok,#hostent{h_name = FQDN, + h_addrtype = inet, + h_length = 4, + h_addr_list = [{127,0,0,1}]}} = inet:gethostbyname(FQDN), + {error,nxdomain} = inet_res:gethostbyname(Hostname), + {error,nxdomain} = inet_res:gethostbyname(FQDN), + {ok,{127,0,0,10}} = inet:getaddr("mx.otptest", inet), + {ok,{0,0,0,0,0,0,32512,28}} = inet:getaddr("resolve.otptest", inet6), + ok = inet_db:res_option(inet6, true), + {ok,#hostent{h_name = Hostname, + h_addrtype = inet6, + h_length = 16, + h_addr_list = [{0,0,0,0,0,0,0,1}]}} = + inet:gethostbyname(Hostname), + {ok,#hostent{h_name = FQDN, + h_addrtype = inet6, + h_length = 16, + h_addr_list = [{0,0,0,0,0,0,0,1}]}} = + inet:gethostbyname(FQDN), + {error,nxdomain} = inet_res:gethostbyname("resolve"), + %% XXX inet does not honour res_option inet6, might be a problem? + %% therefore inet_res is called here + {ok,#hostent{h_name = "resolve.otptest", + h_addrtype = inet6, + h_length = 16, + h_addr_list = [{0,0,0,0,0,0,32512,28}]}} = + inet_res:gethostbyname("resolve.otptest"), + {error,nxdomain} = inet_hosts:gethostbyname("files_monitor"), + ok = file:write_file(ResolvConf, "search otptest\n"), + ok = file:write_file(HostsFile, "::100 files_monitor\n"), + receive after 7000 -> ok end, % RES_FILE_UPDATE_TM in inet_res.hrl is 5 s + {ok,#hostent{h_name = "resolve.otptest", + h_addrtype = inet6, + h_length = 16, + h_addr_list = [{0,0,0,0,0,0,32512,28}]}} = + inet_res:gethostbyname("resolve.otptest"), + ["otptest"] = inet_db:res_option(search), + {ok,#hostent{h_name = "files_monitor", + h_addrtype = inet6, + h_length = 16, + h_addr_list = [{0,0,0,0,0,0,0,256}]}} = + inet_hosts:gethostbyname("files_monitor"), + ok = inet_db:res_option(inet6, false), + {ok,#hostent{h_name = "resolve.otptest", + h_addrtype = inet, + h_length = 4, + h_addr_list = [{127,0,0,28}]}} = + inet:gethostbyname("resolve.otptest"), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Compatibility tests. Call the inet_SUITE tests, but with +%% lookup = [file,dns] instead of [native] + +gethostbyaddr(Config) -> inet_SUITE:t_gethostbyaddr(Config). +gethostbyaddr_v6(Config) -> inet_SUITE:t_gethostbyaddr_v6(Config). +gethostbyname(Config) -> inet_SUITE:t_gethostbyname(Config). +gethostbyname_v6(Config) -> inet_SUITE:t_gethostbyname_v6(Config). +getaddr(Config) -> inet_SUITE:t_getaddr(Config). +getaddr_v6(Config) -> inet_SUITE:t_getaddr_v6(Config). +ipv4_to_ipv6(Config) -> inet_SUITE:ipv4_to_ipv6(Config). +host_and_addr(Config) -> inet_SUITE:host_and_addr(Config). diff --git a/lib/kernel/test/inet_res_SUITE_data/otptest/0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa.zone b/lib/kernel/test/inet_res_SUITE_data/otptest/0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa.zone new file mode 100644 index 0000000000..81e14217ba --- /dev/null +++ b/lib/kernel/test/inet_res_SUITE_data/otptest/0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa.zone @@ -0,0 +1,12 @@ +$TTL 3600 +@ IN SOA ns.otptest. lsa.otptest. ( + 1 ; serial + 60 ; refresh + 10 ; retry + 300 ; expiry + 30 ) ; minimum + + IN NS ns.otptest. + IN MX 10 mx.otptest. + +c.1 IN PTR resolve.otptest. diff --git a/lib/kernel/test/inet_res_SUITE_data/otptest/0.0.127.in-addr.arpa.zone b/lib/kernel/test/inet_res_SUITE_data/otptest/0.0.127.in-addr.arpa.zone new file mode 100644 index 0000000000..bae50a9eec --- /dev/null +++ b/lib/kernel/test/inet_res_SUITE_data/otptest/0.0.127.in-addr.arpa.zone @@ -0,0 +1,27 @@ +$TTL 3600 +@ IN SOA ns.otptest. lsa.otptest. ( + 1 ; serial + 60 ; refresh + 10 ; retry + 300 ; expiry + 30 ) ; minimum + + IN NS ns.otptest. + IN MX 10 mx.otptest. + +1 IN PTR test1-78901234567890123456789012345678.otptest. +2 IN PTR test2-78901234567890123456789012345678.otptest. +10 IN PTR mx.otptest. +11 IN PTR ns1-5678901234567890123456789012345678.otptest. +12 IN PTR ns2-5678901234567890123456789012345678.otptest. +21 IN PTR mx1-5678901234567890123456789012345678.otptest. +22 IN PTR mx2-5678901234567890123456789012345678.otptest. +23 IN PTR mx3-5678901234567890123456789012345678.otptest. +24 IN PTR mx4-5678901234567890123456789012345678.otptest. +25 IN PTR mx5-5678901234567890123456789012345678.otptest. +26 IN PTR mx6-5678901234567890123456789012345678.otptest. +27 IN PTR mx7-5678901234567890123456789012345678.otptest. + +28 IN PTR resolve.otptest. + +254 IN PTR ns.otptest. diff --git a/lib/kernel/test/inet_res_SUITE_data/otptest/named_inc.conf b/lib/kernel/test/inet_res_SUITE_data/otptest/named_inc.conf new file mode 100644 index 0000000000..0b01b25204 --- /dev/null +++ b/lib/kernel/test/inet_res_SUITE_data/otptest/named_inc.conf @@ -0,0 +1,12 @@ +zone "." in { + type master; + file "root.zone"; +}; +zone "0.0.127.in-addr.arpa" in { + type master; + file "0.0.127.in-addr.arpa.zone"; +}; +zone "0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa" in { + type master; + file "0.0.0.0.f.7.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.0.ip6.arpa.zone"; +};
\ No newline at end of file diff --git a/lib/kernel/test/inet_res_SUITE_data/otptest/root.zone b/lib/kernel/test/inet_res_SUITE_data/otptest/root.zone new file mode 100644 index 0000000000..11cba18d45 --- /dev/null +++ b/lib/kernel/test/inet_res_SUITE_data/otptest/root.zone @@ -0,0 +1,50 @@ +$TTL 3600 +@ IN SOA ns.otptest lsa.otptest ( + 1 ; serial + 60 ; refresh + 10 ; retry + 300 ; expiry + 30 ) ; minimum + + IN NS ns.otptest + IN NS ns1-5678901234567890123456789012345678.otptest + IN NS ns2-5678901234567890123456789012345678.otptest +otptest IN MX 10 mx.otptest +otptest IN MX 20 mx1-5678901234567890123456789012345678.otptest +otptest IN MX 20 mx2-5678901234567890123456789012345678.otptest +otptest IN MX 20 mx3-5678901234567890123456789012345678.otptest +otptest IN MX 20 mx4-5678901234567890123456789012345678.otptest +otptest IN MX 20 mx5-5678901234567890123456789012345678.otptest +otptest IN MX 20 mx6-5678901234567890123456789012345678.otptest +otptest IN MX 20 mx7-5678901234567890123456789012345678.otptest + +test1-78901234567890123456789012345678.otptest IN A 127.0.0.1 +test2-78901234567890123456789012345678.otptest IN A 127.0.0.2 +ns1-5678901234567890123456789012345678.otptest IN A 127.0.0.11 +ns2-5678901234567890123456789012345678.otptest IN A 127.0.0.12 +mx.otptest IN A 127.0.0.10 +mx1-5678901234567890123456789012345678.otptest IN A 127.0.0.21 +mx2-5678901234567890123456789012345678.otptest IN A 127.0.0.22 +mx3-5678901234567890123456789012345678.otptest IN A 127.0.0.23 +mx4-5678901234567890123456789012345678.otptest IN A 127.0.0.24 +mx5-5678901234567890123456789012345678.otptest IN A 127.0.0.25 +mx6-5678901234567890123456789012345678.otptest IN A 127.0.0.26 +mx7-5678901234567890123456789012345678.otptest IN A 127.0.0.27 + +resolve.otptest IN A 127.0.0.28 +resolve.otptest IN AAAA ::127.0.0.28 +cname.resolve.otptest IN CNAME resolve.otptest +wks.resolve.otptest IN WKS 127.0.0.28 TCP ( telnet smtp ) +resolve.otptest IN HINFO "BEAM" "Erlang/OTP" +ns.resolve.otptest IN NS resolve.otptest +mx.resolve.otptest IN MX 10 resolve.otptest +_srv._tcp.resolve.otptest IN SRV 10 3 4711 resolve.otptest +naptr.resolve.otptest IN NAPTR 10 5 "S" "HTTP" "" _srv._tcp.resolve.otptest +txt.resolve.otptest IN TXT "Hej " "du " "glade " +txt.resolve.otptest IN TXT "ta " "en " "spade!" +mb.resolve.otptest IN MB mx.resolve.otptest +mg.resolve.otptest IN MG lsa.otptest +mr.resolve.otptest IN MR lsa.otptest +minfo.resolve.otptest IN MINFO minfo-owner.resolve.otptest minfo-bounce.resolve.otptest + +ns.otptest IN A 127.0.0.254 diff --git a/lib/kernel/test/inet_res_SUITE_data/run-named b/lib/kernel/test/inet_res_SUITE_data/run-named new file mode 100755 index 0000000000..b418607d48 --- /dev/null +++ b/lib/kernel/test/inet_res_SUITE_data/run-named @@ -0,0 +1,163 @@ +#! /bin/sh +## +## %CopyrightBegin% +## +## Copyright Ericsson AB 2009. All Rights Reserved. +## +## The contents of this file are subject to the Erlang Public License, +## Version 1.1, (the "License"); you may not use this file except in +## compliance with the License. You should have received a copy of the +## Erlang Public License along with this software. If not, it can be +## retrieved online at http://www.erlang.org/. +## +## Software distributed under the License is distributed on an "AS IS" +## basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +## the License for the specific language governing rights and limitations +## under the License. +## +## %CopyrightEnd% +## +# + +# +## run-named +## +## $0 IPAddress PortNum SubDir +## +## * Create a work directory ./SubDir, create a named.conf there. +## * Locate named and check its version. +## * Zopy zone files from `dirname $0`/SubDir to ./SubDir. +## * Start named in ./SubDir with logging to named.log there. +## * Wait for "quit" on stdin. +## * Terminate named and wait for it. +## +## Prints status lines starting with tag and colon (think mail header): +## Error: have given up, no name server started +## Running: name server is running, waiting for "quit" +## Other tags: diagnostics info +# + +unset LDPATH CDPATH ENV BASH_ENV +IFS=' ' +PATH=/usr/sbin:/sbin:/usr/bin:/bin +SHELL=/bin/sh +export PATH SHELL + +CONF_FILE=named.conf +INC_FILE=named_inc.conf +PID_FILE=named.pid +LOG_FILE=named.log + +error () { + r=$? + echo "Error: $*" + exit $r +} + +# Check argument: IP address +test :"$1" != : || \ + error "Empty argument 1: IP address !" + +# Check argument: Port number +expr "0$2" + 0 '>' 0 '&' "0$2" + 0 '<' 65536 >/dev/null 2>&1 || \ + error "Invalid argument 2: port number !" + +# Check argument: Work/Zone subdir +test :"$3" != : || \ + error "Empty argument 3: Work/Zone subdir!" +SRCDIR="`dirname "$0"`/$3" +test -d "$SRCDIR" || \ + error "Missing zone directory $SRCDIR !" +test -f "$SRCDIR/$INC_FILE" || \ + error "Missing file: $SRCDIR/$INC_FILE !" + +# Locate named and check version +NAMED=named +for n in /usr/sbin/named /usr/sbin/in.named; do + test -x "$n" && NAMED="$n" +done +NAMED_VER="`"$NAMED" -v 2>&1`" || \ + error "Name server not found!" +NAMED_VER=`echo "$NAMED_VER" | ( read V1 V2 V3 IGNORED && \ + if test :"$V1" = :'in.named'; then + echo "$V2 $V3" + else + echo "$V1 $V2" + fi +)` +case :"$NAMED_VER" in + :'BIND '8.*) NAMED_FG='-f';; + :'BIND '9.*) NAMED_FG='-g';; + :*) error "Name server version is unknown: $NAMED_VER";; +esac + +# Create working directory and cd to it +mkdir "$3" >/dev/null 2>&1 +cd "$3" >/dev/null 2>&1 || \ + error "Can not cd: $3 !" + +# Create $CONF_FILE +cat >"$CONF_FILE" <<-CONF_FILE + # + # $CONF_FILE for $NAMED_VER + # Generated by $0. + # + # Copyright: see $0. + # + logging { + category default { + default_stderr; + }; + }; + CONF_FILE +case :"$NAMED_VER" in + :'BIND '8.*|:'BIND '9.[012]|:'BIND '9.[012].*) + cat >>"$CONF_FILE" <<-CONF_FILE + controls { + inet 127.0.0.1 port 0 allow { !0/32; }; + }; + options { + pid-file "$PID_FILE"; + listen-on port $2 { $1; }; + recursion no; + allow-query { $1; }; + }; + CONF_FILE + ;; + :*) + cat >>"$CONF_FILE" <<-CONF_FILE + controls { + }; + options { + pid-file none; + listen-on port $2 { $1; }; + recursion no; + allow-query { $1; }; + }; + CONF_FILE + ;; +esac +cat >>"$CONF_FILE" <<-CONF_FILE + include "$INC_FILE"; + CONF_FILE + +# Copy all subdir files +( cd "$SRCDIR" && ls -1 ) | while read f; do + cp -fp "$SRCDIR/$f" . +done + +# Start nameserver +echo "Cwd: `pwd`" +echo "Nameserver: $NAMED_VER" +echo "Port: $2" +echo "ZoneDir: $3" +$NAMED $NAMED_FG -c "$CONF_FILE" >"$LOG_FILE" 2>&1 </dev/null & +NAMED=$! +trap "kill -TERM $NAMED >/dev/null 2>&1; wait $NAMED >/dev/null 2>&1" \ + 0 1 2 3 15 +sleep 1 # Give name server time to load its zone files +echo "Running: Enter \`\`quit'' to terminate nameserver[$NAMED]..." +while read LINE; do + test :"$LINE" = :'quit' && break +done +echo "Closing: Terminating nameserver..." diff --git a/lib/kernel/test/inet_sockopt_SUITE.erl b/lib/kernel/test/inet_sockopt_SUITE.erl new file mode 100644 index 0000000000..0fa0226ccf --- /dev/null +++ b/lib/kernel/test/inet_sockopt_SUITE.erl @@ -0,0 +1,681 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2009. 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(inet_sockopt_SUITE). + +-include("test_server.hrl"). + + +-define(C_GET_IPPROTO_TCP,1). +-define(C_GET_IPPROTO_IP,2). +-define(C_GET_SOL_SOCKET,3). +-define(C_GET_SOL_IP,4). + +-define(C_GET_TCP_KEEPIDLE,11). +-define(C_GET_TCP_LINGER2,12). +-define(C_GET_TCP_INFO,13). +-define(C_GET_SO_REUSEADDR,14). +-define(C_GET_SO_KEEPALIVE,15). +-define(C_GET_SO_LINGER,16). + +-define(C_GET_LINGER_SIZE,21). +-define(C_GET_TCP_INFO_SIZE,22). + +-define(C_GET_OFF_LINGER_L_ONOFF,31). +-define(C_GET_OFF_LINGER_L_LINGER,32). +-define(C_GET_OFF_TCPI_SACKED,33). +-define(C_GET_OFF_TCPI_OPTIONS,34). + +-define(C_GET_SIZ_LINGER_L_ONOFF,41). +-define(C_GET_SIZ_LINGER_L_LINGER,42). +-define(C_GET_SIZ_TCPI_SACKED,43). +-define(C_GET_SIZ_TCPI_OPTIONS,44). + +-define(C_QUIT,99). + +-export([all/1, simple/1, loop_all/1, simple_raw/1, simple_raw_getbin/1, + doc_examples_raw/1,doc_examples_raw_getbin/1, + large_raw/1,large_raw_getbin/1,combined/1,combined_getbin/1, + type_errors/1]). + +-export([init_per_testcase/2, end_per_testcase/2]). + + +all(suite) -> + [simple,loop_all,simple_raw,simple_raw_getbin, + doc_examples_raw, doc_examples_raw_getbin, + large_raw,large_raw_getbin,combined,combined_getbin,type_errors]. + +init_per_testcase(_Func, Config) -> + Dog = test_server:timetrap(test_server:seconds(60)), + [{watchdog,Dog}|Config]. + +end_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog). + +simple(suite) -> []; +simple(doc) -> "Test inet:setopt/getopt simple functionality."; +simple(Config) when is_list(Config) -> + ?line XOpt = case os:type() of + {unix,_} -> [{reuseaddr,true}]; + _ -> [] + end, + ?line Opt = [{nodelay,true}, + {keepalive,true},{packet,4}, + {active,false}|XOpt], + ?line OptTags = [X || {X,_} <- Opt], + ?line {S1,S2} = create_socketpair(Opt, Opt), + ?line {ok,Opt} = inet:getopts(S1,OptTags), + ?line {ok,Opt} = inet:getopts(S2,OptTags), + ?line COpt = [{X,case X of nodelay -> false;_ -> Y end} || {X,Y} <- Opt], + ?line inet:setopts(S1,COpt), + ?line {ok,COpt} = inet:getopts(S1,OptTags), + ?line {ok,Opt} = inet:getopts(S2,OptTags), + ?line gen_tcp:close(S1), + ?line gen_tcp:close(S2), + ok. + +loop_all(suite) -> []; +loop_all(doc) -> "Loop through all socket options and check that they work"; +loop_all(Config) when is_list(Config) -> + ?line ListenFailures = + lists:foldr(make_check_fun(listen,1),[],all_listen_options()), + ?line ConnectFailures = + lists:foldr(make_check_fun(connect,2),[],all_connect_options()), + ?line case ListenFailures++ConnectFailures of + [] -> + ?line ok; + Failed -> + ?line {comment,lists:flatten( + io_lib:format("Non mandatory failed:~w", + [Failed]))} + end. + + + +simple_raw(suite) -> []; +simple_raw(doc) -> "Test simple setopt/getopt of raw options."; +simple_raw(Config) when is_list(Config) -> + do_simple_raw(Config,false). +simple_raw_getbin(suite) -> []; +simple_raw_getbin(doc) -> "Test simple setopt/getopt of raw options, " + "with binaries in getopt."; +simple_raw_getbin(Config) when is_list(Config) -> + do_simple_raw(Config,true). + +do_simple_raw(Config,Binary) when is_list(Config) -> + ?line Port = start_helper(Config), + ?line SolSocket = ask_helper(Port,?C_GET_SOL_SOCKET), + ?line SoKeepAlive = ask_helper(Port,?C_GET_SO_KEEPALIVE), + ?line OptionTrue = {raw,SolSocket,SoKeepAlive,<<1:32/native>>}, + ?line OptionFalse = {raw,SolSocket,SoKeepAlive,<<0:32/native>>}, + ?line {S1,S2} = create_socketpair([OptionTrue],[{keepalive,true}]), + ?line {ok,[{keepalive,true}]} = inet:getopts(S1,[keepalive]), + ?line {ok,[{keepalive,true}]} = inet:getopts(S2,[keepalive]), + ?line {ok,[{raw,SolSocket,SoKeepAlive,X1B}]} = + inet:getopts(S1,[{raw,SolSocket,SoKeepAlive,binarify(4,Binary)}]), + ?line X1 = nintbin2int(X1B), + ?line {ok,[{raw,SolSocket,SoKeepAlive,X2B}]} = + inet:getopts(S2,[{raw,SolSocket,SoKeepAlive,binarify(4,Binary)}]), + ?line X2 = nintbin2int(X2B), + ?line true = X1 > 0, + ?line true = X2 > 0, + ?line inet:setopts(S1,[{keepalive,false}]), + ?line inet:setopts(S2,[OptionFalse]), + ?line {ok,[{keepalive,false}]} = inet:getopts(S1,[keepalive]), + ?line {ok,[{keepalive,false}]} = inet:getopts(S2,[keepalive]), + ?line {ok,[{raw,SolSocket,SoKeepAlive,Y1B}]} = + inet:getopts(S1,[{raw,SolSocket,SoKeepAlive,binarify(4,Binary)}]), + ?line Y1 = nintbin2int(Y1B), + ?line {ok,[{raw,SolSocket,SoKeepAlive,Y2B}]} = + inet:getopts(S2,[{raw,SolSocket,SoKeepAlive,binarify(4,Binary)}]), + ?line Y2 = nintbin2int(Y2B), + ?line true = Y1 == 0, + ?line true = Y2 == 0, + ?line gen_tcp:close(S1), + ?line gen_tcp:close(S2), + ?line stop_helper(Port), + ok. + +nintbin2int(<<Int:32/native>>) -> Int; +nintbin2int(<<Int:24/native>>) -> Int; +nintbin2int(<<Int:16/native>>) -> Int; +nintbin2int(<<Int:8/native>>) -> Int; +nintbin2int(<<>>) -> 0. + +doc_examples_raw(suite) -> []; +doc_examples_raw(doc) -> "Test that the example code from the documentation " + "works"; +doc_examples_raw(Config) when is_list(Config) -> + do_doc_examples_raw(Config,false). +doc_examples_raw_getbin(suite) -> []; +doc_examples_raw_getbin(doc) -> "Test that the example code from the " + "documentation works when getopt uses " + "binaries"; +doc_examples_raw_getbin(Config) when is_list(Config) -> + do_doc_examples_raw(Config,true). +do_doc_examples_raw(Config,Binary) when is_list(Config) -> + ?line Port = start_helper(Config), + ?line Proto = ask_helper(Port,?C_GET_IPPROTO_TCP), + ?line TcpInfo = ask_helper(Port,?C_GET_TCP_INFO), + ?line TcpInfoSize = ask_helper(Port,?C_GET_TCP_INFO_SIZE), + ?line TcpiSackedOffset = ask_helper(Port,?C_GET_OFF_TCPI_SACKED), + ?line TcpiOptionsOffset = ask_helper(Port,?C_GET_OFF_TCPI_OPTIONS), + ?line TcpiSackedSize = ask_helper(Port,?C_GET_SIZ_TCPI_SACKED), + ?line TcpiOptionsSize = ask_helper(Port,?C_GET_SIZ_TCPI_OPTIONS), + ?line TcpLinger2 = ask_helper(Port,?C_GET_TCP_LINGER2), + ?line stop_helper(Port), + case all_ok([Proto,TcpInfo,TcpInfoSize,TcpiSackedOffset, + TcpiOptionsOffset,TcpiSackedSize,TcpiOptionsSize, + TcpLinger2]) of + false -> + {skipped,"Does not run on this OS."}; + true -> + ?line {Sock,I} = create_socketpair([],[]), + ?line {ok,[{raw,Proto,TcpLinger2,<<OrigLinger:32/native>>}]} = + inet:getopts(Sock,[{raw,Proto,TcpLinger2,binarify(4,Binary)}]), + ?line NewLinger = OrigLinger div 2, + ?line ok = inet:setopts(Sock,[{raw,Proto,TcpLinger2, + <<NewLinger:32/native>>}]), + ?line {ok,[{raw,Proto,TcpLinger2,<<NewLinger:32/native>>}]} = + inet:getopts(Sock,[{raw,Proto,TcpLinger2,binarify(4,Binary)}]), + ?line ok = inet:setopts(Sock,[{raw,Proto,TcpLinger2, + <<OrigLinger:32/native>>}]), + ?line {ok,[{raw,Proto,TcpLinger2,<<OrigLinger:32/native>>}]} = + inet:getopts(Sock,[{raw,Proto,TcpLinger2,binarify(4,Binary)}]), + ?line {ok,[{raw,_,_,Info}]} = + inet:getopts(Sock,[{raw,Proto,TcpInfo, + binarify(TcpInfoSize,Binary)}]), + ?line Bit1 = TcpiSackedSize * 8, + ?line <<_:TcpiSackedOffset/binary, + TcpiSacked:Bit1/native,_/binary>> = + Info, + ?line 0 = TcpiSacked, + ?line Bit2 = TcpiOptionsSize * 8, + ?line <<_:TcpiOptionsOffset/binary, + TcpiOptions:Bit2/native,_/binary>> = + Info, + ?line true = TcpiOptions =/= 0, + ?line gen_tcp:close(Sock), + ?line gen_tcp:close(I), + ok + end. + +large_raw(suite) -> []; +large_raw(doc) -> "Test structs and large/too large buffers when raw"; +large_raw(Config) when is_list(Config) -> + do_large_raw(Config,false). +large_raw_getbin(suite) -> []; +large_raw_getbin(doc) -> "Test structs and large/too large buffers when raw" + "using binaries to getopts"; +large_raw_getbin(Config) when is_list(Config) -> + do_large_raw(Config,true). +do_large_raw(Config,Binary) when is_list(Config) -> + ?line Port = start_helper(Config), + ?line Proto = ask_helper(Port,?C_GET_SOL_SOCKET), + ?line Linger = ask_helper(Port,?C_GET_SO_LINGER), + ?line LingerSize = ask_helper(Port,?C_GET_LINGER_SIZE), + ?line LingerOnOffOffset = ask_helper(Port,?C_GET_OFF_LINGER_L_ONOFF), + ?line LingerLingerOffset = ask_helper(Port,?C_GET_OFF_LINGER_L_LINGER), + ?line LingerOnOffSize = ask_helper(Port,?C_GET_SIZ_LINGER_L_ONOFF), + ?line LingerLingerSize = ask_helper(Port,?C_GET_SIZ_LINGER_L_LINGER), + ?line stop_helper(Port), + case all_ok([Proto,Linger,LingerSize,LingerOnOffOffset, + LingerLingerOffset,LingerOnOffSize,LingerLingerSize]) of + false -> + {skipped,"Does not run on this OS."}; + true -> + ?line {Sock1,Sock2} = create_socketpair([{linger,{true,10}}], + [{linger,{false,0}}]), + ?line LargeSize = 1024, % Solaris can take up to 1024*9, + % linux 1024*63... + ?line TooLargeSize = 1024*64, + ?line {ok,[{raw,Proto,Linger,Linger1}]} = + inet:getopts(Sock1,[{raw,Proto,Linger, + binarify(LargeSize,Binary)}]), + ?line {ok,[{raw,Proto,Linger,Linger2}]} = + inet:getopts(Sock2,[{raw,Proto,Linger, + binarify(LingerSize,Binary)}]), + ?line true = byte_size(Linger1) =:= LingerSize, + ?line LingerLingerBits = LingerLingerSize * 8, + ?line LingerOnOffBits = LingerOnOffSize * 8, + ?line <<_:LingerLingerOffset/binary, + Ling1:LingerLingerBits/native,_/binary>> = Linger1, + ?line <<_:LingerOnOffOffset/binary, + Off1:LingerOnOffBits/native,_/binary>> = Linger1, + ?line <<_:LingerOnOffOffset/binary, + Off2:LingerOnOffBits/native,_/binary>> = Linger2, + ?line true = Off1 =/= 0, + ?line true = Off2 == 0, + ?line true = Ling1 == 10, + ?line {error,einval} = + inet:getopts(Sock1,[{raw,Proto,Linger,TooLargeSize}]), + ?line gen_tcp:close(Sock1), + ?line gen_tcp:close(Sock2), + ok + end. + +combined(suite) -> []; +combined(doc) -> "Test raw structs combined w/ other options "; +combined(Config) when is_list(Config) -> + do_combined(Config,false). +combined_getbin(suite) -> []; +combined_getbin(doc) -> "Test raw structs combined w/ other options and " + "binarise in getopts"; +combined_getbin(Config) when is_list(Config) -> + do_combined(Config,true). +do_combined(Config,Binary) when is_list(Config) -> + ?line Port = start_helper(Config), + ?line Proto = ask_helper(Port,?C_GET_SOL_SOCKET), + ?line Linger = ask_helper(Port,?C_GET_SO_LINGER), + ?line LingerSize = ask_helper(Port,?C_GET_LINGER_SIZE), + ?line LingerOnOffOffset = ask_helper(Port,?C_GET_OFF_LINGER_L_ONOFF), + ?line LingerLingerOffset = ask_helper(Port,?C_GET_OFF_LINGER_L_LINGER), + ?line LingerOnOffSize = ask_helper(Port,?C_GET_SIZ_LINGER_L_ONOFF), + ?line LingerLingerSize = ask_helper(Port,?C_GET_SIZ_LINGER_L_LINGER), + ?line stop_helper(Port), + case all_ok([Proto,Linger,LingerSize,LingerOnOffOffset, + LingerLingerOffset,LingerOnOffSize,LingerLingerSize]) of + false -> + {skipped,"Does not run on this OS."}; + true -> + ?line LingerLingerBits = LingerLingerSize * 8, + ?line LingerOnOffBits = LingerOnOffSize * 8, + ?line {LingerOn,LingerOff} = + case LingerOnOffOffset < LingerLingerOffset of + true -> + Pad1 = + list_to_binary( + lists:duplicate(LingerOnOffOffset, + 0)), + Pad2Siz = + LingerLingerOffset - LingerOnOffSize - + LingerOnOffOffset, + Pad2 = + list_to_binary( + lists:duplicate(Pad2Siz, + 0)), + Pad3Siz = LingerSize - LingerLingerSize - + LingerLingerOffset, + Pad3 = list_to_binary( + lists:duplicate(Pad3Siz, + 0)), + {<<Pad1/binary,1:LingerOnOffBits/native, + Pad2/binary,10:LingerLingerBits/native, + Pad3/binary>>, + <<Pad1/binary,0:LingerOnOffBits/native, + Pad2/binary,0:LingerLingerBits/native, + Pad3/binary>>}; + false -> + Pad1 = + list_to_binary( + lists:duplicate(LingerLingerOffset, + 0)), + Pad2Siz = + LingerOnOffOffset - LingerLingerSize - + LingerLingerOffset, + Pad2 = + list_to_binary( + lists:duplicate(Pad2Siz, + 0)), + Pad3Siz = LingerSize - LingerOnOffSize - + LingerOnOffOffset, + Pad3 = list_to_binary( + lists:duplicate(Pad3Siz, + 0)), + {<<Pad1/binary,1:LingerLingerBits/native, + Pad2/binary,10:LingerOnOffBits/native, + Pad3/binary>>, + <<Pad1/binary,0:LingerLingerBits/native, + Pad2/binary,0:LingerOnOffBits/native, + Pad3/binary>>} + end, + ?line RawLingerOn = {raw,Proto,Linger,LingerOn}, + ?line RawLingerOff = {raw,Proto,Linger,LingerOff}, + ?line {Sock1,Sock2} = + create_socketpair([{keepalive,true}, + RawLingerOn], + [{keepalive,false}, + RawLingerOff]), + ?line {ok,[{raw,Proto,Linger,Linger1},{keepalive,Keep1}]} = + inet:getopts(Sock1,[{raw,Proto,Linger, + binarify(LingerSize,Binary)},keepalive]), + ?line {ok,[{raw,Proto,Linger,Linger2},{keepalive,Keep2}]} = + inet:getopts(Sock2,[{raw,Proto,Linger, + binarify(LingerSize,Binary)},keepalive]), + ?line true = byte_size(Linger1) =:= LingerSize, + ?line <<_:LingerLingerOffset/binary, + Ling1:LingerLingerBits/native,_/binary>> = Linger1, + ?line <<_:LingerOnOffOffset/binary, + Off1:LingerOnOffBits/native,_/binary>> = Linger1, + ?line <<_:LingerOnOffOffset/binary, + Off2:LingerOnOffBits/native,_/binary>> = Linger2, + ?line true = Off1 =/= 0, + ?line true = Off2 == 0, + ?line true = Ling1 == 10, + ?line true = Keep1 =:= true, + ?line true = Keep2 =:= false, + ?line {Sock3,Sock4} = + create_socketpair([RawLingerOn,{keepalive,true}], + [RawLingerOff,{keepalive,false}]), + ?line {ok,[{raw,Proto,Linger,Linger3},{keepalive,Keep3}]} = + inet:getopts(Sock3,[{raw,Proto,Linger, + binarify(LingerSize,Binary)},keepalive]), + ?line {ok,[{raw,Proto,Linger,Linger4},{keepalive,Keep4}]} = + inet:getopts(Sock4,[{raw,Proto,Linger, + binarify(LingerSize,Binary)},keepalive]), + ?line true = byte_size(Linger3) =:= LingerSize, + ?line <<_:LingerLingerOffset/binary, + Ling3:LingerLingerBits/native,_/binary>> = Linger3, + ?line <<_:LingerOnOffOffset/binary, + Off3:LingerOnOffBits/native,_/binary>> = Linger3, + ?line <<_:LingerOnOffOffset/binary, + Off4:LingerOnOffBits/native,_/binary>> = Linger4, + ?line true = Off3 =/= 0, + ?line true = Off4 == 0, + ?line true = Ling3 == 10, + ?line true = Keep3 =:= true, + ?line true = Keep4 =:= false, + ?line {Sock5,Sock6} = + create_socketpair([{packet,4},RawLingerOn,{keepalive,true}], + [{packet,2},RawLingerOff,{keepalive,false}]), + ?line {ok,[{packet,Pack5},{raw,Proto,Linger,Linger5}, + {keepalive,Keep5}]} = + inet:getopts(Sock5,[packet,{raw,Proto,Linger, + binarify(LingerSize,Binary)}, + keepalive]), + ?line {ok,[{packet,Pack6},{raw,Proto,Linger,Linger6}, + {keepalive,Keep6}]} = + inet:getopts(Sock6,[packet,{raw,Proto,Linger, + binarify(LingerSize,Binary)}, + keepalive]), + ?line true = byte_size(Linger5) =:= LingerSize, + ?line <<_:LingerLingerOffset/binary, + Ling5:LingerLingerBits/native,_/binary>> = Linger5, + ?line <<_:LingerOnOffOffset/binary, + Off5:LingerOnOffBits/native,_/binary>> = Linger5, + ?line <<_:LingerOnOffOffset/binary, + Off6:LingerOnOffBits/native,_/binary>> = Linger6, + ?line true = Off5 =/= 0, + ?line true = Off6 == 0, + ?line true = Ling5 == 10, + ?line true = Keep5 =:= true, + ?line true = Keep6 =:= false, + ?line true = Pack5 =:= 4, + ?line true = Pack6 =:= 2, + ?line inet:setopts(Sock6,[{packet,4},RawLingerOn, + {keepalive,true}]), + ?line {ok,[{packet,Pack7},{raw,Proto,Linger,Linger7}, + {keepalive,Keep7}]} = + inet:getopts(Sock6,[packet,{raw,Proto,Linger, + binarify(LingerSize,Binary)}, + keepalive]), + ?line <<_:LingerOnOffOffset/binary, + Off7:LingerOnOffBits/native,_/binary>> = Linger7, + ?line true = Off7 =/= 0, + ?line true = Keep7 =:= true, + ?line true = Pack7 =:= 4, + ?line gen_tcp:close(Sock1), + ?line gen_tcp:close(Sock2), + ?line gen_tcp:close(Sock3), + ?line gen_tcp:close(Sock4), + ?line gen_tcp:close(Sock5), + ?line gen_tcp:close(Sock6), + ok + end. + +type_errors(suite) -> + []; +type_errors(doc) -> + "Test that raw data requests are not executed for bad types"; +type_errors(Config) when is_list(Config) -> + ?line BadSetOptions = + [ + {raw,x,3,<<1:32>>}, + {raw,1,tre,<<1:32>>}, + {raw,1,3,ko}, + {raw,1,3,5}, + {raw,1,3}, + {raw,1}, + {raw}, + {raw,ett}, + {raw,ett,tre}, + {raw,{true,10}}, + {raw,{ett,tre,<<1:32>>}}, + {rav,1,3,<<1:32>>}, + raw, + rav, + {linger,banan} + ], + ?line BadGetOptions = + [ + {raw,x,3,<<1:32>>}, + {raw,1,tre,<<1:32>>}, + {raw,1,3,ko}, + {raw,1,3,5.1}, + {raw,1,3,-3}, + {raw,1,3}, + {raw,1}, + {raw}, + {raw,ett}, + {raw,ett,tre}, + {raw,{true,10}}, + {raw,{ett,tre,<<1:32>>}}, + {rav,1,3,<<1:32>>}, + raw, + rav, + {linger,banan} + ], + ?line lists:foreach(fun(Option) -> + ?line case + catch create_socketpair([Option],[]) of + {'EXIT',badarg} -> + ?line ok; + Unexpected1 -> + ?line exit({unexpected, + Unexpected1}) + end, + ?line case + catch create_socketpair([],[Option]) of + {'EXIT',badarg} -> + ?line ok; + Unexpected2 -> + ?line exit({unexpected, + Unexpected2}) + end, + ?line {Sock1,Sock2} = create_socketpair([],[]), + ?line case inet:setopts(Sock1, [Option]) of + {error,einval} -> + ?line ok; + Unexpected3 -> + ?line exit({unexpected, + Unexpected3}) + end, + ?line gen_tcp:close(Sock1), + ?line gen_tcp:close(Sock2) + end,BadSetOptions), + ?line {Sock1,Sock2} = create_socketpair([],[]), + ?line lists:foreach(fun(Option) -> + ?line case inet:getopts(Sock1, [Option]) of + {error,einval} -> + ?line ok; + Unexpected -> + ?line exit({unexpected, + Unexpected}) + end + end,BadGetOptions), + ?line gen_tcp:close(Sock1), + ?line gen_tcp:close(Sock2), + ok. + +all_ok([]) -> + true; +all_ok([H|T]) when H >= 0 -> + all_ok(T); +all_ok(_) -> + false. + + +make_check_fun(Type,Element) -> + fun({Name,V1,V2,Mand,Chang},Acc) -> + ?line {LO1,CO1} = setelement(Element,{[],[]}, [{Name,V1}]), + ?line {LO2,CO2} = setelement(Element,{[],[]}, [{Name,V2}]), + ?line {X1,Y1} = create_socketpair(LO1,CO1), + ?line {X2,Y2} = create_socketpair(LO2,CO2), + ?line S1 = element(Element,{X1,Y1}), + ?line S2 = element(Element,{X2,Y2}), + ?line {ok,[{Name,R1}]} = inet:getopts(S1,[Name]), + ?line {ok,[{Name,R2}]} = inet:getopts(S2,[Name]), + NewAcc = + case R1 =/= R2 of + true -> + case Chang of + true -> + ?line inet:setopts(S1,[{Name,V2}]), + ?line {ok,[{Name,R3}]} = + inet:getopts(S1,[Name]), + case {R3 =/= R1, R3 =:= R2} of + {true,true} -> + ?line Acc; + _ -> + case Mand of + true -> + ?line exit + ({failed_sockopt, + {change, + Name}}); + false -> + ?line [{change,Name}|Acc] + end + end; + false -> + ?line Acc + end; + false -> + case Mand of + true -> + ?line exit({failed_sockopt, + {Type,Name}}); + false -> + ?line [{Type,Name}|Acc] + end + end, + ?line gen_tcp:close(X1), + ?line gen_tcp:close(Y1), + ?line gen_tcp:close(X2), + ?line gen_tcp:close(Y2), + NewAcc + end. + +% {OptionName,Value1,Value2,Mandatory,Changeable} +all_listen_options() -> + [{tos,0,1,false,true}, + {priority,0,1,false,true}, + {reuseaddr,false,true,false,true}, + {keepalive,false,true,true,true}, + {linger, {false,10}, {true,10},true,true}, + {sndbuf,2048,4096,false,true}, + {recbuf,2048,4096,false,true}, + {nodelay,false,true,true,true}, + {header,2,4,true,true}, + {active,false,true,true,false}, + {packet,2,4,true,true}, + {buffer,1000,2000,true,true}, + {mode,list,binary,true,true}, + {deliver,term,port,true,true}, + {exit_on_close, true, false, true, true}, + %{high_watermark,4096,8192,true,true}, + %{low_watermark,2048,4096,true,true}, + {bit8,on,off,true,true}, + {send_timeout,infinity,1000,true,true}, + {send_timeout_close,false,true,true,true}, + {delay_send,false,true,true,true}, + {packet_size,0,4,true,true} + ]. +all_connect_options() -> + [{tos,0,1,false,true}, + {priority,0,1,false,true}, + {reuseaddr,false,true,false,true}, + {keepalive,false,true,true,true}, + {linger, {false,10}, {true,10},true,true}, + {sndbuf,2048,4096,false,true}, + {recbuf,2048,4096,false,true}, + {nodelay,false,true,true,true}, + {header,2,4,true,true}, + {active,false,true,true,false}, + {packet,2,4,true,true}, + {buffer,1000,2000,true,true}, + {mode,list,binary,true,true}, + {deliver,term,port,true,true}, + {exit_on_close, true, false, true, true}, + {high_watermark,4096,8192,false,true}, + {low_watermark,2048,4096,false,true}, + {bit8,on,off,true,true}, + {send_timeout,infinity,1000,true,true}, + {send_timeout_close,false,true,true,true}, + {delay_send,false,true,true,true}, + {packet_size,0,4,true,true} + ]. + + +create_socketpair(ListenOptions,ConnectOptions) -> + ?line {ok,LS}=gen_tcp:listen(0,ListenOptions), + ?line {ok,Port}=inet:port(LS), + ?line {ok,CS}=gen_tcp:connect(localhost,Port,ConnectOptions), + ?line {ok,AS}=gen_tcp:accept(LS), + ?line gen_tcp:close(LS), + {AS,CS}. + + +start_helper(Config) -> + Progname = filename:join(?config(data_dir, Config), "sockopt_helper"), + Port = open_port({spawn,Progname},[eof,line]), + Port. + +ask_helper(Port,Code) -> + Com = integer_to_list(Code)++"\n", + Port ! {self(),{command,Com}}, + receive + {Port,{data,{eol,Text}}} -> + list_to_integer(Text); + Other -> + exit({error,{unexpected_data_from_helper,Other}}) + after 3000 -> + exit({error,helper_timeout}) + end. + +stop_helper(Port) -> + catch ask_helper(Port,?C_QUIT), + receive + {Port,eof} -> + Port ! {self(), close}, + receive + {Port,closed} -> + ok + after 1000 -> + timeout + end + after 1000 -> + timeout + end. + +binarify(Size,Binary) when Binary =:= true -> + <<0:Size/unit:8>>; +binarify(Size,Binary) when Binary =:= false -> + Size. diff --git a/lib/kernel/test/inet_sockopt_SUITE_data/Makefile.src b/lib/kernel/test/inet_sockopt_SUITE_data/Makefile.src new file mode 100644 index 0000000000..22829e8033 --- /dev/null +++ b/lib/kernel/test/inet_sockopt_SUITE_data/Makefile.src @@ -0,0 +1,14 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROGS = sockopt_helper@exe@ + +all: $(PROGS) + +sockopt_helper@exe@: sockopt_helper@obj@ + $(LD) $(CROSSLDFLAGS) -o sockopt_helper sockopt_helper@obj@ @LIBS@ + +sockopt_helper@obj@: sockopt_helper.c + $(CC) -c -o sockopt_helper@obj@ $(CFLAGS) sockopt_helper.c diff --git a/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c b/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c new file mode 100644 index 0000000000..fb3c622909 --- /dev/null +++ b/lib/kernel/test/inet_sockopt_SUITE_data/sockopt_helper.c @@ -0,0 +1,219 @@ +#if defined(VXWORKS) || defined(__OSE__) +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +int sockopt_helper(void){ + return 0; +} +#else + +#if defined(__WIN32__) +#define WIN32_LEAN_AND_MEAN +#include <winsock2.h> +#include <windows.h> +#include <process.h> +#include <stdio.h> +#include <stdlib.h> + +#else /* Unix */ + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include <stdarg.h> +#include <sys/types.h> +#include <sys/socket.h> +#include <sys/wait.h> +#ifdef HAVE_LINUX_TCP_H +#ifdef HAVE_SANE_LINUX_TCP_H +#include <linux/tcp.h> +#endif +#endif +#include <netinet/in.h> +#include <arpa/inet.h> +#include <netdb.h> +#include <errno.h> +#include <signal.h> + +#endif + +#define C_GET_IPPROTO_TCP 1 +#define C_GET_IPPROTO_IP 2 +#define C_GET_SOL_SOCKET 3 +#define C_GET_SOL_IP 4 + +#define C_GET_TCP_KEEPIDLE 11 +#define C_GET_TCP_LINGER2 12 +#define C_GET_TCP_INFO 13 +#define C_GET_SO_REUSEADDR 14 +#define C_GET_SO_KEEPALIVE 15 +#define C_GET_SO_LINGER 16 + +#define C_GET_LINGER_SIZE 21 +#define C_GET_TCP_INFO_SIZE 22 + +#define C_GET_OFF_LINGER_L_ONOFF 31 +#define C_GET_OFF_LINGER_L_LINGER 32 +#define C_GET_OFF_TCPI_SACKED 33 +#define C_GET_OFF_TCPI_OPTIONS 34 + +#define C_GET_SIZ_LINGER_L_ONOFF 41 +#define C_GET_SIZ_LINGER_L_LINGER 42 +#define C_GET_SIZ_TCPI_SACKED 43 +#define C_GET_SIZ_TCPI_OPTIONS 44 + +#define C_QUIT 99 + +int get_command(void) +{ + char buff[256]; + int res; + if (fgets(buff,256,stdin) == NULL) + exit(1); + sscanf(buff,"%d",&res); + return res; +} + +void put_answer(int x) +{ + printf("%d\n",x); +} + +int main(void){ + int x; + int res; + setbuf(stdin,NULL); + setbuf(stdout,NULL); + do { + x = get_command(); + + switch(x) { +#ifdef IPPROTO_TCP + case C_GET_IPPROTO_TCP: + res = IPPROTO_TCP; + break; +#endif +#ifdef IPPROTO_IP + case C_GET_IPPROTO_IP: + res = IPPROTO_IP; + break; +#endif +#ifdef SOL_SOCKET + case C_GET_SOL_SOCKET: + res = SOL_SOCKET; + break; +#endif +#ifdef SOL_IP + case C_GET_SOL_IP : + res = SOL_IP; + break; +#endif +#ifdef TCP_KEEPIDLE + case C_GET_TCP_KEEPIDLE: + res = TCP_KEEPIDLE; + break; +#endif +#ifdef TCP_LINGER2 + case C_GET_TCP_LINGER2: + res = TCP_LINGER2; + break; +#endif +#ifdef TCP_INFO + case C_GET_TCP_INFO: + res = TCP_INFO; + break; +#endif +#ifdef SO_REUSEADDR + case C_GET_SO_REUSEADDR: + res = SO_REUSEADDR; + break; +#endif +#ifdef SO_KEEPALIVE + case C_GET_SO_KEEPALIVE: + res = SO_KEEPALIVE; + break; +#endif +#ifdef SO_LINGER + case C_GET_SO_LINGER: + res = SO_LINGER; + break; +#endif +#ifdef SO_LINGER + case C_GET_LINGER_SIZE: + res = sizeof(struct linger); + break; +#endif +#if defined(TCP_INFO) && defined(HAVE_LINUX_TCP_H) + case C_GET_TCP_INFO_SIZE: + res = sizeof(struct tcp_info); + break; +#endif +#ifdef SO_LINGER + case C_GET_OFF_LINGER_L_ONOFF: + { + struct linger l; + res = ((char *) &(l.l_onoff)) - ((char *) &l); + } + break; + case C_GET_OFF_LINGER_L_LINGER: + { + struct linger l; + res = ((char *) &(l.l_linger)) - ((char *) &l); + } + break; +#endif +#if defined(TCP_INFO) && defined(HAVE_LINUX_TCP_H) + case C_GET_OFF_TCPI_SACKED: + { + struct tcp_info ti; + res = ((char *) &(ti.tcpi_sacked)) - ((char *) &(ti)); + } + break; + case C_GET_OFF_TCPI_OPTIONS: + { + struct tcp_info ti; + res = ((char *) &(ti.tcpi_options)) - ((char *) &(ti)); + } + break; +#endif +#ifdef SO_LINGER + case C_GET_SIZ_LINGER_L_ONOFF: + { + struct linger l; + res = sizeof(l.l_onoff); + } + break; + case C_GET_SIZ_LINGER_L_LINGER: + { + struct linger l; + res = sizeof(l.l_linger); + } + break; +#endif +#if defined(TCP_INFO) && defined(HAVE_LINUX_TCP_H) + case C_GET_SIZ_TCPI_SACKED: + { + struct tcp_info ti; + res = sizeof(ti.tcpi_sacked); + } + break; + case C_GET_SIZ_TCPI_OPTIONS: + { + struct tcp_info ti; + res = sizeof(ti.tcpi_options); + } + break; +#endif + case C_QUIT: + res = 0; + break; + default: + res = -1; + } + put_answer(res); + } while (x != C_QUIT); + return 0; +} +#endif + diff --git a/lib/kernel/test/init_SUITE.erl b/lib/kernel/test/init_SUITE.erl new file mode 100644 index 0000000000..3d777f93a4 --- /dev/null +++ b/lib/kernel/test/init_SUITE.erl @@ -0,0 +1,582 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. 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(init_SUITE). + +-include("test_server.hrl"). + +-export([all/1]). + +-export([get_arguments/1, get_argument/1, boot_var/1, restart/1, + get_plain_arguments/1, + reboot/1, stop/1, get_status/1, script_id/1, boot/1]). +-export([boot1/1, boot2/1]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +-export([init/1, fini/1]). + +-define(DEFAULT_TIMEOUT_SEC, 100). + +%%----------------------------------------------------------------- +%% Test suite for init. (Most code is run during system start/stop. +%% Should be started in a CC view with: +%% erl -sname master -rsh ctrsh +%%----------------------------------------------------------------- +all(suite) -> + [get_arguments, get_argument, boot_var, + get_plain_arguments, + restart, + get_status, script_id, boot]. + +init_per_testcase(Func, Config) when atom(Func), list(Config) -> + Dog=?t:timetrap(?t:seconds(?DEFAULT_TIMEOUT_SEC)), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Func, Config) -> + Dog=?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +init(doc) -> []; +init(suite) -> []; +init(Config) when is_list(Config) -> + Config. + +fini(doc) -> []; +fini(suite) -> []; +fini(Config) when is_list(Config) -> + Host = list_to_atom(from($@, atom_to_list(node()))), + Node = list_to_atom(lists:concat([init_test, "@", Host])), + stop_node(Node), + Config. + +get_arguments(doc) ->[]; +get_arguments(suite) -> {req, [distribution, {local_slave_nodes, 1}]}; +get_arguments(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(10)), + + Args = args(), + ?line {ok, Node} = start_node(init_test, Args), + ?line case rpc:call(Node, init, get_arguments, []) of + Arguments when is_list(Arguments) -> + stop_node(Node), + check_a(Arguments), + check_b(Arguments), + check_c(Arguments), + check_d(Arguments); + _ -> + stop_node(Node), + ?t:fail(get_arguments) + end, + ?line ?t:timetrap_cancel(Dog), + ok. + +check_a(Args) -> + case lists:keysearch(a,1,Args) of + {value, {a,["kalle"]}} -> + Args1 = lists:keydelete(a,1,Args), + case lists:keysearch(a,1,Args1) of + false -> + ok; + _ -> + ?t:fail(check_a1) + end; + _ -> + ?t:fail(check_a2) + end. + +check_b(Args) -> + case lists:keysearch(b,1,Args) of + {value, {b,["hej", "hopp"]}} -> + Args1 = lists:keydelete(b,1,Args), + case lists:keysearch(b,1,Args1) of + {value, {b,["san", "sa"]}} -> + Args2 = lists:keydelete(b,1,Args1), + case lists:keysearch(b,1,Args2) of + false -> + ok; + _ -> + ?t:fail(check_b1) + end; + _ -> + ?t:fail(check_b2) + end; + _ -> + ?t:fail(check_b3) + end. + +check_c(Args) -> + case lists:keysearch(c,1,Args) of + {value, {c,["4", "5", "6"]}} -> + Args1 = lists:keydelete(c,1,Args), + case lists:keysearch(c,1,Args1) of + {value, {c,["7", "8", "9"]}} -> + Args2 = lists:keydelete(c,1,Args1), + case lists:keysearch(c,1,Args2) of + false -> + ok; + _ -> + ?t:fail(check_c1) + end; + _ -> + ?t:fail(check_c2) + end; + _ -> + ?t:fail(check_c3) + end. + +check_d(Args) -> + case lists:keysearch(d,1,Args) of + {value, {d,[]}} -> + Args1 = lists:keydelete(d,1,Args), + case lists:keysearch(d,1,Args1) of + false -> + ok; + _ -> + ?t:fail(check_d1) + end; + _ -> + ?t:fail(check_d2) + end. + +get_argument(doc) ->[]; +get_argument(suite) -> {req, [distribution, {local_slave_nodes, 1}]}; +get_argument(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(10)), + + Args = args(), + ?line {ok, Node} = start_node(init_test, Args), + ?line case rpc:call(Node, init, get_argument, [b]) of + {ok, [["hej", "hopp"],["san", "sa"]]} -> + ok; + _ -> + stop_node(Node), + ?t:fail({get_argument, b}) + end, + ?line case rpc:call(Node, init, get_argument, [a]) of + {ok, [["kalle"]]} -> + ok; + _ -> + stop_node(Node), + ?t:fail({get_argument, a}) + end, + ?line case rpc:call(Node, init, get_argument, [c]) of + {ok, [["4", "5", "6"], ["7", "8", "9"]]} -> + ok; + _ -> + stop_node(Node), + ?t:fail({get_argument, c}) + end, + ?line case rpc:call(Node, init, get_argument, [d]) of + {ok, [[]]} -> + ok; + _ -> + stop_node(Node), + ?t:fail({get_argument, d}) + end, + ?line case rpc:call(Node, init, get_argument, [e]) of + error -> + ok; + _ -> + stop_node(Node), + ?t:fail({get_argument, e}) + end, + stop_node(Node), + ?line ?t:timetrap_cancel(Dog), + ok. + +get_plain_arguments(doc) ->[]; +get_plain_arguments(suite) -> {req, [distribution, {local_slave_nodes, 1}]}; +get_plain_arguments(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(10)), + Longstring = + "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2" + "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2" + "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2" + "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2" + "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2" + "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2" + "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2" + "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2" + "fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2fjdkfjdkfjfdaa2", + ?line true = (length(Longstring) > 255), + Args = long_args(Longstring), + ?line {ok, Node} = start_node(init_test, Args), + ?line case rpc:call(Node, init, get_plain_arguments, []) of + ["a", "b", "c", Longstring] -> + ok; + As -> + stop_node(Node), + ?t:fail({get_argument, As}) + end, + stop_node(Node), + ?line ?t:timetrap_cancel(Dog), + + ok. + + +%% ------------------------------------------------ +%% Use -boot_var flag to set $TEST_VAR in boot script. +%% ------------------------------------------------ +boot_var(doc) -> []; +boot_var(suite) -> {req, [distribution, {local_slave_nodes, 1}]}; +boot_var(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {comment, "Not run on VxWorks"}; + _ -> + ?line Dog = ?t:timetrap(?t:seconds(100)), + + {BootScript, TEST_VAR, KernelVsn, StdlibVsn} = create_boot(Config), + + %% Should fail as we have not given -boot_var TEST_VAR + ?line {error, timeout} = + start_node(init_test, "-boot " ++ BootScript), + + case is_real_system(KernelVsn, StdlibVsn) of + true -> + %% Now it should work !! + ?line {ok, Node} = + start_node(init_test, + "-boot " ++ BootScript ++ + " -boot_var TEST_VAR " ++ TEST_VAR), + stop_node(Node), + Res = ok; + _ -> +%% What we need is not so much version numbers on the directories, but +%% for the boot var TEST_VAR to appear in the boot script, and it doesn't +%% if we give the 'local' option to systools:make_script. + ?t:format( + "Test case not complete as we are not~n" + "running in a real system!~n" + "Probably this test is performed in a " + "clearcase view or source tree.~n" + "Need version numbers on the kernel and " + "stdlib directories!~n", + []), + Res = {skip, + "Test case only partially run since it is run " + "in a clearcase view or in a source tree. " + "Need an installed system to complete this test."} + end, + ?line ?t:timetrap_cancel(Dog), + Res + end. + +create_boot(Config) -> + ?line {ok, OldDir} = file:get_cwd(), + ?line {LatestDir, LatestName, KernelVsn, StdlibVsn} = + create_script(Config), + LibDir = code:lib_dir(), + ?line ok = file:set_cwd(LatestDir), + ?line ok = systools:make_script(LatestName, + [{variables, [{"TEST_VAR", LibDir}]}]), + ?line ok = file:set_cwd(OldDir), + {LatestDir ++ "/" ++ LatestName, LibDir, KernelVsn, StdlibVsn}. + +is_real_system(KernelVsn, StdlibVsn) -> + LibDir = code:lib_dir(), + filelib:is_dir(filename:join(LibDir, "kernel"++KernelVsn)) andalso + filelib:is_dir(filename:join(LibDir, "stdlib"++StdlibVsn)). + +%% ------------------------------------------------ +%% Slave executes erlang:halt() on master nodedown. +%% Therefore the slave process must be killed +%% before restart. +%% ------------------------------------------------ +restart(doc) -> []; +restart(suite) -> + case ?t:os_type() of + {Fam, _} when Fam == unix; Fam == win32 -> + {req, [distribution, {local_slave_nodes, 1}, {time, 5}]}; + _ -> + {skip, "Only run on unix and win32"} + end; +restart(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(40)), + ?line Args = args(), + + %% Currently test_server:start_node cannot be used. The restarted + %% node immediately halts due to the implementation of + %% test_server:start_node. + ?line {ok, Node} = loose_node:start(init_test, Args, ?DEFAULT_TIMEOUT_SEC), + %% Ok, the node is up, now the real test test begins. + ?line erlang:monitor_node(Node, true), + ?line InitPid = rpc:call(Node, erlang, whereis, [init]), + ?line Procs = rpc:call(Node, erlang, processes, []), + ?line MaxPid = lists:last(Procs), + ?line ok = rpc:call(Node, init, restart, []), + ?line receive + {nodedown, Node} -> + ok + after 10000 -> + loose_node:stop(Node), + ?t:fail(not_stopping) + end, + ?line ok = wait_restart(30, Node), + + %% Still the same init process! + ?line InitPid1 = rpc:call(Node, erlang, whereis, [init]), + InitP = pid_to_list(InitPid), + ?line InitP = pid_to_list(InitPid1), + + ?line NewProcs0 = rpc:call(Node, erlang, processes, []), + NewProcs = lists:delete(InitPid1, NewProcs0), + ?line case check_processes(NewProcs, MaxPid) of + true -> + ok; + _ -> + loose_node:stop(Node), + ?t:fail(processes_not_greater) + end, + + %% Test that, for instance, the same argument still exists. + ?line case rpc:call(Node, init, get_argument, [c]) of + {ok, [["4", "5", "6"], ["7", "8", "9"]]} -> + ok; + _ -> + loose_node:stop(Node), + ?t:fail({get_argument, restart_fail}) + end, + loose_node:stop(Node), + ?line ?t:timetrap_cancel(Dog), + ok. + +wait_restart(0, _Node) -> + ?t:fail(not_restarted); +wait_restart(N, Node) -> + case net_adm:ping(Node) of + pong -> ok; + _ -> + ?t:sleep(1000), + wait_restart(N - 1, Node) + end. + +check_processes(NewProcs, MaxPid) -> + [N,P,I] = apid(MaxPid), + case lists:filter(fun(Pid) -> + case apid(Pid) of + [N,P1,_I1] when P1 > P -> false; + [N,_P1,I1] when I1 > I -> false; + _ -> true + end + end, NewProcs) of + [] -> + true; + _ -> + false + end. + +apid(Pid) -> + [N,P,I] = string:tokens(pid_to_list(Pid),"<>."), + [list_to_integer(N),list_to_integer(P),list_to_integer(I)]. + +%% ------------------------------------------------ +%% Just test that the system is halted here. +%% The reboot facility using heart is tested +%% in the heart_SUITE. +%% ------------------------------------------------ +reboot(doc) -> []; +reboot(suite) -> {req, [distribution, {local_slave_nodes, 1}]}; +reboot(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(40)), + + Args = args(), + ?line {ok, Node} = start_node(init_test, Args), + erlang:monitor_node(Node, true), + ?line ok = rpc:call(Node, init, reboot, []), + ?line receive + {nodedown, Node} -> + ok + after 10000 -> + stop_node(Node), + ?t:fail(not_stopping) + end, + ?t:sleep(5000), + ?line case net_adm:ping(Node) of + pang -> + ok; + _ -> + stop_node(Node), + ?t:fail(system_rebooted) + end, + ?line ?t:timetrap_cancel(Dog), + ok. + +%% ------------------------------------------------ +%% +%% ------------------------------------------------ +stop(doc) -> []; +stop(suite) -> []; +stop(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(20)), + Args = args(), + ?line {ok, Node} = start_node(init_test, Args), + erlang:monitor_node(Node, true), + ?line ok = rpc:call(Node, init, reboot, []), + ?line receive + {nodedown, Node} -> + ok + after 10000 -> + stop_node(Node), + ?t:fail(not_stopping) + end, + ?t:sleep(5000), + ?line case net_adm:ping(Node) of + pang -> + ok; + _ -> + stop_node(Node), + ?t:fail(system_rebooted) + end, + ?line ?t:timetrap_cancel(Dog), + ok. + +%% ------------------------------------------------ +%% +%% ------------------------------------------------ +get_status(doc) -> []; +get_status(suite) -> []; +get_status(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(10)), + ?line ?t:timetrap_cancel(Dog), + + ?line {Start, _} = init:get_status(), + %% Depending on how the test_server is started Start has + %% different values. staring if test_server started with + %% -s flag. + ?line case lists:member(Start, [started, starting]) of + true -> + ok; + _ -> + ?t:fail(get_status) + end. + +%% ------------------------------------------------ +%% +%% ------------------------------------------------ +script_id(doc) -> []; +script_id(suite) -> []; +script_id(Config) when is_list(Config) -> + ?line Dog = ?t:timetrap(?t:seconds(10)), + + ?line {Name, Vsn} = init:script_id(), + ?line if + list(Name), list(Vsn) -> + ok; + true -> + ?t:fail(not_standard_script) + end, + ?line ?t:timetrap_cancel(Dog), + ok. + +%% ------------------------------------------------ +%% Start the slave system with -boot flag. +%% ------------------------------------------------ +boot(suite) -> [boot1, boot2]. + +boot1(doc) -> []; +boot1(suite) -> {req, [distribution, {local_slave_nodes, 1}, {time, 35}]}; +boot1(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {comment, "Not run on VxWorks"}; + _ -> + ?line Dog = ?t:timetrap(?t:seconds(80)), + Args = args() ++ " -boot start_sasl", + ?line {ok, Node} = start_node(init_test, Args), + ?line stop_node(Node), + + %% Try to start with non existing boot file. + Args1 = args() ++ " -boot dummy_script", + ?line {error, timeout} = start_node(init_test, Args1), + + ?line ?t:timetrap_cancel(Dog), + ok + end. + +boot2(doc) -> []; +boot2(suite) -> {req, [distribution, {local_slave_nodes, 1}, {time, 35}]}; +boot2(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {comment, "Not run on VxWorks"}; + _ -> + ?line Dog = ?t:timetrap(?t:seconds(80)), + + %% Absolute boot file name + Boot = filename:join([code:root_dir(), "bin", "start_sasl"]), + + Args = args() ++ " -boot " ++ Boot, + ?line {ok, Node} = start_node(init_test, Args), + ?line stop_node(Node), + + case os:type() of + {win32, _} -> + %% Absolute boot file name for Windows -- all slashes are + %% converted to backslashes. + Win_boot = lists:map(fun($/) -> $\\; (C) -> C end, + Boot), + Args2 = args() ++ " -boot " ++ Win_boot, + ?line {ok, Node2} = start_node(init_test, Args2), + ?line stop_node(Node2); + _ -> + ok + end, + + ?line ?t:timetrap_cancel(Dog), + ok + end. + +%% Misc. functions + +start_node(Name, Param) -> + ?t:start_node(Name, slave, [{args, Param}]). + +stop_node(Node) -> + ?t:stop_node(Node). + +from(H, [H | T]) -> T; +from(H, [_ | T]) -> from(H, T); +from(_, []) -> []. + +args() -> + "-a kalle -- a b -d -b hej hopp -- c d -b san sa -c 4 5 6 -c 7 8 9". + +long_args(A) -> + lists:flatten( + io_lib:format("-a kalle -- a b -d -b hej hopp -- c " + "~s -b san sa -c 4 5 6 -c 7 8 9", + [A])). + +create_script(Config) -> + ?line PrivDir = ?config(priv_dir,Config), + ?line Name = PrivDir ++ "boot_var_test", + ?line Apps = application_controller:which_applications(), + ?line {value,{_,_,KernelVer}} = lists:keysearch(kernel,1,Apps), + ?line {value,{_,_,StdlibVer}} = lists:keysearch(stdlib,1,Apps), + ?line {ok,Fd} = file:open(Name ++ ".rel", write), + ?line io:format(Fd, + "{release, {\"Test release 3\", \"P2A\"}, \n" + " {erts, \"4.4\"}, \n" + " [{kernel, \"~s\"}, {stdlib, \"~s\"}]}.\n", + [KernelVer,StdlibVer]), + ?line file:close(Fd), + {filename:dirname(Name), filename:basename(Name), + KernelVer, StdlibVer}. + diff --git a/lib/kernel/test/interactive_shell_SUITE.erl b/lib/kernel/test/interactive_shell_SUITE.erl new file mode 100644 index 0000000000..c0db292ba5 --- /dev/null +++ b/lib/kernel/test/interactive_shell_SUITE.erl @@ -0,0 +1,616 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2009. 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(interactive_shell_SUITE). +-include("test_server.hrl"). +-export([all/1, get_columns_and_rows/1, exit_initial/1, job_control_local/1, + job_control_remote/1, + job_control_remote_noshell/1]). + +-export([init_per_testcase/2, end_per_testcase/2]). +%% For spawn +-export([toerl_server/3]). + +init_per_testcase(_Func, Config) -> + Dog = test_server:timetrap(test_server:seconds(60)), + Term = case os:getenv("TERM") of + List when is_list(List) -> + List; + _ -> + "dumb" + end, + os:putenv("TERM","vt100"), + [{watchdog,Dog},{term,Term}|Config]. + +end_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + Term = ?config(term,Config), + os:putenv("TERM",Term), + test_server:timetrap_cancel(Dog). + + +all(suite) -> + [get_columns_and_rows, exit_initial, job_control_local, + job_control_remote, job_control_remote_noshell]. + +%-define(DEBUG,1). +-ifdef(DEBUG). +-define(dbg(Data),erlang:display(Data)). +-else. +-define(dbg(Data),noop). +-endif. + +get_columns_and_rows(suite) -> []; +get_columns_and_rows(doc) -> ["Test that the shell can access columns and rows"]; +get_columns_and_rows(Config) when is_list(Config) -> + ?line rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline,"io:columns()."}, +%% Behaviour change in R12B-5, returns 80 +%% {getline,"{error,enotsup}"}, + {getline,"{ok,80}"}, + {putline,"io:rows()."}, +%% Behaviour change in R12B-5, returns 24 +%% {getline,"{error,enotsup}"} + {getline,"{ok,24}"} + ],[]), + ?line rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline,"io:columns()."}, + {getline,"{ok,90}"}, + {putline,"io:rows()."}, + {getline,"{ok,40}"}], + [], + "stty rows 40; stty columns 90; "). + + + +exit_initial(suite) -> []; +exit_initial(doc) -> ["Tests that exit of initial shell restarts shell"]; +exit_initial(Config) when is_list(Config) -> + ?line rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline,"exit()."}, + {getline,""}, + {getline,"Eshell"}, + {putline,""}, + {putline,"35."}, + {getline,"35"}],[]). + +job_control_local(suite) -> []; +job_control_local(doc) -> [ "Tests that local shell can be " + "started by means of job control" ]; +job_control_local(Config) when is_list(Config) -> + ?line rtnode([{putline,""}, + {putline, "2."}, + {getline, "2"}, + {putline,[7]}, + {sleep,timeout(short)}, + {putline,""}, + {getline," -->"}, + {putline,"s"}, + {putline,"c"}, + {putline_raw,""}, + {getline,"Eshell"}, + {putline_raw,""}, + {getline,"1>"}, + {putline,"35."}, + {getline,"35"}],[]). + +job_control_remote(suite) -> []; +job_control_remote(doc) -> [ "Tests that remote shell can be " + "started by means of job control" ]; +job_control_remote(Config) when is_list(Config) -> + case node() of + nonode@nohost -> + ?line exit(not_distributed); + _ -> + ?line RNode = create_nodename(), + ?line MyNode = atom_to_list(node()), + ?line Pid = spawn_link(fun() -> + receive die -> + ok + end + end), + ?line PidStr = pid_to_list(Pid), + ?line register(kalaskula,Pid), + ?line CookieString = lists:flatten( + io_lib:format("~w", + [erlang:get_cookie()])), + ?line Res = rtnode([{putline,""}, + {putline, "erlang:get_cookie()."}, + {getline, CookieString}, + {putline,[7]}, + {sleep,timeout(short)}, + {putline,""}, + {getline," -->"}, + {putline,"r "++MyNode}, + {putline,"c"}, + {putline_raw,""}, + {getline,"Eshell"}, + {sleep,timeout(short)}, + {putline_raw,""}, + {getline,"("++MyNode++")1>"}, + {putline,"whereis(kalaskula)."}, + {getline,PidStr}, + {sleep,timeout(short)}, % Race, known bug. + {putline_raw,"exit()."}, + {getline,"***"}, + {putline,[7]}, + {putline,""}, + {getline," -->"}, + {putline,"c 1"}, + {putline,""}, + {sleep,timeout(short)}, + {putline_raw,""}, + {getline,"("++RNode++")"}],RNode), + ?line Pid ! die, + ?line Res + end. +job_control_remote_noshell(suite) -> []; +job_control_remote_noshell(doc) -> + [ "Tests that remote shell can be " + "started by means of job control to -noshell node" ]; +job_control_remote_noshell(Config) when is_list(Config) -> + case node() of + nonode@nohost -> + ?line exit(not_distributed); + _ -> + ?line RNode = create_nodename(), + ?line NSNode = start_noshell_node(interactive_shell_noshell), + ?line Pid = spawn_link(NSNode, fun() -> + receive die -> + ok + end + end), + ?line PidStr = rpc:call(NSNode,erlang,pid_to_list,[Pid]), + ?line true = rpc:call(NSNode,erlang,register,[kalaskula,Pid]), + ?line NSNodeStr = atom_to_list(NSNode), + ?line CookieString = lists:flatten( + io_lib:format("~w", + [erlang:get_cookie()])), + ?line Res = rtnode([{putline,""}, + {putline, "erlang:get_cookie()."}, + {getline, CookieString}, + {putline,[7]}, + {sleep,timeout(short)}, + {putline,""}, + {getline," -->"}, + {putline,"r "++NSNodeStr}, + {putline,"c"}, + {putline_raw,""}, + {getline,"Eshell"}, + {sleep,timeout(short)}, + {putline_raw,""}, + {getline,"("++NSNodeStr++")1>"}, + {putline,"whereis(kalaskula)."}, + {getline,PidStr}, + {sleep,timeout(short)}, % Race, known bug. + {putline_raw,"exit()."}, + {getline,"***"}, + {putline,[7]}, + {putline,""}, + {getline," -->"}, + {putline,"c 1"}, + {putline,""}, + {sleep,timeout(short)}, + {putline_raw,""}, + {getline,"("++RNode++")"}],RNode), + ?line Pid ! die, + ?line stop_noshell_node(NSNode), + ?line Res + end. + +rtnode(C,N) -> + rtnode(C,N,[]). +rtnode(Commands,Nodename,ErlPrefix) -> + ?line case get_progs() of + {error,_Reason} -> + ?line {skip,"No runerl present"}; + {RunErl,ToErl,Erl} -> + ?line case create_tempdir() of + {error, Reason2} -> + ?line {skip, Reason2}; + Tempdir -> + ?line SPid = + start_runerl_node(RunErl,ErlPrefix++Erl, + Tempdir,Nodename), + ?line CPid = start_toerl_server(ToErl,Tempdir), + ?line erase(getline_skipped), + ?line Res = + (catch get_and_put(CPid, Commands,1)), + ?line case stop_runerl_node(CPid) of + {error,_} -> + ?line CPid2 = + start_toerl_server + (ToErl,Tempdir), + ?line erase(getline_skipped), + ?line ok = get_and_put + (CPid2, + [{putline,[7]}, + {sleep, + timeout(short)}, + {putline,""}, + {getline," -->"}, + {putline,"s"}, + {putline,"c"}, + {putline,""}],1), + ?line stop_runerl_node(CPid2); + _ -> + ?line ok + end, + ?line wait_for_runerl_server(SPid), + ?line ok = rm_rf(Tempdir), + ?line ok = Res + end + end. + +timeout(long) -> + 2 * timeout(normal); +timeout(short) -> + timeout(normal) div 10; +timeout(normal) -> + 10000 * test_server:timetrap_scale_factor(). + + +start_noshell_node(Name) -> + PADir = filename:dirname(code:which(?MODULE)), + {ok, Node} = test_server:start_node(Name,slave,[{args," -noshell -pa "++ + PADir++" "}]), + Node. +stop_noshell_node(Node) -> + test_server:stop_node(Node). + + +rm_rf(Dir) -> + try + {ok,List} = file:list_dir(Dir), + Files = [filename:join([Dir,X]) || X <- List], + [case file:list_dir(Y) of + {error, enotdir} -> + ok = file:delete(Y); + _ -> + ok = rm_rf(Y) + end || Y <- Files], + ok = file:del_dir(Dir), + ok + catch + _:Exception -> {error, {Exception,Dir}} + end. + + +get_and_put(_CPid,[],_) -> + ok; +get_and_put(CPid, [{sleep, X}|T],N) -> + ?dbg({sleep, X}), + receive + after X -> + get_and_put(CPid,T,N+1) + end; +get_and_put(CPid, [{getline, Match}|T],N) -> + ?dbg({getline, Match}), + CPid ! {self(), {get_line, timeout(normal)}}, + receive + {get_line, timeout} -> + error_logger:error_msg("~p: getline timeout waiting for \"~s\" " + "(command number ~p, skipped: ~p)~n", + [?MODULE, Match,N,get(getline_skipped)]), + {error, timeout}; + {get_line, Data} -> + ?dbg({data,Data}), + case lists:prefix(Match, Data) of + true -> + erase(getline_skipped), + get_and_put(CPid, T,N+1); + false -> + case get(getline_skipped) of + undefined -> + put(getline_skipped,[Data]); + List -> + put(getline_skipped,List ++ [Data]) + end, + get_and_put(CPid, [{getline, Match}|T],N) + end + end; + +get_and_put(CPid, [{putline_raw, Line}|T],N) -> + ?dbg({putline_raw, Line}), + CPid ! {self(), {send_line, Line}}, + Timeout = timeout(normal), + receive + {send_line, ok} -> + get_and_put(CPid, T,N+1) + after Timeout -> + error_logger:error_msg("~p: putline_raw timeout (~p) sending " + "\"~s\" (command number ~p)~n", + [?MODULE, Timeout, Line, N]), + {error, timeout} + end; + +get_and_put(CPid, [{putline, Line}|T],N) -> + ?dbg({putline, Line}), + CPid ! {self(), {send_line, Line}}, + Timeout = timeout(normal), + receive + {send_line, ok} -> + get_and_put(CPid, [{getline, []}|T],N) + after Timeout -> + error_logger:error_msg("~p: putline timeout (~p) sending " + "\"~s\" (command number ~p)~n[~p]~n", + [?MODULE, Timeout, Line, N,get()]), + {error, timeout} + end. + +wait_for_runerl_server(SPid) -> + Ref = erlang:monitor(process, SPid), + Timeout = timeout(long), + receive + {'DOWN', Ref, process, SPid, _} -> + ok + after Timeout -> + {error, timeout} + end. + + + +stop_runerl_node(CPid) -> + Ref = erlang:monitor(process, CPid), + CPid ! {self(), kill_emulator}, + Timeout = timeout(long), + receive + {'DOWN', Ref, process, CPid, noproc} -> + ok; + {'DOWN', Ref, process, CPid, normal} -> + ok; + {'DOWN', Ref, process, CPid, {error, Reason}} -> + {error, Reason} + after Timeout -> + {error, timeout} + end. + +get_progs() -> + case os:type() of + {unix,freebsd} -> + {error,"cant use run_erl on freebsd"}; + {unix,openbsd} -> + {error,"cant use run_erl on openbsd"}; + {unix,_} -> + case os:find_executable("run_erl") of + RE when is_list(RE) -> + case os:find_executable("to_erl") of + TE when is_list(TE) -> + case os:find_executable("erl") of + E when is_list(E) -> + {RE,TE,E}; + _ -> + {error, "Could not find erl command"} + end; + _ -> + {error, "Could not find to_erl command"} + end; + _ -> + {error, "Could not find run_erl command"} + end; + _ -> + {error, "Not a unix OS"} + end. + +create_tempdir() -> + create_tempdir(filename:join(["/tmp","rtnode"++os:getpid()]),$A). + +create_tempdir(Dir,X) when X > $Z, X < $a -> + create_tempdir(Dir,$a); +create_tempdir(Dir,X) when X > $z -> + Estr = lists:flatten( + io_lib:format("Unable to create ~s, reason eexist", + [Dir++[$z]])), + {error, Estr}; +create_tempdir(Dir0, Ch) -> + % Expect fairly standard unix. + Dir = Dir0++[Ch], + case file:make_dir(Dir) of + {error, eexist} -> + create_tempdir(Dir0, Ch+1); + {error, Reason} -> + Estr = lists:flatten( + io_lib:format("Unable to create ~s, reason ~p", + [Dir,Reason])), + {error,Estr}; + ok -> + Dir + end. + +create_nodename() -> + create_nodename($A). + +create_nodename(X) when X > $Z, X < $a -> + create_nodename($a); +create_nodename(X) when X > $z -> + {error,out_of_nodenames}; +create_nodename(X) -> + NN = "rtnode"++os:getpid()++[X], + case file:read_file_info(filename:join(["/tmp",NN])) of + {error,enoent} -> + Host = lists:nth(2,string:tokens(atom_to_list(node()),"@")), + NN++"@"++Host; + _ -> + create_nodename(X+1) + end. + + +start_runerl_node(RunErl,Erl,Tempdir,Nodename) -> + XArg = case Nodename of + [] -> + []; + _ -> + " -sname "++(if is_atom(Nodename) -> atom_to_list(Nodename); + true -> Nodename + end)++ + " -setcookie "++atom_to_list(erlang:get_cookie()) + end, + spawn(fun() -> + os:cmd(RunErl++" "++Tempdir++"/ "++Tempdir++" \""++ + Erl++XArg++"\"") + end). + +start_toerl_server(ToErl,Tempdir) -> + Pid = spawn(?MODULE,toerl_server,[self(),ToErl,Tempdir]), + receive + {Pid,started} -> + Pid; + {Pid,error,Reason} -> + {error,Reason} + end. + +try_to_erl(_Command, 0) -> + {error, cannot_to_erl}; +try_to_erl(Command, N) -> + ?dbg({?LINE,N}), + Port = open_port({spawn, Command},[eof,{line,1000}]), + Timeout = timeout(normal) div 2, + receive + {Port, eof} -> + receive after Timeout -> + ok + end, + try_to_erl(Command, N-1) + after Timeout -> + ?dbg(Port), + Port + end. + +toerl_server(Parent,ToErl,Tempdir) -> + Port = try_to_erl(ToErl++" "++Tempdir++"/ 2>/dev/null",8), + case Port of + P when is_port(P) -> + Parent ! {self(),started}; + {error,Other} -> + Parent ! {self(),error,Other}, + exit(Other) + end, + case toerl_loop(Port,[]) of + normal -> + ok; + {error, Reason} -> + error_logger:error_msg("toerl_server exit with reason ~p~n", + [Reason]), + exit(Reason) + end. + +toerl_loop(Port,Acc) -> + ?dbg({toerl_loop, Port, Acc}), + receive + {Port,{data,{Tag0,Data}}} when is_port(Port) -> + ?dbg({?LINE,Port,{data,{Tag0,Data}}}), + case Acc of + [{noeol,Data0}|T0] -> + toerl_loop(Port,[{Tag0, Data0++Data}|T0]); + _ -> + toerl_loop(Port,[{Tag0,Data}|Acc]) + end; + {Pid,{get_line,Timeout}} -> + case Acc of + [] -> + case get_data_within(Port,Timeout,[]) of + timeout -> + Pid ! {get_line, timeout}, + toerl_loop(Port,[]); + {noeol,Data1} -> + Pid ! {get_line, timeout}, + toerl_loop(Port,[{noeol,Data1}]); + {eol,Data2} -> + Pid ! {get_line, Data2}, + toerl_loop(Port,[]) + end; + [{noeol,Data3}] -> + case get_data_within(Port,Timeout,Data3) of + timeout -> + Pid ! {get_line, timeout}, + toerl_loop(Port,Acc); + {noeol,Data4} -> + Pid ! {get_line, timeout}, + toerl_loop(Port,[{noeol,Data4}]); + {eol,Data5} -> + Pid ! {get_line, Data5}, + toerl_loop(Port,[]) + end; + List -> + {NewAcc,[{eol,Data6}]} = lists:split(length(List)-1,List), + Pid ! {get_line,Data6}, + toerl_loop(Port,NewAcc) + end; + {Pid, {send_line, Data7}} -> + Port ! {self(),{command, Data7++"\n"}}, + Pid ! {send_line, ok}, + toerl_loop(Port,Acc); + {_Pid, kill_emulator} -> + Port ! {self(),{command, "init:stop().\n"}}, + Timeout1 = timeout(long), + receive + {Port,eof} -> + normal + after Timeout1 -> + {error, kill_timeout} + end; + {Port, eof} -> + {error, unexpected_eof}; + Other -> + {error, {unexpected, Other}} + end. + +millistamp() -> + {Mega, Secs, Micros} = erlang:now(), + (Micros div 1000) + Secs * 1000 + Mega * 1000000000. + +get_data_within(Port, X, Acc) when X =< 0 -> + ?dbg({get_data_within, X, Acc, ?LINE}), + receive + {Port,{data,{Tag0,Data}}} -> + ?dbg({?LINE,Port,{data,{Tag0,Data}}}), + {Tag0, Acc++Data} + after 0 -> + case Acc of + [] -> + timeout; + Noeol -> + {noeol,Noeol} + end + end; + + +get_data_within(Port, Timeout, Acc) -> + ?dbg({get_data_within, Timeout, Acc, ?LINE}), + T1 = millistamp(), + receive + {Port,{data,{noeol,Data}}} -> + ?dbg({?LINE,Port,{data,{noeol,Data}}}), + Elapsed = millistamp() - T1 + 1, + get_data_within(Port, Timeout - Elapsed, Acc ++ Data); + {Port,{data,{eol,Data1}}} -> + ?dbg({?LINE,Port,{data,{eol,Data1}}}), + {eol, Acc ++ Data1} + after Timeout -> + timeout + end. + + + + diff --git a/lib/kernel/test/kernel.cover b/lib/kernel/test/kernel.cover new file mode 100644 index 0000000000..228dafc565 --- /dev/null +++ b/lib/kernel/test/kernel.cover @@ -0,0 +1,4 @@ +%% -*- erlang -*- +{exclude,all}. +{include,[gen_udp,inet6_udp,inet_res,inet_dns]}. + diff --git a/lib/kernel/test/kernel.dynspec b/lib/kernel/test/kernel.dynspec new file mode 100644 index 0000000000..297a7c71ea --- /dev/null +++ b/lib/kernel/test/kernel.dynspec @@ -0,0 +1,57 @@ +%% -*- erlang -*- +%% You can test this file using this command. +%% file:script("kernel.dynspec", [{'Os',"Unix"}]). + +case Os of + "VxWorks" -> + FsCantHandle = "VxWorks filesystem can't handle this", + FsOverload = "VxWorks filesystem would overload", + CantHandle = "VxWorks can't handle this", + SlaveMisadaption = "Test not adopted to slaves on different machine", + [{skip,{application_SUITE, + "VxWorks: requires manual testing "++ + "(requires multiple nodes (OTP-1774))"}}, + {skip,{bif_SUITE, spawn_link_race1, "Known bug."}}, + {skip,{erl_distribution_SUITE, "VxWorks: More vx nodes needed"}}, + {skip,{file_SUITE,read_write_file,FsCantHandle}}, + {skip,{file_SUITE,cur_dir_0,FsCantHandle}}, + {skip,{file_SUITE,open1,FsCantHandle}}, + {skip,{file_SUITE,file_info_times,FsCantHandle}}, + {skip,{file_SUITE,file_write_file_info,FsCantHandle}}, + {skip,{file_SUITE,truncate,FsCantHandle}}, + {skip,{file_SUITE,rename,FsCantHandle}}, + {skip,{file_SUITE,e_delete,FsCantHandle}}, + {skip,{file_SUITE,e_rename,FsCantHandle}}, + {skip,{file_SUITE,delayed_write,FsCantHandle}}, + {skip,{file_SUITE,read_ahead,FsCantHandle}}, + {skip,{file_SUITE,segment_write,FsOverload}}, + {skip,{file_SUITE,segment_read,FsOverload}}, + {skip,{file_SUITE,compress_errors,FsCantHandle}}, + {skip,{global_SUITE, + "To heavy on slavenodes for VxWorks (and more)."}}, + {skip,{global_group_SUITE, "To heavy on slavenodes for VxWorks."}}, + {skip,{heart_SUITE, "Not for VxWorks heart, it's special"}}, + {skip,{init_SUITE,restart,"Uses peer nodes"}}, + {skip,{kernel_config_SUITE, "VxWorks does not support slave nodes"}}, + {skip,{os_SUITE,space_in_cwd,CantHandle}}, + {skip,{os_SUITE,space_in_name,CantHandle}}, + {skip,{os_SUITE,quoting,CantHandle}}, + {skip,{prim_file_SUITE,open1,FsCantHandle}}, + {skip,{prim_file_SUITE,compress_errors,FsCantHandle}}, + {skip,{seq_trace_SUITE,distributed_recv,SlaveMisadaption}}, + {skip,{seq_trace_SUITE,distributed_exit,SlaveMisadaption}}]; + _ -> + [] +end ++ +try gen_sctp:open() of + {ok,Socket} -> + gen_sctp:close(Socket), + []; + _ -> + [] +catch + error:badarg -> + [{skip,{gen_sctp_SUITE,"SCTP not supported on this machine"}}]; + _:_ -> + [] +end. diff --git a/lib/kernel/test/kernel_SUITE.erl b/lib/kernel/test/kernel_SUITE.erl new file mode 100644 index 0000000000..225bc38b05 --- /dev/null +++ b/lib/kernel/test/kernel_SUITE.erl @@ -0,0 +1,61 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. 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% +%% +%%%---------------------------------------------------------------- +%%% Kernel application test suite. +%%%----------------------------------------------------------------- +-module(kernel_SUITE). +-include("test_server.hrl"). + + +% Default timetrap timeout (set in init_per_testcase). +-define(default_timeout, ?t:minutes(1)). + +% Test server specific exports +-export([all/1]). +-export([init_per_testcase/2, fin_per_testcase/2]). + +% Test cases must be exported. +-export([app_test/1]). + +%% +%% all/1 +%% +all(doc) -> + []; +all(suite) -> + [app_test]. + +init_per_testcase(_Case, Config) -> + ?line Dog=test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. +fin_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +% +% Test cases starts here. +% +app_test(doc) -> + ["Tests the applications consistency."]; +app_test(suite) -> + []; +app_test(Config) when list(Config) -> + ?line ok=?t:app_test(kernel), + ok. diff --git a/lib/kernel/test/kernel_config_SUITE.erl b/lib/kernel/test/kernel_config_SUITE.erl new file mode 100644 index 0000000000..6b7d788e60 --- /dev/null +++ b/lib/kernel/test/kernel_config_SUITE.erl @@ -0,0 +1,107 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2009. 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(kernel_config_SUITE). + +-include("test_server.hrl"). + +-export([all/1, sync/1]). + +-export([init/1, fini/1]). + +all(suite) -> + [{conf, init, [sync], fini}]. + +init(doc) -> []; +init(suite) -> []; +init(Config) when is_list(Config) -> + Config. + +fini(doc) -> []; +fini(suite) -> []; +fini(Config) when is_list(Config) -> + stop_node(init_test), + Config. + +config(Fd) -> + M = from($@, atom_to_list(node())), + io:format(Fd, "[{kernel, [{sync_nodes_optional, ['cp1@~s','cp2@~s']}," + "{sync_nodes_timeout, 15000}]}].~n", + [M, M]). + +from(H, [H | T]) -> T; +from(H, [_ | T]) -> from(H, T); +from(_, []) -> []. + +%%----------------------------------------------------------------- +%% Test suite for sync_nodes. This is quite tricky. +%% +%% Should be started in a CC view with: +%% erl -sname XXX where XX not in [cp1, cp2] +%%----------------------------------------------------------------- +sync(doc) -> []; +sync(suite) -> []; +sync(Conf) when list(Conf) -> + ?line Dog = ?t:timetrap(?t:seconds(120)), + % Write a config file + Dir = ?config(priv_dir,Conf), + {ok, Fd} = file:open(Dir ++ "sys.config", [write]), + config(Fd), + file:close(Fd), + Config = Dir ++ "sys", + + %% Reset wall_clock + {T1,_} = erlang:statistics(wall_clock), + io:format("~p~n", [{t1, T1}]), + ?line Command = lists:concat([lib:progname(), + " -detached -sname cp1 ", + "-config ", Config, + " -env ERL_CRASH_DUMP erl_crash_dump.cp1"]), + io:format("Command: ~s", [Command]), + ?line open_port({spawn, Command}, [stream]), + io:format("started~n"), + ?line ?t:sleep(12000), + io:format("waited12~n"), + ?line Host = from($@, atom_to_list(node())), + ?line Cp1 = list_to_atom("cp1@"++Host), + ?line wait_for_node(Cp1), + io:format("waitednode~n"), + %% Check time since last call + ?line {TT, T} = erlang:statistics(wall_clock), + io:format("~p~n", [{t2, {TT, T}}]), + ?line stop_node(cp1), + if + TT-T1 < 15000 -> ?line ?t:fail({too_short_time, TT-T1}); + true -> ok + end, + ?line ?t:timetrap_cancel(Dog), + ok. + +wait_for_node(Node) -> + case rpc:call(Node, init, get_status, []) of + {started,_} -> ok; + {badrpc, R} -> ?line ?t:fail({rpc_failed, R}); + _Other -> wait_for_node(Node) + end. + + +stop_node(Node) -> + M = list_to_atom(lists:concat([Node, + [$@], + from($@,atom_to_list(node()))])), + rpc:cast(M, erlang, halt, []). diff --git a/lib/kernel/test/loose_node.erl b/lib/kernel/test/loose_node.erl new file mode 100644 index 0000000000..ac1ddb8d9a --- /dev/null +++ b/lib/kernel/test/loose_node.erl @@ -0,0 +1,193 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2004-2009. 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% +%% + +%%%------------------------------------------------------------------- +%%% File : loose_node.erl +%%% Author : Rickard Green <[email protected]> +%%% Description : Creation of nodes which are not supervised by +%%% the test_server. Currently needed by init_SUITE +%%% and heart_SUITE (until the test_server can +%%% handle node restart). +%%% +%%% Created : 22 Sep 2004 by Rickard Green <[email protected]> +%%%------------------------------------------------------------------- +-module(loose_node). +-author('[email protected]'). + +%% +%% Exports +%% +-export([start/3, start/2, stop/1]). + +%% +%% Internal exports +%% +-export([loose_node_started/1]). + +%% +%% Exported functions for internal use. +%% + +%% +%% Defines +%% +-define(L2A, list_to_atom). +-define(A2L, atom_to_list). +-define(I2L, integer_to_list). + +%% +%% Exported functions. +%% + +stop(Node) when atom(Node) -> + rpc:cast(Node, erlang, halt, []), + io:format("Stopped loose node ~p~n", [Node]), + ok. + +start(Name, Args) -> + start(Name, Args, -1). + +start(Name, Args, TimeOut) when atom(Name) -> + start(atom_to_list(Name), Args, TimeOut); +start(Name, Args, TimeOut) when list(Name), list(Args), integer(TimeOut) -> + Parent = self(), + Ref = make_ref(), + Starter + = fun () -> + Erl = case init:get_argument(progname) of + {ok,[[Prog]]} -> + Prog; + _ -> + "erl" + end, + RegName = until_success(fun () -> + {A, B, C} = now(), + Reg = + ?L2A(?A2L(?MODULE) + ++ "-" ++ ?I2L(A) + ++ "-" ++ ?I2L(B) + ++ "-" ++ ?I2L(C)), + true = register(Reg, self()), + Reg + end), + NameCmd = case net_kernel:longnames() of + true -> " -name " ++ Name; + false -> " -sname " ++ Name + end, + Cookie = " -setcookie " ++ atom_to_list(auth:get_cookie()), + Pa = " -pa " ++ filename:dirname(code:which(?MODULE)), + ThisNode = node(), + NodeStarted + = " -run " + ++ atom_to_list(?MODULE) + ++ " loose_node_started " + ++ atom_to_list(RegName) + ++ " " + ++ atom_to_list(ThisNode) + ++ " " + ++ integer_to_list(TimeOut), + CrashDump = + " -env ERL_CRASH_DUMP" + ++ " erl_crash.dump.loose_node." + ++ Name, + Cmd = + Erl + ++ " -detached" + ++ NameCmd + ++ Cookie + ++ Pa + ++ NodeStarted + ++ CrashDump + ++ " " + ++ Args, + io:format("Trying to start loose node...~n" + " --> ~p~n", [Cmd]), + Res = case open_port({spawn, Cmd}, []) of + P when port(P) -> + receive + {loose_node_started, + Node, + {RegName, ThisNode}} -> + io:format("Loose node ~p started.~n", + [Node]), + {ok, Node} + after 10000 -> + io:format("Start of loose node ~p " + "timed out.", [Name]), + {error, timeout} + end; + _ -> + io:format("Start of loose node ~p failed.", + [Name]), + {error, open_port_failed} + end, + Parent ! {Ref, Res} + end, + spawn_opt(Starter, [link, {priority, max}]), + receive + {Ref, Result} -> + Result + end. + + +%% +%% Exported functions for internal use. +%% + +loose_node_started([Name, Node, TimeOutSecs]) when list(Name), + list(Node), + list(TimeOutSecs) -> + spawn_opt(fun () -> + process_flag(trap_exit, true), + Proc = {list_to_atom(Name), list_to_atom(Node)}, + Timeout = case catch list_to_integer(TimeOutSecs) of + I when integer(I), I >= 0 -> I*1000; + _ -> infinity + end, + wait_until(fun () -> is_alive() end), + Proc ! {loose_node_started, node(), Proc}, + receive + after Timeout -> + timeout + end, + erlang:halt("Loose node timeout") + end, + [{priority, max}]), + ok. + +%% +%% Internal functions. +%% + +until_success(Fun) -> + case catch Fun() of + {'EXIT', _} -> until_success(Fun); + Res -> Res + end. + +wait_until(Fun) -> + case Fun() of + true -> true; + _ -> + receive + after 100 -> + wait_until(Fun) + end + end. + diff --git a/lib/kernel/test/myApp.app b/lib/kernel/test/myApp.app new file mode 100644 index 0000000000..62959545e3 --- /dev/null +++ b/lib/kernel/test/myApp.app @@ -0,0 +1,7 @@ + {application, myApp, + [{description, "Test of start phase"}, + {id, "CXC 138 38"}, + {applications, [kernel]}, + {included_applications, []}, + {start_phases, [{init, [initArgs]}, {go, [goArgs]}]}, + {mod, {myApp, {myApp, 1, 3}} }]}. diff --git a/lib/kernel/test/myApp.erl b/lib/kernel/test/myApp.erl new file mode 100644 index 0000000000..2b92046141 --- /dev/null +++ b/lib/kernel/test/myApp.erl @@ -0,0 +1,48 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(myApp). +-behaviour(supervisor). + +%% External exports +-export([start/2, stop/1, start_phase/3]). + +%% Internal exports +-export([init/1]). + +start(_Type, {_AppN, Low, High}) -> + Name = list_to_atom(lists:concat([ch_sup, Low])), + {ok,P} = supervisor:start_link({local, Name}, ch_sup, + lists:seq(Low, High)), + {ok, P, []}. + +stop(_) -> ok. + +init(Nos) -> + SupFlags = {one_for_one, 12, 60}, + Chs = lists:map(fun(No) -> + {list_to_atom(lists:concat([ch,No])), + {ch, start_link, [{ch, No}]}, + permanent, 2000, worker, [ch]} + end, + Nos), + {ok, {SupFlags, Chs}}. + +start_phase(Phase, _Type, _Args) -> + (catch global:send(start_phase,{sp, Phase})), + ok. diff --git a/lib/kernel/test/os_SUITE.erl b/lib/kernel/test/os_SUITE.erl new file mode 100644 index 0000000000..667f267079 --- /dev/null +++ b/lib/kernel/test/os_SUITE.erl @@ -0,0 +1,212 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1997-2009. 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(os_SUITE). + +-export([all/1]). +-export([space_in_cwd/1, quoting/1, space_in_name/1, bad_command/1, + find_executable/1, unix_comment_in_command/1]). + +-include("test_server.hrl"). + +all(suite) -> + [space_in_cwd, quoting, space_in_name, bad_command, find_executable, + unix_comment_in_command]. + +space_in_cwd(doc) -> + "Test that executing a command in a current working directory " + "with space in its name works."; +space_in_cwd(suite) -> []; +space_in_cwd(Config) when list(Config) -> + ?line PrivDir = ?config(priv_dir, Config), + ?line Dirname = filename:join(PrivDir, "cwd with space"), + ?line ok = file:make_dir(Dirname), + ?line ok = file:set_cwd(Dirname), + + %% Using `more' gives the almost the same result on both Unix and Windows. + + Cmd = case os:type() of + {win32, _} -> + "more"; + {unix, _} -> + "more </dev/null" + end, + + ?line case os:cmd(Cmd) of + [] -> ok; % Unix. + "\r\n" -> ok; % Windows. + Other -> + ?line test_server:fail({unexpected, Other}) + end, + + ?t:sleep(5), + ?line [] = receive_all(), + ok. + +quoting(doc) -> "Test that various ways of quoting arguments work."; +quoting(suite) -> []; +quoting(Config) when list(Config) -> + ?line DataDir = ?config(data_dir, Config), + ?line Echo = filename:join(DataDir, "my_echo"), + + ?line comp("one", os:cmd(Echo ++ " one")), + ?line comp("one::two", os:cmd(Echo ++ " one two")), + ?line comp("one two", os:cmd(Echo ++ " \"one two\"")), + ?line comp("x::one two::y", os:cmd(Echo ++ " x \"one two\" y")), + ?line comp("x::one two", os:cmd(Echo ++ " x \"one two\"")), + ?line comp("one two::y", os:cmd(Echo ++ " \"one two\" y")), + ?line comp("x::::y", os:cmd(Echo ++ " x \"\" y")), + ?t:sleep(5), + ?line [] = receive_all(), + ok. + +space_in_name(doc) -> + "Test that program with a space in its name can be executed."; +space_in_name(suite) -> []; +space_in_name(Config) when list(Config) -> + ?line PrivDir = ?config(priv_dir, Config), + ?line DataDir = ?config(data_dir, Config), + ?line Spacedir = filename:join(PrivDir, "program files"), + Ext = case os:type() of + {win32,_} -> ".exe"; + _ -> "" + end, + ?line OrigEcho = filename:join(DataDir, "my_echo" ++ Ext), + ?line Echo0 = filename:join(Spacedir, "my_echo" ++ Ext), + + %% Copy the `my_echo' program to a directory whose name contains a space. + + ?line ok = file:make_dir(Spacedir), + ?line {ok, Bin} = file:read_file(OrigEcho), + ?line ok = file:write_file(Echo0, Bin), + ?line Echo = filename:nativename(Echo0), + ?line ok = file:change_mode(Echo, 8#777), % Make it executable on Unix. + + %% Run the echo program. + + ?line comp("", os:cmd("\"" ++ Echo ++ "\"")), + ?line comp("a::b::c", os:cmd("\"" ++ Echo ++ "\" a b c")), + ?t:sleep(5), + ?line [] = receive_all(), + ok. + +bad_command(doc) -> + "Check that a bad command doesn't crasch the server or the emulator (it used to)."; +bad_command(suite) -> []; +bad_command(Config) when list(Config) -> + ?line catch os:cmd([a|b]), + ?line catch os:cmd({bad, thing}), + + %% This should at least not crash (on Unix it typically returns + %% a message from the shell). + ?line os:cmd("xxxxx"), + + ok. + +find_executable(suite) -> []; +find_executable(doc) -> []; +find_executable(Config) when list(Config) -> + case os:type() of + {win32, _} -> + ?line DataDir = filename:join(?config(data_dir, Config), "win32"), + ?line ok = file:set_cwd(filename:join([DataDir, "current"])), + ?line Bin = filename:join(DataDir, "bin"), + ?line Abin = filename:join(DataDir, "abin"), + ?line UsrBin = filename:join([DataDir, "usr", "bin"]), + ?line {ok, Current} = file:get_cwd(), + + ?line Path = lists:concat([Bin, ";", Abin, ";", UsrBin]), + ?line io:format("Path = ~s", [Path]), + + %% Search for programs in Bin (second element in PATH). + ?line find_exe(Abin, "my_ar", ".exe", Path), + ?line find_exe(Abin, "my_ascii", ".com", Path), + ?line find_exe(Abin, "my_adb", ".bat", Path), + + %% Search for programs in Abin (second element in PATH). + ?line find_exe(Abin, "my_ar", ".exe", Path), + ?line find_exe(Abin, "my_ascii", ".com", Path), + ?line find_exe(Abin, "my_adb", ".bat", Path), + + %% Search for programs in the current working directory. + ?line find_exe(Current, "my_program", ".exe", Path), + ?line find_exe(Current, "my_command", ".com", Path), + ?line find_exe(Current, "my_batch", ".bat", Path), + ok; + {unix, _} -> + ok; + vxworks -> + ok + end. + +find_exe(Where, Name, Ext, Path) -> + Expected = filename:join(Where, Name++Ext), + case os:find_executable(Name, Path) of + Expected -> + ok; + Name when list(Name) -> + case filename:absname(Name) of + Expected -> + ok; + Other -> + io:format("Expected ~p; got (converted to absolute) ~p", + [Expected, Other]), + test_server:fail() + end; + Other -> + io:format("Expected ~p; got ~p", [Expected, Other]), + test_server:fail() + end. + +unix_comment_in_command(doc) -> + "OTP-1805: Test that os:cmd(\"ls #\") works correctly (used to hang)."; +unix_comment_in_command(suite) -> []; +unix_comment_in_command(Config) when list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(20)), + ?line Priv = ?config(priv_dir, Config), + ?line ok = file:set_cwd(Priv), + ?line _ = os:cmd("ls #"), % Any result is ok. + ?t:sleep(5), + ?line [] = receive_all(), + ?line test_server:timetrap_cancel(Dog), + ok. + + +comp(Expected, Got) -> + case strip_nl(Got) of + Expected -> + ok; + Other -> + ok = io:format("Expected: ~s\n", [Expected]), + ok = io:format("Got: ~s\n", [Other]), + test_server:fail() + end. + +%% Like lib:nonl/1, but strips \r as well as \n. + +strip_nl([$\r, $\n]) -> []; +strip_nl([$\n]) -> []; +strip_nl([H|T]) -> [H|strip_nl(T)]; +strip_nl([]) -> []. + +receive_all() -> + receive + X -> [X|receive_all()] + after 0 -> [] + end. + diff --git a/lib/kernel/test/os_SUITE_data/Makefile.src b/lib/kernel/test/os_SUITE_data/Makefile.src new file mode 100644 index 0000000000..912d0cbcb1 --- /dev/null +++ b/lib/kernel/test/os_SUITE_data/Makefile.src @@ -0,0 +1,14 @@ +CC = @CC@ +LD = @LD@ +CFLAGS = @CFLAGS@ -I@erl_include@ @DEFS@ +CROSSLDFLAGS = @CROSSLDFLAGS@ + +PROGS = my_echo@exe@ + +all: $(PROGS) + +my_echo@exe@: my_echo@obj@ + $(LD) $(CROSSLDFLAGS) -o my_echo my_echo@obj@ @LIBS@ + +my_echo@obj@: my_echo.c + $(CC) -c -o my_echo@obj@ $(CFLAGS) my_echo.c diff --git a/lib/kernel/test/os_SUITE_data/my_echo.c b/lib/kernel/test/os_SUITE_data/my_echo.c new file mode 100644 index 0000000000..2127511dd1 --- /dev/null +++ b/lib/kernel/test/os_SUITE_data/my_echo.c @@ -0,0 +1,19 @@ +#include <stdio.h> + +int +main(int argc, char** argv) +{ + char* sep = ""; + + /* + * Echo all arguments separated with '::', so that we can check that + * quotes are interpreted correctly. + */ + + while (argc-- > 1) { + printf("%s%s", sep, argv++[1]); + sep = "::"; + } + putchar('\n'); + return 0; +} diff --git a/lib/kernel/test/os_SUITE_data/unix/.gitignore b/lib/kernel/test/os_SUITE_data/unix/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/kernel/test/os_SUITE_data/unix/.gitignore diff --git a/lib/kernel/test/os_SUITE_data/win32/abin/hello.exe b/lib/kernel/test/os_SUITE_data/win32/abin/hello.exe Binary files differnew file mode 100755 index 0000000000..631d40ccaf --- /dev/null +++ b/lib/kernel/test/os_SUITE_data/win32/abin/hello.exe diff --git a/lib/kernel/test/os_SUITE_data/win32/abin/my_adb.bat b/lib/kernel/test/os_SUITE_data/win32/abin/my_adb.bat new file mode 100644 index 0000000000..a633f83ea5 --- /dev/null +++ b/lib/kernel/test/os_SUITE_data/win32/abin/my_adb.bat @@ -0,0 +1,2 @@ +@echo off +echo A real batch file. diff --git a/lib/kernel/test/os_SUITE_data/win32/abin/my_ar.exe b/lib/kernel/test/os_SUITE_data/win32/abin/my_ar.exe new file mode 100644 index 0000000000..49d0d254c0 --- /dev/null +++ b/lib/kernel/test/os_SUITE_data/win32/abin/my_ar.exe @@ -0,0 +1 @@ +Not really an EXE file. diff --git a/lib/kernel/test/os_SUITE_data/win32/abin/my_ascii.com b/lib/kernel/test/os_SUITE_data/win32/abin/my_ascii.com Binary files differnew file mode 100644 index 0000000000..7c7f5729d5 --- /dev/null +++ b/lib/kernel/test/os_SUITE_data/win32/abin/my_ascii.com diff --git a/lib/kernel/test/os_SUITE_data/win32/bin/.gitignore b/lib/kernel/test/os_SUITE_data/win32/bin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/kernel/test/os_SUITE_data/win32/bin/.gitignore diff --git a/lib/kernel/test/os_SUITE_data/win32/current/my_batch.bat b/lib/kernel/test/os_SUITE_data/win32/current/my_batch.bat new file mode 100644 index 0000000000..a633f83ea5 --- /dev/null +++ b/lib/kernel/test/os_SUITE_data/win32/current/my_batch.bat @@ -0,0 +1,2 @@ +@echo off +echo A real batch file. diff --git a/lib/kernel/test/os_SUITE_data/win32/current/my_command.com b/lib/kernel/test/os_SUITE_data/win32/current/my_command.com new file mode 100644 index 0000000000..847d9fe544 --- /dev/null +++ b/lib/kernel/test/os_SUITE_data/win32/current/my_command.com @@ -0,0 +1 @@ +Not a real COM file. diff --git a/lib/kernel/test/os_SUITE_data/win32/current/my_program.exe b/lib/kernel/test/os_SUITE_data/win32/current/my_program.exe new file mode 100644 index 0000000000..90bbf20b8b --- /dev/null +++ b/lib/kernel/test/os_SUITE_data/win32/current/my_program.exe @@ -0,0 +1 @@ +Not a real EXE file. diff --git a/lib/kernel/test/os_SUITE_data/win32/usr/bin/.gitignore b/lib/kernel/test/os_SUITE_data/win32/usr/bin/.gitignore new file mode 100644 index 0000000000..e69de29bb2 --- /dev/null +++ b/lib/kernel/test/os_SUITE_data/win32/usr/bin/.gitignore diff --git a/lib/kernel/test/pdict_SUITE.erl b/lib/kernel/test/pdict_SUITE.erl new file mode 100644 index 0000000000..6aa434b614 --- /dev/null +++ b/lib/kernel/test/pdict_SUITE.erl @@ -0,0 +1,323 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1999-2009. 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(pdict_SUITE). +%% NB: The ?line macro cannot be used when testing the dictionary. + + +-include("test_server.hrl"). + +-define(M(A,B),m(A,B,?MODULE,?LINE)). +-ifdef(DEBUG). +-define(DEBUGF(A,B), io:format(A,B)). +-else. +-define(DEBUGF(A,B), noop). +-endif. + +-export([all/1, + simple/1, complicated/1, heavy/1, info/1]). +-export([init_per_testcase/2, fin_per_testcase/2]). +-export([other_process/2]). + +init_per_testcase(_Case, Config) -> + ?line Dog = ?t:timetrap(test_server:minutes(10)), + [{watchdog, Dog} | Config]. +fin_per_testcase(_Case, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +all(suite) -> + [simple, complicated, heavy, info]. + +simple(doc) -> + ["Tests simple functionality in process dictionary."]; +simple(suite) -> + []; +simple(Config) when list(Config) -> + XX = get(), + erase(), + L = [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p, + q,r,s,t,u,v,x,y,z,'A','B','C','D'], + ins_list_0(L), + ins_list_1(L), + L2 = lists:keysort(1, lists:map(fun(X) -> + {X, atom_to_list(X)} + end, + L)), + ?DEBUGF("~p~n",[L2]), + ?M(L2,lists:keysort(1, get())), + ins_list_2(L), + L3 = lists:keysort(1, lists:map(fun(X) -> + {hd(atom_to_list(X)) - $a, + atom_to_list(X)} + end, + L) ++ L2), + ?DEBUGF("~p~n",[L3]), + ?M(L3, lists:keysort(1, get())), + L4 = lists:map(fun(X) -> + lists:sort(get_keys(atom_to_list(X))) + end, + L), + ?DEBUGF("~p~n",[L4]), + ?M(L4,lists:map(fun(X) -> + lists:sort([X, hd(atom_to_list(X)) - $a]) + end, + L)), + erase(), + ?M([],get()), + [put(Key, Value) || {Key,Value} <- XX], + ok. + +complicated(Config) when is_list(Config) -> + Previous = get(), + Previous = erase(), + N = case ?t:is_debug() of + false -> 500000; + true -> 5000 + end, + comp_1(N), + comp_2(N), + N = comp_3(lists:sort(get()), 1), + comp_4(get()), + [] = get(), + [put(Key, Value) || {Key,Value} <- Previous], + ok. + +comp_1(0) -> ok; +comp_1(N) -> + undefined = put({key,N}, {value,N}), + comp_1(N-1). + +comp_2(0) -> ok; +comp_2(N) -> + {value,N} = put({key,N}, {value,N*N}), + comp_2(N-1). + +comp_3([{{key,K},{value,V}}], K) when V =:= K*K -> + K; +comp_3([{{key,K},{value,V}}|T], K) when V =:= K*K -> + comp_3(T, K+1). + +comp_4([{{key,_}=K,{value,_}=Val}|T]) -> + Val = erase(K), + comp_4(T); +comp_4([]) -> ok. + +heavy(doc) -> + ["Tests heavy usage of the process dictionary"]; +heavy(suite) -> + []; +heavy(Config) when is_list(Config) -> + XX = get(), + erase(), + time(50), + ?M([],get()), + time(500), + ?M([],get()), + time(5000), + ?M([],get()), + case {os:type(),?t:is_debug()} of + {vxworks,_} -> ok; + {_,true} -> ok; + _ -> + time(50000), + ?M([], get()) + end, + [put(Key, Value) || {Key,Value} <- XX], + ok. + +info(doc) -> + ["Tests process_info(Pid, dictionary)"]; +info(suite) -> + []; +info(Config) when list(Config) -> + L = [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p, + q,r,s,t,u,v,x,y,z,'A','B','C','D'], + process_flag(trap_exit,true), + Pid = spawn_link(?MODULE, other_process, [L,self()]), + Dict = receive + {Pid, D} -> + D + end, + ?M({dictionary, Dict}, process_info(Pid, dictionary)), + Pid ! bye, + receive + {'EXIT', Pid, _} -> + ok + end, + ok. + +other_process(List,From) -> + erase(), + ins_list_1(List), + From ! {self(), get()}, + receive + bye -> + ok + end. + +ins_list_2([]) -> + done; +ins_list_2([H|T]) -> + X = {hd(atom_to_list(H)) - $a, atom_to_list(H)}, + _Y = put(element(1,X), element(2,X)), + ?DEBUGF("Inserting ~w: ~w~n",[X,_Y]), + ins_list_2(T). + +ins_list_1([]) -> + done; +ins_list_1([H|T]) -> + X = {H, atom_to_list(H)}, + _Y = put(element(1,X), element(2,X)), + ?DEBUGF("Inserting ~w: ~w~n",[X,_Y]), + ins_list_1(T). + +ins_list_0([]) -> + done; +ins_list_0([H|T]) -> + X = {H, H}, + _Y = put(element(1,X), element(2,X)), + ?DEBUGF("Inserting ~w: ~w~n",[X,_Y]), + ins_list_0(T). + +time(N) -> + ?DEBUGF("~p~n",[erlang:process_info(self())]), + TT1 = erlang:now(), + T1 = insert_testloop(N,N,0), + TT2 = erlang:now(), + T2 = lookup_testloop(N,N,0), + TT3 = erlang:now(), + T5 = delete_testloop(N,N,0), + TT6 = erlang:now(), + io:format("~p inserts took ~.2f(~.2f) seconds~n", + [N, nowdiff3(TT1,TT2), T1 / 100]), + io:format("~p lookups took ~.2f(~.2f) seconds~n", + [N, nowdiff3(TT2,TT3), T2 / 100]), + io:format("~p deletes took ~.2f(~.2f) seconds~n", + [N, nowdiff3(TT3,TT6), T5 / 100]), + io:format("Total time for ~p elements is ~.2f(~.2f) seconds~n", + [N, nowdiff3(TT1,TT6), (T1+T2+T5) / 100]), + ok. + +key_to_object(Key) -> + {Key, Key,[Key, Key, {Key, banan}]}. + +time_call(Fun,Acc) -> + T1 = erlang:now(), + Ret = Fun(), + T2 = erlang:now(), + {nowdiff2(T1,T2)+Acc,Ret}. + +delete_testloop(0, _X, Acc) -> + ?DEBUGF("all ~p deleted~n",[_X]), + Acc; + +delete_testloop(N, X, Acc) -> + Key = gen_key(N), + Obj = key_to_object(Key), + case get(Key) of + Obj -> + ok; + Y -> + io:format("Error - Object ~p does not exist when we are " + "gonna delete!(N=~p, result=~p)~n",[Obj,N,Y]), + exit({inconsistent_1, delete_testloop, Obj, N, Y}) + end, + + {T, Obj2} = time_call(fun() -> erase(Key) end, Acc), + ?M(Obj,Obj2), + case {(X-N) rem 10000,(X-N)} of + {_,0} -> + ok; + {0,_} -> + ?DEBUGF("~p~n",[X-N]); + _ -> + ok + end, + case get(Key) of + undefined -> + ok; + Else -> + io:format("Error - Object ~p does still exist after " + "delete!(N=~p, result=~p)~n",[Obj,N,Else]), + exit({inconsistent_2, delete_testloop, Obj, N, Else}) + end, + delete_testloop(N-1,X,T). + +lookup_testloop(0, X, Acc) -> + io:format("all ~p looked up~n",[X]), + Acc; +lookup_testloop(N, X, Acc) -> + Key = gen_key(N), + D = key_to_object(Key), + {T, D2} = time_call(fun() -> get(Key) end, Acc), + ?M(D,D2), + case {(X-N) rem 10000,(X-N)} of + {_,0} -> + ok; + {0,_} -> + ?DEBUGF("~p~n",[X-N]); + _ -> + ok + end, + lookup_testloop(N-1,X,T). + +insert_testloop(0,X,Acc) -> + io:format("all ~p inserted~n",[X]), + Acc; +insert_testloop(N,X,Acc) -> + Key = gen_key(N), + D = key_to_object(Key), + {T,_} = time_call(fun() -> put(Key,D) end, Acc), + case {(X-N) rem 10000,(X-N)} of + {_,0} -> + ok; + {0,_} -> + ?DEBUGF("~p~n",[X-N]); + _ -> + ok + end, + insert_testloop(N-1,X,T). + + +gen_key(0,A)-> + A; +gen_key(N,A) -> + X = ((N-1) rem 26) + $a, + gen_key((N-1) div 26, [X|A]). +gen_key(N) -> + gen_key(N+1,[]). + +nowtonumber({Mega, Secs, Milli}) -> + Milli div 10000 + Secs * 100 + Mega * 100000000. + +nowdiff2(T1,T2) -> + nowtonumber(T2) - nowtonumber(T1). +nowdiff3(T1,T2) -> + (nowtonumber(T2) - nowtonumber(T1)) / 100. + +m(A,B,Module,Line) -> + case A == B of + true -> + ok; + _ -> + io:format("~p does not match ~p in module ~p, line ~p, exit.~n", + [A,B,Module,Line]), + exit({no_match,{A,B},Module,Line}) + end. diff --git a/lib/kernel/test/pg2_SUITE.erl b/lib/kernel/test/pg2_SUITE.erl new file mode 100644 index 0000000000..8eb1a7ca19 --- /dev/null +++ b/lib/kernel/test/pg2_SUITE.erl @@ -0,0 +1,718 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2008-2009. 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% +%%---------------------------------------------------------------- +%% Purpose:Test Suite for the 'pg2' module. +%%----------------------------------------------------------------- +-module(pg2_SUITE). + +-include("test_server.hrl"). +-define(datadir, ?config(data_dir, Config)). +-define(privdir, ?config(priv_dir, Config)). + +-export([all/1, init_per_testcase/2, fin_per_testcase/2]). + +-export([tickets/1, + otp_7277/1, otp_8259/1, + compat/1, basic/1]). + +% Default timetrap timeout (set in init_per_testcase). +-define(default_timeout, ?t:minutes(1)). + +-define(TESTCASE, testcase_name). +-define(testcase, ?config(?TESTCASE, Config)). + +%% Internal export. +-export([mk_part_node/3, part1/5, p_init/3, start_proc/1, sane/0]). + +init_per_testcase(Case, Config) -> + ?line Dog = ?t:timetrap(?default_timeout), + [{?TESTCASE, Case}, {watchdog, Dog} | Config]. + +fin_per_testcase(_Case, _Config) -> + Dog = ?config(watchdog, _Config), + test_server:timetrap_cancel(Dog), + ok. + +all(suite) -> + [tickets]. + +tickets(suite) -> + [otp_7277, otp_8259, compat, basic]. + +otp_7277(doc) -> + "OTP-7277. Bugfix leave()."; +otp_7277(suite) -> []; +otp_7277(Config) when is_list(Config) -> + ?line ok = pg2:create(a), + ?line ok = pg2:create(b), + P = spawn(forever()), + ?line ok = pg2:join(a, P), + ?line ok = pg2:leave(b, P), + ?line true = exit(P, kill), + case {pg2:get_members(a), pg2:get_local_members(a)} of + {[], []} -> + ok; + _ -> + timer:sleep(100), + ?line [] = pg2:get_members(a), + ?line [] = pg2:get_local_members(a) + end, + ?line _ = pg2:delete(a), + ?line _ = pg2:delete(b), + ok. + +-define(UNTIL(Seq), loop_until_true(fun() -> Seq end, Config)). +-define(UNTIL_LOOP, 300). + +otp_8259(suite) -> []; +otp_8259(doc) -> + ["OTP-8259. Member was not removed after being killed."]; +otp_8259(Config) when is_list(Config) -> + Timeout = 15, + ?line Dog = test_server:timetrap({seconds,Timeout}), + + ?line [A, B, C] = start_nodes([a, b, c], peer, Config), + + ?line wait_for_ready_net(Config), + + G = pg2_otp_8259, + Name = otp_8259_a_global_name, + + % start different processes in both partitions + ?line {Pid, yes} = rpc:call(A, ?MODULE, start_proc, [Name]), + + ?line ok = pg2:create(G), + ?line ok = pg2:join(G, Pid), + + % make b and c connected, partitioned from node() and a + ?line rpc_cast(B, ?MODULE, part1, [Config, node(), A, C, Name]), + ?line ?UNTIL(is_ready_partition(Config)), + + % Connect to the other partition. + % The resolver on node b will be called. + ?line pong = net_adm:ping(B), + timer:sleep(100), + ?line pong = net_adm:ping(C), + ?line _ = global:sync(), + ?line [A, B, C] = lists:sort(nodes()), + + %% Pid has been killed by the resolver. + %% Pid has been removed from pg2 on all nodes, in particular node B. + ?line ?UNTIL([] =:= rpc:call(B, pg2, get_members, [G])), + ?line ?UNTIL([] =:= pg2:get_members(G)), + ?line ?UNTIL([] =:= rpc:call(A, pg2, get_members, [G])), + ?line ?UNTIL([] =:= rpc:call(C, pg2, get_members, [G])), + + ?line ok = pg2:delete(G), + ?line stop_nodes([A,B,C]), + ?line test_server:timetrap_cancel(Dog), + ok. + +part1(Config, Main, A, C, Name) -> + case catch begin + make_partition(Config, [Main, A], [node(), C]), + ?line {_Pid, yes} = start_proc(Name) + end of + {_, yes} -> ok + end. + +start_proc(Name) -> + Pid = spawn(?MODULE, p_init, [self(), Name, node()]), + receive + {Pid, Res} -> {Pid, Res} + end. + +p_init(Parent, Name, TestServer) -> + Resolve = fun(_Name, Pid1, Pid2) -> + %% The pid on node a will be chosen. + [{_,Min}, {_,Max}] = + lists:sort([{node(Pid1),Pid1}, {node(Pid2),Pid2}]), + %% b is connected to test_server. + %% exit(Min, kill), % would ping a + rpc:cast(TestServer, erlang, exit, [Min, kill]), + Max + end, + X = global:register_name(Name, self(), Resolve), + Parent ! {self(),X}, + loop(). + +loop() -> + receive + die -> + exit(normal) + end. + +compat(suite) -> []; +compat(doc) -> + ["OTP-8259. Check that 'exchange' and 'del_member' work."]; +compat(Config) when is_list(Config) -> + case ?t:is_release_available("r13b") of + true -> + Timeout = 15, + ?line Dog = test_server:timetrap({seconds,Timeout}), + Pid = spawn(forever()), + G = a, + ?line ok = pg2:create(G), + ?line ok = pg2:join(G, Pid), + ?line ok = pg2:join(G, Pid), + ?line {ok, A} = start_node_rel(r13, r13b, slave), + ?line pong = net_adm:ping(A), + ?line wait_for_ready_net(Config), + ?line {ok, _} = rpc:call(A, pg2, start, []), + ?line ?UNTIL([Pid,Pid] =:= rpc:call(A, pg2, get_members, [a])), + ?line true = exit(Pid, kill), + ?line ?UNTIL([] =:= pg2:get_members(a)), + ?line ?UNTIL([] =:= rpc:call(A, pg2, get_members, [a])), + ?t:stop_node(A), + ?line test_server:timetrap_cancel(Dog); + false -> + {skipped, "No support for old node"} + end. + +basic(suite) -> []; +basic(doc) -> + ["OTP-8259. Some basic tests."]; +basic(Config) when is_list(Config) -> + _ = [pg2:delete(G) || G <- pg2:which_groups()], + ?line _ = [do(Cs, T, Config) || {T,Cs} <- ts()], + ok. + +ts() -> + [ + {t1, + [{create,[a],ignore}, + {which_groups,[],[a]}, + {get_closest_pid,[a],{error, {no_process, a}}}, + {delete,[a],ignore}]}, + {t2, + [{create,[a],ignore}, + {join,[a,self()],ok}, + {get_closest_pid,[a],self()}, + {delete,[a],ignore}]}, + {t3, + [{create,[a],ignore}, + {new,p1}, + {leave,[a,p1],ok}, + {join,[b,p1],{error,{no_such_group,b}}}, + {leave,[b,p1],{error,{no_such_group,b}}}, + {get_members,[c],{error,{no_such_group,c}}}, + {get_local_members,[c],{error,{no_such_group,c}}}, + {join,[a,p1],ok}, + {leave,[a,p1],ok}, + {join,[a,p1],ok}, + {join,[a,p1],ok}, + {create,[a],ignore}, + {get_closest_pid,[a],p1}, + {leave,[a,p1],ok}, + {get_closest_pid,[a],p1}, + {leave,[a,p1],ok}, + {get_closest_pid,[a],{error,{no_process, a}}}, + {kill,p1}, + {delete,[a],ignore}]}, + {t4, + [{create,[a],ignore}, + {new,p1}, + {join,[a,p1],ok}, + {get_members,[a],[p1]}, + {get_local_members,[a],[p1]}, + {kill,p1}, + {get_members,[a],[]}, + {get_local_members,[a],[]}, + {delete,[a],ignore}]}, + {t5, + [{create,[a],ignore}, + {nodeup,n1}, + {create,[a],ignore}, + {join,[a,self()],ok}, + {new,n1,p1}, + {n1,{create,[b],ignore}}, + {join,[a,p1],ok}, + {join,[b,p1],ok}, + {n1,{which_groups,[],[a,b]}}, + {n1,{join,[a,p1],ok}}, + {n1,{join,[b,p1],ok}}, + {leave,[a,self()],ok}, + {n1,{leave,[a,self()],ok}}, % noop + {n1,{leave,[b,p1],ok}}, + {leave,[b,p1],ok}, + {kill,n1,p1}, + {nodedown,n1}, + {delete,[b],ignore}, + {delete,[a],ignore}]}, + {t6, + [{create,[a],ignore}, % otp_7277 + {create,[b],ignore}, + {new,p}, + {join,[a,p],ok}, + {leave,[b,p],ok}, + {kill,p}, + {get_members,[a],[]}, + {get_local_members,[a],[]}, + {delete,[a],ignore}, + {delete,[b],ignore}]}, + {t7, % p1 joins twice, the new node gets informed about that + [{create,[a],ignore}, + {new,p1}, + {join,[a,p1],ok}, + {join,[a,p1],ok}, + {get_members,[a],[p1,p1]}, + {get_local_members,[a],[p1,p1]}, + {nodeup,n1}, + {leave,[a,p1],ok}, + {get_members,[a],[p1]}, + {get_local_members,[a],[p1]}, + {n1,{get_members,[a],[p1]}}, + {leave,[a,p1],ok}, + {get_members,[a],[]}, + {n1,{get_members,[a],[]}}, + {nodedown,n1}, + {delete,[a],ignore}, + {kill,p1}]}, + {t8, + [{create,[a],ignore}, + {new,p1}, + {join,[a,p1],ok}, + {join,[a,p1],ok}, + {delete,[a],ignore}, + {get_members,[a],{error,{no_such_group,a}}}, + {kill,p1}]} + ]. + +do(Cs, T, Config) -> + ?t:format("*** Test ~p ***~n", [T]), + {ok,T} = (catch {do(Cs, [], [], Config),T}). + +do([{nodeup,N} | Cs], Ps, Ns, Config) -> + [TestNode] = start_nodes([N], peer, Config), + pr(node(), {nodeup,N,TestNode}), + global:sync(), + timer:sleep(100), + {ok,_} = rpc:call(TestNode, pg2, start, []), + NNs = [{N,TestNode} | Ns], + sane(NNs), + do(Cs, Ps, NNs, Config); +do([{nodedown,N}=C | Cs], Ps, Ns, Config) -> + {N, TestNode} = lists:keyfind(N, 1, Ns), + stop_node(TestNode), + timer:sleep(100), + pr(node(), C), + do(Cs, Ps, lists:keydelete(N, 1, Ns), Config); +do([{new,P} | Cs], Ps, Ns, Config) -> + NPs = new_proc(node(), P, Ps, Ns), + do(Cs, NPs, Ns, Config); +do([{new,N,P} | Cs], Ps, Ns, Config) -> + NPs = new_proc(N, P, Ps, Ns), + do(Cs, NPs, Ns, Config); +do([{kill,P} | Cs], Ps, Ns, Config) -> + NPs = killit(node(), P, Ps, Ns), + do(Cs, NPs, Ns, Config); +do([{kill,N,P} | Cs], Ps, Ns, Config) -> + NPs = killit(N, P, Ps, Ns), + do(Cs, NPs, Ns, Config); +do([{Node,{_,_,_}=C} | Cs], Ps, Ns, Config) -> + doit(Node, C, Ps, Ns), + do(Cs, Ps, Ns, Config); +do([C | Cs], Ps, Ns, Config) -> + doit(node(), C, Ps, Ns), + do(Cs, Ps, Ns, Config); +do([], Ps, Ns, _Config) -> + [] = Ns, + [] = Ps, + [] = pg2:which_groups(), + [] = ets:tab2list(pg2_table), + [] = nodes(), + ok. + +doit(N, C, Ps, Ns) -> + Node = get_node(N, Ns), + pr(Node, C), + {F,As,R} = replace_pids(C, Ps), + case rpc:call(Node, erlang, apply, [pg2, F, As]) of + Result when Result =:= R orelse R =:= ignore -> + sane(Ns); + Else -> + ?t:format("~p and ~p: expected ~p, but got ~p~n", + [F, As, R, Else]), + throw({error,{F, As, R, Else}}) + end. + +new_proc(N, P, Ps, Ns) -> + Node = get_node(N, Ns), + Pid = rpc:call(Node, erlang, spawn, [forever()]), + pr(Node, {new,P,Pid}), + [{P,Pid}|Ps]. + +killit(N, P, Ps, Ns) -> + {P, Pid} = lists:keyfind(P, 1, Ps), + Node = get_node(N, Ns), + pr(Node, {kill,P,Pid}), + rpc:call(Node, erlang, exit, [Pid, kill]), + timer:sleep(100), + sane(Ns), + lists:keydelete(P, 1, Ps). + +pr(Node, C) -> + _ = [?t:format("~p: ", [Node]) || Node =/= node()], + ?t:format("do ~p~n", [C]). + +get_node(N, Ns) -> + if + N =:= node() -> + node(); + true -> + {N, TestNode} = lists:keyfind(N, 1, Ns), + TestNode + end. + +forever() -> + fun() -> receive after infinity -> ok end end. + +replace_pids(T, Ps) when is_tuple(T) -> + list_to_tuple(replace_pids(tuple_to_list(T), Ps)); +replace_pids([E | Es], Ps) -> + [replace_pids(E, Ps) | replace_pids(Es, Ps)]; +replace_pids(A, Ps) -> + case lists:keyfind(A, 1, Ps) of + {A, Pid} -> + Pid; + _ -> + A + end. + +sane(Ns) -> + Nodes = [node()] ++ [NN || {_,NN} <- Ns], + _ = [?t:format("~p, pg2_table:~n ~p~n", % debug + [N, rpc:call(N, ets, tab2list, [pg2_table])]) || + N <- Nodes], + R = [case rpc:call(Node, ?MODULE, sane, []) of + {'EXIT',Error} -> + {error, Node, Error}; + _ -> + ok + end || Node <- Nodes], + case lists:usort(R) of + [ok] -> wsane(Nodes); + _ -> throw(R) + end. + +wsane(Ns) -> + %% Same members on all nodes: + {[_],gs} = + {lists:usort([rpc:call(N, pg2, which_groups, []) || N <- Ns]),gs}, + _ = [{[_],ms,G} = {lists:usort([rpc:call(N, pg2, get_members, [G]) || + N <- Ns]),ms,G} || + G <- pg2:which_groups()], + %% The local members are a partitioning of the members: + [begin + LocalMembers = + lists:sort(lists:append( + [rpc:call(N, pg2, get_local_members, [G]) || + N <- Ns])), + {part, LocalMembers} = {part, lists:sort(pg2:get_members(G))} + end || G <- pg2:which_groups()], + %% The closest pid should run on the local node, if possible. + [[case rpc:call(N, pg2, get_closest_pid, [G]) of + Pid when is_pid(Pid), node(Pid) =:= N -> + true = + lists:member(Pid, rpc:call(N, pg2, get_local_members, [G])); +%% FIXME. Om annan nod: member, local = []. + _ -> [] = rpc:call(N, pg2, get_local_members, [G]) + end || N <- Ns] + || G <- pg2:which_groups()]. + +%% Look inside the pg2_table. +sane() -> + L = ets:tab2list(pg2_table), + Gs = lists:sort([G || {{group,G}} <- L]), + MGs = lists:usort([G || {{member,G,_},_} <- L]), + MPs = lists:usort([P || {{member,_,P},_} <- L]), + {[],mg,MGs,Gs} = {MGs -- Gs,mg,MGs,Gs}, + RPs = [P || {{ref,P},_RPid,_Ref,_C} <- L], + {MPs,rp} = {RPs,rp}, + RPs2 = [P || {{ref,_Ref},P} <- L], + {MPs,rp2} = {RPs2,rp2}, + _ = [true = C >= 1 || {{ref,_P},_RPid,_Ref,C} <- L], + LGs = lists:usort([G || {{local_member,G,_}} <- L]), + LPs = lists:usort([P || {{local_member,_,P}} <- L]), + {[],lg} = {LGs -- Gs,lg}, + {[],lp} = {LPs -- MPs,lp}, + PGs = lists:usort([G || {{pid,_,G}} <- L]), + PPs = lists:usort([P || {{pid,P,_}} <- L]), + {[],pg} = {PGs -- Gs,pg}, + {MPs,pp} = {PPs,pp}, + _ = [true = C >= 1 || {{member,_,_},C} <- L], + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Mostly copied from global_SUITE.erl +%% (Setting up a partition is quite tricky.) + +loop_until_true(Fun, Config) -> + case Fun() of + true -> + true; + _ -> + timer:sleep(?UNTIL_LOOP), + loop_until_true(Fun, Config) + end. + +start_node_rel(Name, Rel, How) -> + {Release, Compat} = case Rel of + this -> + {[this], "+R8"}; + Rel when is_atom(Rel) -> + {[{release, atom_to_list(Rel)}], ""}; + RelList -> + {RelList, ""} + end, + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line Res = test_server:start_node(Name, How, + [{args, + Compat ++ + " -kernel net_setuptime 100 " + " -pa " ++ Pa}, + {erl, Release}]), + Res. + +start_nodes(L, How, Config) -> + start_nodes2(L, How, 0, Config), + Nodes = collect_nodes(0, length(L)), + ?line ?UNTIL([] =:= Nodes -- nodes()), + %% Pinging doesn't help, we have to wait too, for nodes() to become + %% correct on the other node. + lists:foreach(fun(E) -> + net_adm:ping(E) + end, + Nodes), + verify_nodes(Nodes, Config), + Nodes. + +verify_nodes(Nodes, Config) -> + verify_nodes(Nodes, lists:sort([node() | Nodes]), Config). + +verify_nodes([], _N, _Config) -> + []; +verify_nodes([Node | Rest], N, Config) -> + ?line ?UNTIL( + case rpc:call(Node, erlang, nodes, []) of + Nodes when is_list(Nodes) -> + case N =:= lists:sort([Node | Nodes]) of + true -> + true; + false -> + lists:foreach(fun(Nd) -> + rpc:call(Nd, net_adm, ping, + [Node]) + end, + nodes()), + false + end; + _ -> + false + end + ), + verify_nodes(Rest, N, Config). + + +start_nodes2([], _How, _, _Config) -> + []; +start_nodes2([Name | Rest], How, N, Config) -> + Self = self(), + spawn(fun() -> + erlang:display({starting, Name}), + {ok, R} = start_node(Name, How, Config), + erlang:display({started, Name, R}), + Self ! {N, R}, + %% sleeping is necessary, or with peer nodes, they will + %% go down again, despite {linked, false}. + test_server:sleep(100000) + end), + start_nodes2(Rest, How, N+1, Config). + +collect_nodes(N, N) -> + []; +collect_nodes(N, Max) -> + receive + {N, Node} -> + [Node | collect_nodes(N+1, Max)] + end. + +start_node(Name, How, Config) -> + start_node(Name, How, "", Config). + +start_node(Name0, How, Args, Config) -> + Name = node_name(Name0, Config), + Pa = filename:dirname(code:which(?MODULE)), + test_server:start_node(Name, How, [{args, + Args ++ " " ++ + "-kernel net_setuptime 100 " + "-noshell " + "-pa " ++ Pa}, + {linked, false}]). +stop_nodes(Nodes) -> + lists:foreach(fun(Node) -> stop_node(Node) end, Nodes). + +stop_node(Node) -> + ?t:stop_node(Node). + +get_known(Node) -> + case catch gen_server:call({global_name_server,Node},get_known,infinity) of + {'EXIT', _} -> + [list, without, nodenames]; + Known when is_list(Known) -> + lists:sort([Node | Known]) + end. + +node_name(Name, Config) -> + U = "_", + {{Y,M,D}, {H,Min,S}} = calendar:now_to_local_time(now()), + Date = io_lib:format("~4w_~2..0w_~2..0w__~2..0w_~2..0w_~2..0w", + [Y,M,D, H,Min,S]), + L = lists:flatten(Date), + lists:concat([Name,U,?testcase,U,U,L]). + +%% this one runs on one node in Part2 +%% The partition is ready when is_ready_partition(Config) returns (true). +%% this one runs on one node in Part2 +%% The partition is ready when is_ready_partition(Config) returns (true). +make_partition(Config, Part1, Part2) -> + Dir = ?config(priv_dir, Config), + Ns = [begin + Name = lists:concat([atom_to_list(N),"_",msec(),".part"]), + File = filename:join([Dir, Name]), + file:delete(File), + rpc_cast(N, ?MODULE, mk_part_node, [File, Part, Config], File), + {N, File} + end || Part <- [Part1, Part2], N <- Part], + all_nodes_files(Ns, "done", Config), + lists:foreach(fun({_N,File}) -> file:delete(File) end, Ns), + PartFile = make_partition_file(Config), + touch(PartFile, "done"). + +%% The node signals its success by touching a file. +mk_part_node(File, MyPart0, Config) -> + touch(File, "start"), % debug + MyPart = lists:sort(MyPart0), + ?UNTIL(is_node_in_part(File, MyPart)), + touch(File, "done"). + +%% The calls to append_to_file are for debugging. +is_node_in_part(File, MyPart) -> + lists:foreach(fun(N) -> + _ = erlang:disconnect_node(N) + end, nodes() -- MyPart), + case {(Known = get_known(node())) =:= MyPart, + (Nodes = lists:sort([node() | nodes()])) =:= MyPart} of + {true, true} -> + %% Make sure the resolvers have been terminated, + %% otherwise they may pop up and send some message. + %% (This check is probably unnecessary.) + case element(5, global:info()) of + [] -> + true; + Rs -> + append_to_file(File, {now(), Known, Nodes, Rs}), + false + end; + _ -> + append_to_file(File, {now(), Known, Nodes}), + false + end. + +is_ready_partition(Config) -> + File = make_partition_file(Config), + file_contents(File, "done", Config), + file:delete(File), + true. + +wait_for_ready_net(Config) -> + wait_for_ready_net([node()|nodes()], Config). + +wait_for_ready_net(Nodes0, Config) -> + Nodes = lists:sort(Nodes0), + ?t:format("wait_for_ready_net ~p~n", [Nodes]), + ?UNTIL(begin + lists:all(fun(N) -> Nodes =:= get_known(N) end, Nodes) and + lists:all(fun(N) -> + LNs = rpc:call(N, erlang, nodes, []), + Nodes =:= lists:sort([N | LNs]) + end, Nodes) + end). + +%% To make it less probable that some low-level problem causes +%% problems, the receiving node is ping:ed. +rpc_cast(Node, Module, Function, Args) -> + {_,pong,Node}= {node(),net_adm:ping(Node),Node}, + rpc:cast(Node, Module, Function, Args). + +rpc_cast(Node, Module, Function, Args, File) -> + case net_adm:ping(Node) of + pong -> + rpc:cast(Node, Module, Function, Args); + Else -> + append_to_file(File, {now(), {rpc_cast, Node, Module, Function, + Args, Else}}) + %% Maybe we should crash, but it probably doesn't matter. + end. + +touch(File, List) -> + ok = file:write_file(File, list_to_binary(List)). + +append_to_file(File, Term) -> + {ok, Fd} = file:open(File, [raw,binary,append]), + ok = file:write(Fd, io_lib:format("~p.~n", [Term])), + ok = file:close(Fd). + +all_nodes_files(Files, ContentsList, Config) -> + lists:all(fun({_N,File}) -> + file_contents(File, ContentsList, Config) + end, Files). + +file_contents(File, ContentsList, Config) -> + file_contents(File, ContentsList, Config, no_log_file). + +file_contents(File, ContentsList, Config, LogFile) -> + Contents = list_to_binary(ContentsList), + Sz = size(Contents), + ?UNTIL(begin + case file:read_file(File) of + {ok, FileContents}=Reply -> + case catch split_binary(FileContents, Sz) of + {Contents,_} -> + true; + _ -> + catch append_to_file(LogFile, + {File,Contents,Reply}), + false + end; + Reply -> + catch append_to_file(LogFile, {File, Contents, Reply}), + false + end + end). + +make_partition_file(Config) -> + Dir = ?config(priv_dir, Config), + filename:join([Dir, atom_to_list(make_partition_done)]). + +msec() -> + msec(now()). + +msec(T) -> + element(1,T)*1000000000 + element(2,T)*1000 + element(3,T) div 1000. diff --git a/lib/kernel/test/prim_file_SUITE.erl b/lib/kernel/test/prim_file_SUITE.erl new file mode 100644 index 0000000000..860aeecbf4 --- /dev/null +++ b/lib/kernel/test/prim_file_SUITE.erl @@ -0,0 +1,1810 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. 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(prim_file_SUITE). +-export([all/1, + init/1, fini/1, + read_write_file/1, dirs/1, files/1]). +-export([cur_dir_0a/1, cur_dir_0b/1, + cur_dir_1a/1, cur_dir_1b/1, + make_del_dir_a/1, make_del_dir_b/1, + pos/1, pos1/1, pos2/1]). +-export([close/1, + delete_a/1, delete_b/1]). +-export([open/1, open1/1, modes/1]). +-export([file_info/1, + file_info_basic_file_a/1, file_info_basic_file_b/1, + file_info_basic_directory_a/1, file_info_basic_directory_b/1, + file_info_bad_a/1, file_info_bad_b/1, + file_info_times_a/1, file_info_times_b/1, + file_write_file_info_a/1, file_write_file_info_b/1]). +-export([rename_a/1, rename_b/1, + access/1, truncate/1, sync/1, + read_write/1, pread_write/1, append/1]). +-export([errors/1, e_delete/1, e_rename/1, e_make_dir/1, e_del_dir/1]). + +-export([compression/1, read_not_really_compressed/1, + read_compressed/1, write_compressed/1, + compress_errors/1]). + +-export([links/1, + make_link_a/1, make_link_b/1, + read_link_info_for_non_link/1, + symlinks_a/1, symlinks_b/1, + list_dir_limit/1]). + +-include("test_server.hrl"). +-include_lib("kernel/include/file.hrl"). + +-define(PRIM_FILE, prim_file). + +%% Calls ?PRIM_FILE:F with arguments A and an optional handle H +%% as first argument, unless the handle is [], i.e no handle. +%% This is a macro to give the compiler and thereby +%% the cross reference tool the possibility to interprete +%% the call, since M, F, A (or [H | A]) can all be known at +%% compile time. +-define(PRIM_FILE_call(F, H, A), + case H of + [] -> apply(?PRIM_FILE, F, A); + _ -> apply(?PRIM_FILE, F, [H | A]) + end). + +all(suite) -> {req, [kernel], + {conf, init, + [read_write_file, dirs, files, + delete_a, delete_b, rename_a, rename_b, errors, + compression, links, list_dir_limit], + fini}}. + +init(Config) when is_list(Config) -> + case os:type() of + {win32, _} -> + Priv = ?config(priv_dir, Config), + HasAccessTime = + case file:read_file_info(Priv) of + {ok, #file_info{atime={_, {0, 0, 0}}}} -> + %% This is a unfortunately a FAT file system. + [no_access_time]; + {ok, _} -> + [] + end, + HasAccessTime++Config; + _ -> + Config + end. + +fini(Config) when is_list(Config) -> + case os:type() of + {win32, _} -> + os:cmd("subst z: /d"); + _ -> + ok + end, + Config. + +%% Matches a term (the last) against alternatives +expect(X, _, X) -> + X; +expect(_, X, X) -> + X. + +expect(X, _, _, X) -> + X; +expect(_, X, _, X) -> + X; +expect(_, _, X, X) -> + X. + +expect(X, _, _, _, X) -> + X; +expect(_, X, _, _, X) -> + X; +expect(_, _, X, _, X) -> + X; +expect(_, _, _, X, X) -> + X. + +%% Calculate the time difference +time_dist({YY, MM, DD, H, M, S}, DT) -> + time_dist({{YY, MM, DD}, {H, M, S}}, DT); +time_dist(DT, {YY, MM, DD, H, M, S}) -> + time_dist(DT, {{YY, MM, DD}, {H, M, S}}); +time_dist({_D1, _T1} = DT1, {_D2, _T2} = DT2) -> + calendar:datetime_to_gregorian_seconds(DT2) + - calendar:datetime_to_gregorian_seconds(DT1). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +read_write_file(suite) -> []; +read_write_file(doc) -> []; +read_write_file(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_read_write_file"), + + %% Try writing and reading back some term + ?line SomeTerm = {"This term",{will,be},[written,$t,$o],1,file,[]}, + ?line ok = ?PRIM_FILE:write_file(Name,term_to_binary(SomeTerm)), + ?line {ok,Bin1} = ?PRIM_FILE:read_file(Name), + ?line SomeTerm = binary_to_term(Bin1), + + %% Try a "null" term + ?line NullTerm = [], + ?line ok = ?PRIM_FILE:write_file(Name,term_to_binary(NullTerm)), + ?line {ok,Bin2} = ?PRIM_FILE:read_file(Name), + ?line NullTerm = binary_to_term(Bin2), + + %% Try some "complicated" types + ?line BigNum = 123456789012345678901234567890, + ?line ComplTerm = {self(),make_ref(),BigNum,3.14159}, + ?line ok = ?PRIM_FILE:write_file(Name,term_to_binary(ComplTerm)), + ?line {ok,Bin3} = ?PRIM_FILE:read_file(Name), + ?line ComplTerm = binary_to_term(Bin3), + + %% Try reading a nonexistent file + ?line Name2 = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_nonexistent_file"), + ?line {error, enoent} = ?PRIM_FILE:read_file(Name2), + ?line {error, enoent} = ?PRIM_FILE:read_file(""), + + % Try writing to a bad filename + ?line {error, enoent} = + ?PRIM_FILE:write_file("",term_to_binary(NullTerm)), + + % Try writing something else than a binary + ?line {error, badarg} = ?PRIM_FILE:write_file(Name,{1,2,3}), + ?line {error, badarg} = ?PRIM_FILE:write_file(Name,self()), + + %% Some non-term binaries + ?line ok = ?PRIM_FILE:write_file(Name,[]), + ?line {ok,Bin4} = ?PRIM_FILE:read_file(Name), + ?line 0 = byte_size(Bin4), + + ?line ok = ?PRIM_FILE:write_file(Name,[Bin1,[],[[Bin2]]]), + ?line {ok,Bin5} = ?PRIM_FILE:read_file(Name), + ?line {Bin1,Bin2} = split_binary(Bin5,byte_size(Bin1)), + + ?line test_server:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +dirs(suite) -> [make_del_dir_a, make_del_dir_b, + cur_dir_0a, cur_dir_0b, + cur_dir_1a, cur_dir_1b]. + +make_del_dir_a(suite) -> []; +make_del_dir_a(doc) -> []; +make_del_dir_a(Config) when is_list(Config) -> + make_del_dir(Config, [], "_a"). + +make_del_dir_b(suite) -> []; +make_del_dir_b(doc) -> []; +make_del_dir_b(Config) when is_list(Config) -> + ?line {ok, Handle} = ?PRIM_FILE:start(), + Result = make_del_dir(Config, Handle, "_b"), + ?line ok = ?PRIM_FILE:stop(Handle), + %% Just to make sure the state of the server makes a difference + ?line {error, einval} = ?PRIM_FILE_call(get_cwd, Handle, []), + Result. + +make_del_dir(Config, Handle, Suffix) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_mk-dir"++Suffix), + ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), + ?line {error, eexist} = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), + ?line ok = ?PRIM_FILE_call(del_dir, Handle, [NewDir]), + ?line {error, enoent} = ?PRIM_FILE_call(del_dir, Handle, [NewDir]), + + %% Check that we get an error when trying to create... + %% a deep directory + ?line NewDir2 = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_mk-dir/foo"), + ?line {error, enoent} = ?PRIM_FILE_call(make_dir, Handle, [NewDir2]), + %% a nameless directory + ?line {error, enoent} = ?PRIM_FILE_call(make_dir, Handle, [""]), + %% a directory with illegal name + ?line {error, badarg} = ?PRIM_FILE_call(make_dir, Handle, ['mk-dir']), + + %% a directory with illegal name, even if it's a (bad) list + ?line {error, badarg} = ?PRIM_FILE_call(make_dir, Handle, [[1,2,3,{}]]), + + %% Maybe this isn't an error, exactly, but worth mentioning anyway: + %% ok = ?PRIM_FILE:make_dir([$f,$o,$o,0,$b,$a,$r])), + %% The above line works, and created a directory "./foo" + %% More elegant would maybe have been to fail, or to really create + %% a directory, but with a name that incorporates the "bar" part of + %% the list, so that [$f,$o,$o,0,$f,$o,$o] wouldn't refer to the same + %% dir. But this would slow it down. + + %% Try deleting some bad directories + %% Deleting the parent directory to the current, sounds dangerous, huh? + %% Don't worry ;-) the parent directory should never be empty, right? + ?line {error, eexist} = ?PRIM_FILE_call(del_dir, Handle, [".."]), + ?line {error, enoent} = ?PRIM_FILE_call(del_dir, Handle, [""]), + ?line {error, badarg} = ?PRIM_FILE_call(del_dir, Handle, [[3,2,1,{}]]), + + ?line test_server:timetrap_cancel(Dog), + ok. + +cur_dir_0a(suite) -> []; +cur_dir_0a(doc) -> []; +cur_dir_0a(Config) when is_list(Config) -> + cur_dir_0(Config, []). + +cur_dir_0b(suite) -> []; +cur_dir_0b(doc) -> []; +cur_dir_0b(Config) when is_list(Config) -> + ?line {ok, Handle} = ?PRIM_FILE:start(), + Result = cur_dir_0(Config, Handle), + ?line ok = ?PRIM_FILE:stop(Handle), + Result. + +cur_dir_0(Config, Handle) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + %% Find out the current dir, and cd to it ;-) + ?line {ok,BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []), + ?line Dir1 = BaseDir ++ "", %% Check that it's a string + ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), + ?line DirName = atom_to_list(?MODULE) ++ + case Handle of + [] -> + "_curdir"; + _ -> + "_curdir_h" + end, + + %% Make a new dir, and cd to that + ?line RootDir = ?config(priv_dir,Config), + ?line NewDir = filename:join(RootDir, DirName), + ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), + ?line io:format("cd to ~s",[NewDir]), + ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), + + %% Create a file in the new current directory, and check that it + %% really is created there + ?line UncommonName = "uncommon.fil", + ?line {ok,Fd} = ?PRIM_FILE:open(UncommonName, [read, write]), + ?line ok = ?PRIM_FILE:close(Fd), + ?line {ok,NewDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]), + ?line true = lists:member(UncommonName,NewDirFiles), + + %% Delete the directory and return to the old current directory + %% and check that the created file isn't there (too!) + ?line expect({error, einval}, {error, eacces}, {error, eexist}, + ?PRIM_FILE_call(del_dir, Handle, [NewDir])), + ?line ?PRIM_FILE_call(delete, Handle, [UncommonName]), + ?line {ok,[]} = ?PRIM_FILE_call(list_dir, Handle, ["."]), + ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), + ?line io:format("cd back to ~s",[Dir1]), + ?line ok = ?PRIM_FILE_call(del_dir, Handle, [NewDir]), + ?line {error, enoent} = ?PRIM_FILE_call(set_cwd, Handle, [NewDir]), + ?line ok = ?PRIM_FILE_call(set_cwd, Handle, [Dir1]), + ?line io:format("cd back to ~s",[Dir1]), + ?line {ok,OldDirFiles} = ?PRIM_FILE_call(list_dir, Handle, ["."]), + ?line false = lists:member(UncommonName,OldDirFiles), + + %% Try doing some bad things + ?line {error, badarg} = + ?PRIM_FILE_call(set_cwd, Handle, [{foo,bar}]), + ?line {error, enoent} = + ?PRIM_FILE_call(set_cwd, Handle, [""]), + ?line {error, enoent} = + ?PRIM_FILE_call(set_cwd, Handle, [".......a......"]), + ?line {ok,BaseDir} = + ?PRIM_FILE_call(get_cwd, Handle, []), %% Still there? + + %% On Windows, there should only be slashes, no backslashes, + %% in the return value of get_cwd(). + %% (The test is harmless on Unix, because filenames usually + %% don't contain backslashes.) + + ?line {ok, BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []), + ?line false = lists:member($\\, BaseDir), + + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests ?PRIM_FILE:get_cwd/1. + +cur_dir_1a(suite) -> []; +cur_dir_1a(doc) -> []; +cur_dir_1a(Config) when is_list(Config) -> + cur_dir_1(Config, []). + +cur_dir_1b(suite) -> []; +cur_dir_1b(doc) -> []; +cur_dir_1b(Config) when is_list(Config) -> + ?line {ok, Handle} = ?PRIM_FILE:start(), + Result = cur_dir_1(Config, Handle), + ?line ok = ?PRIM_FILE:stop(Handle), + Result. + +cur_dir_1(Config, Handle) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + + ?line case os:type() of + {unix, _} -> + ?line {error, enotsup} = + ?PRIM_FILE_call(get_cwd, Handle, ["d:"]); + vxworks -> + ?line {error, enotsup} = + ?PRIM_FILE_call(get_cwd, Handle, ["d:"]); + {win32, _} -> + win_cur_dir_1(Config, Handle) + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +win_cur_dir_1(_Config, Handle) -> + ?line {ok, BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, []), + + %% Get the drive letter from the current directory, + %% and try to get current directory for that drive. + + ?line [Drive, $:|_] = BaseDir, + ?line {ok, BaseDir} = ?PRIM_FILE_call(get_cwd, Handle, [[Drive, $:]]), + io:format("BaseDir = ~s\n", [BaseDir]), + + %% Unfortunately, there is no way to move away from the + %% current drive as we can't use the "subst" command from + %% a SSH connection. We can't test any more. Too bad. + + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +files(suite) -> [open,pos,file_info,truncate,sync]. + +open(suite) -> [open1,modes,close,access,read_write, + pread_write,append]. + +open1(suite) -> []; +open1(doc) -> []; +open1(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_files"), + ?line ok = ?PRIM_FILE:make_dir(NewDir), + ?line Name = filename:join(NewDir, "foo1.fil"), + ?line {ok,Fd1} = ?PRIM_FILE:open(Name, [read, write]), + ?line {ok,Fd2} = ?PRIM_FILE:open(Name, [read]), + ?line Str = "{a,tuple}.\n", + ?line Length = length(Str), + ?line ?PRIM_FILE:write(Fd1,Str), + ?line {ok,0} = ?PRIM_FILE:position(Fd1,bof), + ?line {ok, Str} = ?PRIM_FILE:read(Fd1,Length), + ?line {ok, Str} = ?PRIM_FILE:read(Fd2,Length), + ?line ok = ?PRIM_FILE:close(Fd2), + ?line {ok,0} = ?PRIM_FILE:position(Fd1,bof), + ?line ok = ?PRIM_FILE:truncate(Fd1), + ?line eof = ?PRIM_FILE:read(Fd1,Length), + ?line ok = ?PRIM_FILE:close(Fd1), + ?line {ok,Fd3} = ?PRIM_FILE:open(Name, [read]), + ?line eof = ?PRIM_FILE:read(Fd3,Length), + ?line ok = ?PRIM_FILE:close(Fd3), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests all open modes. + +modes(suite) -> []; +modes(doc) -> []; +modes(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_open_modes"), + ?line ok = ?PRIM_FILE:make_dir(NewDir), + ?line Name1 = filename:join(NewDir, "foo1.fil"), + ?line Marker = "hello, world", + ?line Length = length(Marker), + + %% write + ?line {ok, Fd1} = ?PRIM_FILE:open(Name1, [write]), + ?line ok = ?PRIM_FILE:write(Fd1, Marker), + ?line ok = ?PRIM_FILE:write(Fd1, ".\n"), + ?line ok = ?PRIM_FILE:close(Fd1), + + %% read + ?line {ok, Fd2} = ?PRIM_FILE:open(Name1, [read]), + ?line {ok, Marker} = ?PRIM_FILE:read(Fd2, Length), + ?line ok = ?PRIM_FILE:close(Fd2), + + %% read and write + ?line {ok, Fd3} = ?PRIM_FILE:open(Name1, [read, write]), + ?line {ok, Marker} = ?PRIM_FILE:read(Fd3, Length), + ?line ok = ?PRIM_FILE:write(Fd3, Marker), + ?line ok = ?PRIM_FILE:close(Fd3), + + %% read by default + ?line {ok, Fd4} = ?PRIM_FILE:open(Name1, []), + ?line {ok, Marker} = ?PRIM_FILE:read(Fd4, Length), + ?line ok = ?PRIM_FILE:close(Fd4), + + %% read and binary + ?line BinaryMarker = list_to_binary(Marker), + ?line {ok, Fd5} = ?PRIM_FILE:open(Name1, [read, binary]), + ?line {ok, BinaryMarker} = ?PRIM_FILE:read(Fd5, Length), + ?line ok = ?PRIM_FILE:close(Fd5), + + ?line test_server:timetrap_cancel(Dog), + ok. + +close(suite) -> []; +close(doc) -> []; +close(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_close.fil"), + ?line {ok,Fd1} = ?PRIM_FILE:open(Name, [read, write]), + %% Just closing it is no fun, we did that a million times already + %% This is a common error, for code written before Erlang 4.3 + %% bacause then ?PRIM_FILE:open just returned a Pid, and not everyone + %% really checked what they got. + ?line {'EXIT',_Msg} = (catch ok = ?PRIM_FILE:close({ok,Fd1})), + ?line ok = ?PRIM_FILE:close(Fd1), + + %% Try closing one more time + ?line Val = ?PRIM_FILE:close(Fd1), + ?line io:format("Second close gave: ~p", [Val]), + + ?line test_server:timetrap_cancel(Dog), + ok. + +access(suite) -> []; +access(doc) -> []; +access(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_access.fil"), + ?line Str = "ABCDEFGH", + ?line {ok,Fd1} = ?PRIM_FILE:open(Name, [write]), + ?line ?PRIM_FILE:write(Fd1,Str), + ?line ok = ?PRIM_FILE:close(Fd1), + %% Check that we can't write when in read only mode + ?line {ok,Fd2} = ?PRIM_FILE:open(Name, [read]), + ?line case catch ?PRIM_FILE:write(Fd2,"XXXX") of + ok -> + test_server:fail({access,write}); + _ -> + ok + end, + ?line ok = ?PRIM_FILE:close(Fd2), + ?line {ok, Fd3} = ?PRIM_FILE:open(Name, [read]), + ?line {ok, Str} = ?PRIM_FILE:read(Fd3,length(Str)), + ?line ok = ?PRIM_FILE:close(Fd3), + + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Tests ?PRIM_FILE:read/2 and ?PRIM_FILE:write/2. + +read_write(suite) -> []; +read_write(doc) -> []; +read_write(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_read_write"), + ?line ok = ?PRIM_FILE:make_dir(NewDir), + + %% Raw file. + ?line Name = filename:join(NewDir, "raw.fil"), + ?line {ok, Fd} = ?PRIM_FILE:open(Name, [read, write]), + ?line read_write_test(Fd), + + ?line test_server:timetrap_cancel(Dog), + ok. + +read_write_test(File) -> + ?line Marker = "hello, world", + ?line ok = ?PRIM_FILE:write(File, Marker), + ?line {ok, 0} = ?PRIM_FILE:position(File, 0), + ?line {ok, Marker} = ?PRIM_FILE:read(File, 100), + ?line eof = ?PRIM_FILE:read(File, 100), + ?line ok = ?PRIM_FILE:close(File), + ok. + + +%% Tests ?PRIM_FILE:pread/2 and ?PRIM_FILE:pwrite/2. + +pread_write(suite) -> []; +pread_write(doc) -> []; +pread_write(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_pread_write"), + ?line ok = ?PRIM_FILE:make_dir(NewDir), + + %% Raw file. + ?line Name = filename:join(NewDir, "raw.fil"), + ?line {ok, Fd} = ?PRIM_FILE:open(Name, [read, write]), + ?line pread_write_test(Fd), + + ?line test_server:timetrap_cancel(Dog), + ok. + +pread_write_test(File) -> + ?line Marker = "hello, world", + ?line Len = length(Marker), + ?line ok = ?PRIM_FILE:write(File, Marker), + ?line {ok, Marker} = ?PRIM_FILE:pread(File, 0, 100), + ?line eof = ?PRIM_FILE:pread(File, 100, 1), + ?line ok = ?PRIM_FILE:pwrite(File, Len, Marker), + ?line {ok, Marker} = ?PRIM_FILE:pread(File, Len, 100), + ?line eof = ?PRIM_FILE:pread(File, 100, 1), + ?line MM = Marker ++ Marker, + ?line {ok, MM} = ?PRIM_FILE:pread(File, 0, 100), + ?line ok = ?PRIM_FILE:close(File), + ok. + +append(doc) -> "Test appending to a file."; +append(suite) -> []; +append(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_append"), + ?line ok = ?PRIM_FILE:make_dir(NewDir), + + ?line First = "First line\n", + ?line Second = "Seond lines comes here\n", + ?line Third = "And here is the third line\n", + + %% Write a small text file. + ?line Name1 = filename:join(NewDir, "a_file.txt"), + ?line {ok, Fd1} = ?PRIM_FILE:open(Name1, [write]), + ?line ok = ?PRIM_FILE:write(Fd1, First), + ?line ok = ?PRIM_FILE:write(Fd1, Second), + ?line ok = ?PRIM_FILE:close(Fd1), + + %% Open it a again and a append a line to it. + ?line {ok, Fd2} = ?PRIM_FILE:open(Name1, [append]), + ?line ok = ?PRIM_FILE:write(Fd2, Third), + ?line ok = ?PRIM_FILE:close(Fd2), + + %% Read it back and verify. + ?line Expected = list_to_binary([First, Second, Third]), + ?line {ok, Expected} = ?PRIM_FILE:read_file(Name1), + + ?line test_server:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +pos(suite) -> [pos1,pos2]. + +pos1(suite) -> []; +pos1(doc) -> []; +pos1(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_pos1.fil"), + ?line {ok, Fd1} = ?PRIM_FILE:open(Name, [write]), + ?line ?PRIM_FILE:write(Fd1,"ABCDEFGH"), + ?line ok = ?PRIM_FILE:close(Fd1), + ?line {ok, Fd2} = ?PRIM_FILE:open(Name, [read]), + + %% Start pos is first char + ?line io:format("Relative positions"), + ?line {ok, "A"} = ?PRIM_FILE:read(Fd2,1), + ?line {ok, 2} = ?PRIM_FILE:position(Fd2,{cur,1}), + ?line {ok, "C"} = ?PRIM_FILE:read(Fd2,1), + ?line {ok, 0} = ?PRIM_FILE:position(Fd2,{cur,-3}), + ?line {ok, "A"} = ?PRIM_FILE:read(Fd2,1), + %% Backwards from first char should be an error + ?line {ok,0} = ?PRIM_FILE:position(Fd2,{cur,-1}), + ?line {error, einval} = ?PRIM_FILE:position(Fd2,{cur,-1}), + %% Reset position and move again + ?line {ok, 0} = ?PRIM_FILE:position(Fd2,0), + ?line {ok, 2} = ?PRIM_FILE:position(Fd2,{cur,2}), + ?line {ok, "C"} = ?PRIM_FILE:read(Fd2,1), + %% Go a lot forwards + ?line {ok, 13} = ?PRIM_FILE:position(Fd2,{cur,10}), + ?line eof = ?PRIM_FILE:read(Fd2,1), + + %% Try some fixed positions + ?line io:format("Fixed positions"), + ?line {ok, 8} = ?PRIM_FILE:position(Fd2,8), + ?line eof = ?PRIM_FILE:read(Fd2,1), + ?line {ok, 8} = ?PRIM_FILE:position(Fd2,cur), + ?line eof = ?PRIM_FILE:read(Fd2,1), + ?line {ok, 7} = ?PRIM_FILE:position(Fd2,7), + ?line {ok, "H"} = ?PRIM_FILE:read(Fd2,1), + ?line {ok, 0} = ?PRIM_FILE:position(Fd2,0), + ?line {ok, "A"} = ?PRIM_FILE:read(Fd2,1), + ?line {ok, 3} = ?PRIM_FILE:position(Fd2,3), + ?line {ok, "D"} = ?PRIM_FILE:read(Fd2,1), + ?line {ok, 12} = ?PRIM_FILE:position(Fd2,12), + ?line eof = ?PRIM_FILE:read(Fd2,1), + ?line {ok, 3} = ?PRIM_FILE:position(Fd2,3), + ?line {ok, "D"} = ?PRIM_FILE:read(Fd2,1), + %% Try the {bof,X} notation + ?line {ok, 3} = ?PRIM_FILE:position(Fd2,{bof,3}), + ?line {ok, "D"} = ?PRIM_FILE:read(Fd2,1), + + %% Try eof positions + ?line io:format("EOF positions"), + ?line {ok, 8} = ?PRIM_FILE:position(Fd2,{eof,0}), + ?line eof = ?PRIM_FILE:read(Fd2,1), + ?line {ok, 7} = ?PRIM_FILE:position(Fd2,{eof,-1}), + ?line {ok, "H"} = ?PRIM_FILE:read(Fd2,1), + ?line {ok, 0} = ?PRIM_FILE:position(Fd2,{eof,-8}), + ?line {ok, "A"} = ?PRIM_FILE:read(Fd2,1), + ?line {error, einval} = ?PRIM_FILE:position(Fd2,{eof,-9}), + ?line test_server:timetrap_cancel(Dog), + ok. + +pos2(suite) -> []; +pos2(doc) -> []; +pos2(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_pos2.fil"), + ?line {ok,Fd1} = ?PRIM_FILE:open(Name, [write]), + ?line ?PRIM_FILE:write(Fd1,"ABCDEFGH"), + ?line ok = ?PRIM_FILE:close(Fd1), + ?line {ok, Fd2} = ?PRIM_FILE:open(Name, [read]), + ?line {error, einval} = ?PRIM_FILE:position(Fd2,-1), + + %% Make sure that we still can search after an error. + ?line {ok, 0} = ?PRIM_FILE:position(Fd2, 0), + ?line {ok, 3} = ?PRIM_FILE:position(Fd2, {bof,3}), + ?line {ok, "D"} = ?PRIM_FILE:read(Fd2,1), + + ?line io:format("DONE"), + ?line test_server:timetrap_cancel(Dog), + ok. + +file_info(suite) -> [file_info_basic_file_a, file_info_basic_file_b, + file_info_basic_directory_a, + file_info_basic_directory_b, + file_info_bad_a, file_info_bad_b, + file_info_times_a, file_info_times_b, + file_write_file_info_a, file_write_file_info_b]. + +file_info_basic_file_a(suite) -> []; +file_info_basic_file_a(doc) -> []; +file_info_basic_file_a(Config) when is_list(Config) -> + file_info_basic_file(Config, [], "_a"). + +file_info_basic_file_b(suite) -> []; +file_info_basic_file_b(doc) -> []; +file_info_basic_file_b(Config) when is_list(Config) -> + ?line {ok, Handle} = ?PRIM_FILE:start(), + Result = file_info_basic_file(Config, Handle, "_b"), + ?line ok = ?PRIM_FILE:stop(Handle), + Result. + +file_info_basic_file(Config, Handle, Suffix) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir, Config), + + %% Create a short file. + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_basic_test"++Suffix++".fil"), + ?line {ok,Fd1} = ?PRIM_FILE:open(Name, [write]), + ?line ?PRIM_FILE:write(Fd1, "foo bar"), + ?line ok = ?PRIM_FILE:close(Fd1), + + %% Test that the file has the expected attributes. + %% The times are tricky, so we will save them to a separate test case. + ?line {ok, FileInfo} = ?PRIM_FILE_call(read_file_info, Handle, [Name]), + ?line #file_info{size = Size, type = Type, access = Access, + atime = AccessTime, mtime = ModifyTime} = + FileInfo, + ?line io:format("Access ~p, Modify ~p", [AccessTime, ModifyTime]), + ?line Size = 7, + ?line Type = regular, + ?line Access = read_write, + ?line true = abs(time_dist(filter_atime(AccessTime, Config), + filter_atime(ModifyTime, + Config))) < 2, + ?line {AD, AT} = AccessTime, + ?line all_integers(tuple_to_list(AD) ++ tuple_to_list(AT)), + ?line {MD, MT} = ModifyTime, + ?line all_integers(tuple_to_list(MD) ++ tuple_to_list(MT)), + + ?line test_server:timetrap_cancel(Dog), + ok. + +file_info_basic_directory_a(suite) -> []; +file_info_basic_directory_a(doc) -> []; +file_info_basic_directory_a(Config) when is_list(Config) -> + file_info_basic_directory(Config, []). + +file_info_basic_directory_b(suite) -> []; +file_info_basic_directory_b(doc) -> []; +file_info_basic_directory_b(Config) when is_list(Config) -> + ?line {ok, Handle} = ?PRIM_FILE:start(), + Result = file_info_basic_directory(Config, Handle), + ?line ok = ?PRIM_FILE:stop(Handle), + Result. + +file_info_basic_directory(Config, Handle) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + + %% Note: filename:join/1 removes any trailing slash, + %% which is essential for ?PRIM_FILE:read_file_info/1 to work on + %% platforms such as Windows95. + ?line RootDir = filename:join([?config(priv_dir, Config)]), + + %% Test that the RootDir directory has the expected attributes. + ?line test_directory(RootDir, read_write, Handle), + + %% Note that on Windows file systems, "/" or "c:/" are *NOT* directories. + %% Therefore, test that ?PRIM_FILE:read_file_info/1 behaves + %% as if they were directories. + ?line case os:type() of + {win32, _} -> + ?line test_directory("/", read_write, Handle), + ?line test_directory("c:/", read_write, Handle), + ?line test_directory("c:\\", read_write, Handle); + {unix, _} -> + ?line test_directory("/", read, Handle); + vxworks -> + %% Check is just done for owner + ?line test_directory("/", read_write, Handle) + end, + ?line test_server:timetrap_cancel(Dog). + +test_directory(Name, ExpectedAccess, Handle) -> + ?line {ok, FileInfo} = ?PRIM_FILE_call(read_file_info, Handle, [Name]), + ?line #file_info{size = Size, type = Type, access = Access, + atime = AccessTime, mtime = ModifyTime} = + FileInfo, + ?line io:format("Testing directory ~s", [Name]), + ?line io:format("Directory size is ~p", [Size]), + ?line io:format("Access ~p", [Access]), + ?line io:format("Access time ~p; Modify time~p", + [AccessTime, ModifyTime]), + ?line Type = directory, + ?line Access = ExpectedAccess, + ?line {AD, AT} = AccessTime, + ?line all_integers(tuple_to_list(AD) ++ tuple_to_list(AT)), + ?line {MD, MT} = ModifyTime, + ?line all_integers(tuple_to_list(MD) ++ tuple_to_list(MT)), + ok. + +all_integers([Int|Rest]) when is_integer(Int) -> + ?line all_integers(Rest); +all_integers([]) -> + ok. + +%% Try something nonexistent. + +file_info_bad_a(suite) -> []; +file_info_bad_a(doc) -> []; +file_info_bad_a(Config) when is_list(Config) -> + file_info_bad(Config, []). + +file_info_bad_b(suite) -> []; +file_info_bad_b(doc) -> []; +file_info_bad_b(Config) when is_list(Config) -> + ?line {ok, Handle} = ?PRIM_FILE:start(), + Result = file_info_bad(Config, Handle), + ?line ok = ?PRIM_FILE:stop(Handle), + Result. + +file_info_bad(Config, Handle) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = filename:join([?config(priv_dir, Config)]), + ?line {error, enoent} = + ?PRIM_FILE_call( + read_file_info, Handle, + [filename:join(RootDir, + atom_to_list(?MODULE)++"_nonexistent")]), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Test that the file times behave as they should. + +file_info_times_a(suite) -> []; +file_info_times_a(doc) -> []; +file_info_times_a(Config) when is_list(Config) -> + file_info_times(Config, [], "_a"). + +file_info_times_b(suite) -> []; +file_info_times_b(doc) -> []; +file_info_times_b(Config) when is_list(Config) -> + ?line {ok, Handle} = ?PRIM_FILE:start(), + Result = file_info_times(Config, Handle, "_b"), + ?line ok = ?PRIM_FILE:stop(Handle), + Result. + +file_info_times(Config, Handle, Suffix) -> + ?line Dog = test_server:timetrap(test_server:seconds(60)), + %% We have to try this twice, since if the test runs across the change + %% of a month the time diff calculations will fail. But it won't happen + %% if you run it twice in succession. + ?line test_server:m_out_of_n( + 1,2, + fun() -> ?line file_info_int(Config, Handle, Suffix) end), + ?line test_server:timetrap_cancel(Dog), + ok. + +file_info_int(Config, Handle, Suffix) -> + %% Note: filename:join/1 removes any trailing slash, + %% which is essential for ?PRIM_FILE:read_file_info/1 to work on + %% platforms such as Windows95. + + ?line RootDir = filename:join([?config(priv_dir, Config)]), + ?line test_server:format("RootDir = ~p", [RootDir]), + + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_file_info"++Suffix++".fil"), + ?line {ok,Fd1} = ?PRIM_FILE:open(Name, [write]), + ?line ?PRIM_FILE:write(Fd1,"foo"), + + %% check that the file got a modify date max a few seconds away from now + ?line {ok, #file_info{type = regular, + atime = AccTime1, mtime = ModTime1}} = + ?PRIM_FILE_call(read_file_info, Handle, [Name]), + ?line Now = erlang:localtime(), + ?line io:format("Now ~p",[Now]), + ?line io:format("Open file Acc ~p Mod ~p",[AccTime1,ModTime1]), + ?line true = abs(time_dist(filter_atime(Now, Config), + filter_atime(AccTime1, + Config))) < 8, + ?line true = abs(time_dist(Now, ModTime1)) < 8, + + %% Sleep until we can be sure the seconds value has changed. + %% Note: FAT-based filesystem (like on Windows 95) have + %% a resolution of 2 seconds. + ?line test_server:sleep(test_server:seconds(2.2)), + + %% close the file, and watch the modify date change + ?line ok = ?PRIM_FILE:close(Fd1), + ?line {ok, #file_info{size = Size, type = regular, access = Access, + atime = AccTime2, mtime = ModTime2}} = + ?PRIM_FILE_call(read_file_info, Handle, [Name]), + ?line io:format("Closed file Acc ~p Mod ~p",[AccTime2,ModTime2]), + ?line true = time_dist(ModTime1, ModTime2) >= 0, + + %% this file is supposed to be binary, so it'd better keep it's size + ?line Size = 3, + ?line Access = read_write, + + %% Do some directory checking + ?line {ok, #file_info{size = DSize, type = directory, + access = DAccess, + atime = AccTime3, mtime = ModTime3}} = + ?PRIM_FILE_call(read_file_info, Handle, [RootDir]), + %% this dir was modified only a few secs ago + ?line io:format("Dir Acc ~p; Mod ~p; Now ~p", + [AccTime3, ModTime3, Now]), + ?line true = abs(time_dist(Now, ModTime3)) < 5, + ?line DAccess = read_write, + ?line io:format("Dir size is ~p",[DSize]), + ok. + +%% Filter access times, to cope with a deficiency of FAT file systems +%% (on Windows): The access time is actually only a date. + +filter_atime(Atime, Config) -> + case lists:member(no_access_time, Config) of + true -> + case Atime of + {Date, _} -> + {Date, {0, 0, 0}}; + {Y, M, D, _, _, _} -> + {Y, M, D, 0, 0, 0} + end; + false -> + Atime + end. + +%% Test the write_file_info/2 function. + +file_write_file_info_a(suite) -> []; +file_write_file_info_a(doc) -> []; +file_write_file_info_a(Config) when is_list(Config) -> + file_write_file_info(Config, [], "_a"). + +file_write_file_info_b(suite) -> []; +file_write_file_info_b(doc) -> []; +file_write_file_info_b(Config) when is_list(Config) -> + ?line {ok, Handle} = ?PRIM_FILE:start(), + Result = file_write_file_info(Config, Handle, "_b"), + ?line ok = ?PRIM_FILE:stop(Handle), + Result. + +file_write_file_info(Config, Handle, Suffix) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = get_good_directory(Config), + ?line test_server:format("RootDir = ~p", [RootDir]), + + %% Set the file to read only AND update the file times at the same time. + %% (This used to fail on Windows NT/95 for a local filesystem.) + %% Note: Seconds must be even; see note in file_info_times/1. + + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_write_file_info_ro"++Suffix), + ?line ok = ?PRIM_FILE:write_file(Name, "hello"), + ?line Time = {{1997, 01, 02}, {12, 35, 42}}, + ?line Info = #file_info{mode=8#400, atime=Time, mtime=Time, ctime=Time}, + ?line ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, Info]), + + %% Read back the times. + + ?line {ok, ActualInfo} = + ?PRIM_FILE_call(read_file_info, Handle, [Name]), + ?line #file_info{mode=_Mode, atime=ActAtime, mtime=Time, + ctime=ActCtime} = ActualInfo, + ?line FilteredAtime = filter_atime(Time, Config), + ?line FilteredAtime = filter_atime(ActAtime, Config), + ?line case os:type() of + {win32, _} -> + %% On Windows, "ctime" means creation time and it can + %% be set. + ActCtime = Time; + _ -> + ok + end, + ?line {error, eacces} = ?PRIM_FILE:write_file(Name, "hello again"), + + %% Make the file writable again. + + ?line ?PRIM_FILE_call(write_file_info, Handle, + [Name, #file_info{mode=8#600}]), + ?line ok = ?PRIM_FILE:write_file(Name, "hello again"), + + %% And unwritable. + ?line ?PRIM_FILE_call(write_file_info, Handle, + [Name, #file_info{mode=8#400}]), + ?line {error, eacces} = ?PRIM_FILE:write_file(Name, "hello again"), + + %% Write the times again. + %% Note: Seconds must be even; see note in file_info_times/1. + + ?line NewTime = {{1997, 02, 15}, {13, 18, 20}}, + ?line NewInfo = #file_info{atime=NewTime, mtime=NewTime, ctime=NewTime}, + ?line ok = ?PRIM_FILE_call(write_file_info, Handle, [Name, NewInfo]), + ?line {ok, ActualInfo2} = + ?PRIM_FILE_call(read_file_info, Handle, [Name]), + ?line #file_info{atime=NewActAtime, mtime=NewTime, + ctime=NewActCtime} = ActualInfo2, + ?line NewFilteredAtime = filter_atime(NewTime, Config), + ?line NewFilteredAtime = filter_atime(NewActAtime, Config), + ?line case os:type() of + {win32, _} -> NewActCtime = NewTime; + _ -> ok + end, + + %% The file should still be unwritable. + ?line {error, eacces} = ?PRIM_FILE:write_file(Name, "hello again"), + + %% Make the file writeable again, so that we can remove the + %% test suites ... :-) + ?line ?PRIM_FILE_call(write_file_info, Handle, + [Name, #file_info{mode=8#600}]), + ?line test_server:timetrap_cancel(Dog), + ok. + +%% Returns a directory on a file system that has correct file times. + +get_good_directory(Config) -> + ?line ?config(priv_dir, Config). + +truncate(suite) -> []; +truncate(doc) -> []; +truncate(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_truncate.fil"), + + %% Create a file with some data. + ?line MyData = "0123456789abcdefghijklmnopqrstuvxyz", + ?line ok = ?PRIM_FILE:write_file(Name, MyData), + + %% Truncate the file to 10 characters. + ?line {ok, Fd} = ?PRIM_FILE:open(Name, [read, write]), + ?line {ok, 10} = ?PRIM_FILE:position(Fd, 10), + ?line ok = ?PRIM_FILE:truncate(Fd), + ?line ok = ?PRIM_FILE:close(Fd), + + %% Read back the file and check that it has been truncated. + ?line Expected = list_to_binary("0123456789"), + ?line {ok, Expected} = ?PRIM_FILE:read_file(Name), + + %% Open the file read only and verify that it is not possible to + %% truncate it, OTP-1960 + ?line {ok, Fd2} = ?PRIM_FILE:open(Name, [read]), + ?line {ok, 5} = ?PRIM_FILE:position(Fd2, 5), + ?line {error, _} = ?PRIM_FILE:truncate(Fd2), + + ?line test_server:timetrap_cancel(Dog), + ok. + + +sync(suite) -> []; +sync(doc) -> "Tests that ?PRIM_FILE:sync/1 at least doesn't crash."; +sync(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line PrivDir = ?config(priv_dir, Config), + ?line Sync = filename:join(PrivDir, + atom_to_list(?MODULE) + ++"_sync.fil"), + + %% Raw open. + ?line {ok, Fd} = ?PRIM_FILE:open(Sync, [write]), + ?line ok = ?PRIM_FILE:sync(Fd), + ?line ok = ?PRIM_FILE:close(Fd), + + ?line test_server:timetrap_cancel(Dog), + ok. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +delete_a(suite) -> []; +delete_a(doc) -> []; +delete_a(Config) when is_list(Config) -> + delete(Config, [], "_a"). + +delete_b(suite) -> []; +delete_b(doc) -> []; +delete_b(Config) when is_list(Config) -> + ?line {ok, Handle} = ?PRIM_FILE:start(), + Result = delete(Config, Handle, "_b"), + ?line ok = ?PRIM_FILE:stop(Handle), + Result. + +delete(Config, Handle, Suffix) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line Name = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_delete"++Suffix++".fil"), + ?line {ok, Fd1} = ?PRIM_FILE:open(Name, [write]), + ?line ?PRIM_FILE:write(Fd1,"ok.\n"), + ?line ok = ?PRIM_FILE:close(Fd1), + %% Check that the file is readable + ?line {ok, Fd2} = ?PRIM_FILE:open(Name, [read]), + ?line ok = ?PRIM_FILE:close(Fd2), + ?line ok = ?PRIM_FILE_call(delete, Handle, [Name]), + %% Check that the file is not readable anymore + ?line {error, _} = ?PRIM_FILE:open(Name, [read]), + %% Try deleting a nonexistent file + ?line {error, enoent} = ?PRIM_FILE_call(delete, Handle, [Name]), + ?line test_server:timetrap_cancel(Dog), + ok. + +rename_a(suite) ->[]; +rename_a(doc) ->[]; +rename_a(Config) when is_list(Config) -> + rename(Config, [], "_a"). + +rename_b(suite) ->[]; +rename_b(doc) ->[]; +rename_b(Config) when is_list(Config) -> + ?line {ok, Handle} = ?PRIM_FILE:start(), + Result = rename(Config, Handle, "_b"), + ?line ok = ?PRIM_FILE:stop(Handle), + Result. + +rename(Config, Handle, Suffix) -> + ?line Dog = test_server:timetrap(test_server:seconds(5)), + ?line RootDir = ?config(priv_dir,Config), + ?line FileName1 = atom_to_list(?MODULE)++"_rename"++Suffix++".fil", + ?line FileName2 = atom_to_list(?MODULE)++"_rename"++Suffix++".ful", + ?line Name1 = filename:join(RootDir, FileName1), + ?line Name2 = filename:join(RootDir, FileName2), + ?line {ok,Fd1} = ?PRIM_FILE:open(Name1, [write]), + ?line ok = ?PRIM_FILE:close(Fd1), + %% Rename, and check that it really changed name + ?line ok = ?PRIM_FILE_call(rename, Handle, [Name1, Name2]), + ?line {error, _} = ?PRIM_FILE:open(Name1, [read]), + ?line {ok, Fd2} = ?PRIM_FILE:open(Name2, [read]), + ?line ok = ?PRIM_FILE:close(Fd2), + %% Try renaming something to itself + ?line ok = ?PRIM_FILE_call(rename, Handle, [Name2, Name2]), + %% Try renaming something that doesn't exist + ?line {error, enoent} = + ?PRIM_FILE_call(rename, Handle, [Name1, Name2]), + %% Try renaming to something else than a string + ?line {error, badarg} = + ?PRIM_FILE_call(rename, Handle, [Name1, foobar]), + + %% Move between directories + ?line DirName1 = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_rename_dir"++Suffix), + ?line DirName2 = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_second_rename_dir"++Suffix), + ?line Name1foo = filename:join(DirName1, "foo.fil"), + ?line Name2foo = filename:join(DirName2, "foo.fil"), + ?line Name2bar = filename:join(DirName2, "bar.dir"), + ?line ok = ?PRIM_FILE:make_dir(DirName1), + %% The name has to include the full file name, path is not enough + ?line expect( + {error, eexist}, {error, eisdir}, + ?PRIM_FILE_call(rename, Handle, [Name2, DirName1])), + ?line ok = + ?PRIM_FILE_call(rename, Handle, [Name2, Name1foo]), + %% Now rename the directory + ?line ok = ?PRIM_FILE_call(rename, Handle, [DirName1, DirName2]), + %% And check that the file is there now + ?line {ok,Fd3} = ?PRIM_FILE:open(Name2foo, [read]), + ?line ok = ?PRIM_FILE:close(Fd3), + %% Try some dirty things now: move the directory into itself + ?line {error, Msg1} = + ?PRIM_FILE_call(rename, Handle, [DirName2, Name2bar]), + ?line io:format("Errmsg1: ~p",[Msg1]), + %% move dir into a file in itself + ?line {error, Msg2} = + ?PRIM_FILE_call(rename, Handle, [DirName2, Name2foo]), + ?line io:format("Errmsg2: ~p",[Msg2]), + + ?line test_server:timetrap_cancel(Dog), + ok. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +errors(suite) -> [e_delete, e_rename, e_make_dir, e_del_dir]. + +e_delete(suite) -> []; +e_delete(doc) -> []; +e_delete(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line Base = filename:join(RootDir, + atom_to_list(?MODULE)++"_e_delete"), + ?line ok = ?PRIM_FILE:make_dir(Base), + + %% Delete a non-existing file. + ?line {error, enoent} = + ?PRIM_FILE:delete(filename:join(Base, "non_existing")), + + %% Delete a directory. + ?line {error, eperm} = ?PRIM_FILE:delete(Base), + + %% Use a path-name with a non-directory component. + ?line Afile = filename:join(Base, "a_file"), + ?line ok = ?PRIM_FILE:write_file(Afile, "hello\n"), + ?line {error, E} = + expect( + {error, enotdir}, {error, enoent}, + ?PRIM_FILE:delete(filename:join(Afile, "another_file"))), + ?line io:format("Result: ~p~n", [E]), + + %% No permission. + ?line case os:type() of + {unix, _} -> + ?line ?PRIM_FILE:write_file_info( + Base, #file_info {mode=0}), + ?line {error, eacces} = ?PRIM_FILE:delete(Afile), + ?line ?PRIM_FILE:write_file_info( + Base, #file_info {mode=8#600}); + {win32, _} -> + %% Remove a character device. + ?line {error, eacces} = ?PRIM_FILE:delete("nul"); + vxworks -> + ok + end, + + ?line test_server:timetrap_cancel(Dog), + ok. + +%%% FreeBSD gives EEXIST when renaming a file to an empty dir, although the +%%% manual page can be interpreted as saying that EISDIR should be given. +%%% (What about FreeBSD? We store our nightly build results on a FreeBSD +%%% file system, that's what.) + +e_rename(suite) -> []; +e_rename(doc) -> []; +e_rename(Config) when is_list(Config) -> + case os:type() of + vxworks -> + {comment, "Windriver: dosFs must be fixed first!"}; + _ -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line Base = filename:join(RootDir, + atom_to_list(?MODULE)++"_e_rename"), + ?line ok = ?PRIM_FILE:make_dir(Base), + + %% Create an empty directory. + ?line EmptyDir = filename:join(Base, "empty_dir"), + ?line ok = ?PRIM_FILE:make_dir(EmptyDir), + + %% Create a non-empty directory. + ?line NonEmptyDir = filename:join(Base, "non_empty_dir"), + ?line ok = ?PRIM_FILE:make_dir(NonEmptyDir), + ?line ok = ?PRIM_FILE:write_file( + filename:join(NonEmptyDir, "a_file"), + "hello\n"), + + %% Create another non-empty directory. + ?line ADirectory = filename:join(Base, "a_directory"), + ?line ok = ?PRIM_FILE:make_dir(ADirectory), + ?line ok = ?PRIM_FILE:write_file( + filename:join(ADirectory, "a_file"), + "howdy\n\n"), + + %% Create a data file. + ?line File = filename:join(Base, "just_a_file"), + ?line ok = ?PRIM_FILE:write_file(File, "anything goes\n\n"), + + %% Move an existing directory to a non-empty directory. + ?line {error, eexist} = + ?PRIM_FILE:rename(ADirectory, NonEmptyDir), + + %% Move a root directory. + ?line {error, einval} = ?PRIM_FILE:rename("/", "arne"), + + %% Move Base into Base/new_name. + ?line {error, einval} = + ?PRIM_FILE:rename(Base, filename:join(Base, "new_name")), + + %% Overwrite a directory with a file. + ?line expect({error, eexist}, % FreeBSD (?) + {error, eisdir}, + ?PRIM_FILE:rename(File, EmptyDir)), + ?line expect({error, eexist}, % FreeBSD (?) + {error, eisdir}, + ?PRIM_FILE:rename(File, NonEmptyDir)), + + %% Move a non-existing file. + ?line NonExistingFile = filename:join( + Base, "non_existing_file"), + ?line {error, enoent} = + ?PRIM_FILE:rename(NonExistingFile, NonEmptyDir), + + %% Overwrite a file with a directory. + ?line expect({error, eexist}, % FreeBSD (?) + {error, enotdir}, + ?PRIM_FILE:rename(ADirectory, File)), + + %% Move a file to another filesystem. + %% XXX - This test case is bogus. We cannot be guaranteed that + %% the source and destination are on + %% different filesystems. + %% + %% XXX - Gross hack! + ?line Comment = + case os:type() of + {unix, _} -> + OtherFs = "/tmp", + ?line NameOnOtherFs = + filename:join(OtherFs, + filename:basename(File)), + ?line {ok, Com} = + case ?PRIM_FILE:rename( + File, NameOnOtherFs) of + {error, exdev} -> + %% The file could be in + %% the same filesystem! + {ok, ok}; + ok -> + {ok, {comment, + "Moving between filesystems " + "suceeded, files are probably " + "in the same filesystem!"}}; + {error, eperm} -> + {ok, {comment, "SBS! You don't " + "have the permission to do " + "this test!"}}; + Else -> + Else + end, + Com; + {win32, _} -> + %% At least Windows NT can + %% successfully move a file to + %% another drive. + ok + end, + ?line test_server:timetrap_cancel(Dog), + Comment + end. + +e_make_dir(suite) -> []; +e_make_dir(doc) -> []; +e_make_dir(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line Base = filename:join(RootDir, + atom_to_list(?MODULE)++"_e_make_dir"), + ?line ok = ?PRIM_FILE:make_dir(Base), + + %% A component of the path does not exist. + ?line {error, enoent} = + ?PRIM_FILE:make_dir(filename:join([Base, "a", "b"])), + + %% Use a path-name with a non-directory component. + ?line Afile = filename:join(Base, "a_directory"), + ?line ok = ?PRIM_FILE:write_file(Afile, "hello\n"), + ?line case ?PRIM_FILE:make_dir( + filename:join(Afile, "another_directory")) of + {error, enotdir} -> io:format("Result: enotdir"); + {error, enoent} -> io:format("Result: enoent") + end, + + %% No permission (on Unix only). + case os:type() of + {unix, _} -> + ?line ?PRIM_FILE:write_file_info(Base, #file_info {mode=0}), + ?line {error, eacces} = + ?PRIM_FILE:make_dir(filename:join(Base, "xxxx")), + ?line + ?PRIM_FILE:write_file_info(Base, #file_info {mode=8#600}); + {win32, _} -> + ok; + vxworks -> + ok + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +e_del_dir(suite) -> []; +e_del_dir(doc) -> []; +e_del_dir(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line Base = filename:join(RootDir, + atom_to_list(?MODULE)++"_e_del_dir"), + ?line io:format("Base: ~p", [Base]), + ?line ok = ?PRIM_FILE:make_dir(Base), + + %% Delete a non-existent directory. + ?line {error, enoent} = + ?PRIM_FILE:del_dir(filename:join(Base, "non_existing")), + + %% Use a path-name with a non-directory component. + ?line Afile = filename:join(Base, "a_directory"), + ?line ok = ?PRIM_FILE:write_file(Afile, "hello\n"), + ?line {error, E1} = + expect({error, enotdir}, {error, enoent}, + ?PRIM_FILE:del_dir( + filename:join(Afile, "another_directory"))), + ?line io:format("Result: ~p", [E1]), + + %% Delete a non-empty directory. + %% Delete a non-empty directory. + ?line {error, E2} = + expect({error, enotempty}, {error, eexist}, {error, eacces}, + ?PRIM_FILE:del_dir(Base)), + ?line io:format("Result: ~p", [E2]), + + %% Remove the current directory. + ?line {error, E3} = + expect({error, einval}, + {error, eperm}, % Linux and DUX + {error, eacces}, + {error, ebusy}, + ?PRIM_FILE:del_dir(".")), + ?line io:format("Result: ~p", [E3]), + + %% No permission. + case os:type() of + {unix, _} -> + ?line ADirectory = filename:join(Base, "no_perm"), + ?line ok = ?PRIM_FILE:make_dir(ADirectory), + ?line ?PRIM_FILE:write_file_info(Base, #file_info {mode=0}), + ?line {error, eacces} = ?PRIM_FILE:del_dir(ADirectory), + ?line ?PRIM_FILE:write_file_info( + Base, #file_info {mode=8#600}); + {win32, _} -> + ok; + vxworks -> + ok + end, + ?line test_server:timetrap_cancel(Dog), + ok. + +compression(suite) -> [read_compressed, read_not_really_compressed, + write_compressed, compress_errors]. + +%% Trying reading and positioning from a compressed file. + +read_compressed(suite) -> []; +read_compressed(doc) -> []; +read_compressed(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line Real = filename:join(Data, "realmen.html.gz"), + ?line {ok, Fd} = ?PRIM_FILE:open(Real, [read, compressed]), + ?line try_read_file(Fd). + +%% Trying reading and positioning from an uncompressed file, +%% but with the compressed flag given. + +read_not_really_compressed(suite) -> []; +read_not_really_compressed(doc) -> []; +read_not_really_compressed(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line Priv = ?config(priv_dir, Config), + + %% The file realmen.html might have got CRs added (by WinZip). + %% Remove them, or the file positions will not be correct. + + ?line Real = filename:join(Data, "realmen.html"), + ?line RealPriv = filename:join(Priv, + atom_to_list(?MODULE)++"_realmen.html"), + ?line {ok, RealDataBin} = ?PRIM_FILE:read_file(Real), + ?line RealData = remove_crs(binary_to_list(RealDataBin), []), + ?line ok = ?PRIM_FILE:write_file(RealPriv, RealData), + ?line {ok, Fd} = ?PRIM_FILE:open(RealPriv, [read, compressed]), + ?line try_read_file(Fd). + +remove_crs([$\r|Rest], Result) -> + remove_crs(Rest, Result); +remove_crs([C|Rest], Result) -> + remove_crs(Rest, [C|Result]); +remove_crs([], Result) -> + lists:reverse(Result). + +try_read_file(Fd) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + + %% Seek to the current position (nothing should happen). + + ?line {ok, 0} = ?PRIM_FILE:position(Fd, 0), + ?line {ok, 0} = ?PRIM_FILE:position(Fd, {cur, 0}), + + %% Read a few lines from a compressed file. + + ?line ShouldBe = "<TITLE>Real Programmers Don't Use PASCAL</TITLE>\n", + ?line {ok, ShouldBe} = ?PRIM_FILE:read(Fd, length(ShouldBe)), + + %% Now seek forward. + + ?line {ok, 381} = ?PRIM_FILE:position(Fd, 381), + ?line Back = "Back in the good old days -- the \"Golden Era\" " ++ + "of computers, it was\n", + ?line {ok, Back} = ?PRIM_FILE:read(Fd, length(Back)), + + %% Try to search forward relative to the current position. + + ?line {ok, CurPos} = ?PRIM_FILE:position(Fd, {cur, 0}), + ?line RealPos = 4273, + ?line {ok, RealPos} = ?PRIM_FILE:position(Fd, {cur, RealPos-CurPos}), + ?line RealProg = "<LI> Real Programmers aren't afraid to use GOTOs.\n", + ?line {ok, RealProg} = ?PRIM_FILE:read(Fd, length(RealProg)), + + %% Seek backward. + + ?line AfterTitle = length("<TITLE>"), + ?line {ok, AfterTitle} = ?PRIM_FILE:position(Fd, AfterTitle), + ?line Title = "Real Programmers Don't Use PASCAL</TITLE>\n", + ?line {ok, Title} = ?PRIM_FILE:read(Fd, length(Title)), + + %% Done. + + ?line ?PRIM_FILE:close(Fd), + ?line test_server:timetrap_cancel(Dog), + ok. + +write_compressed(suite) -> []; +write_compressed(doc) -> []; +write_compressed(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Priv = ?config(priv_dir, Config), + ?line MyFile = filename:join(Priv, + atom_to_list(?MODULE)++"_test.gz"), + + %% Write a file. + + ?line {ok, Fd} = ?PRIM_FILE:open(MyFile, [write, compressed]), + ?line {ok, 0} = ?PRIM_FILE:position(Fd, 0), + ?line Prefix = "hello\n", + ?line End = "end\n", + ?line ok = ?PRIM_FILE:write(Fd, Prefix), + ?line {ok, 143} = ?PRIM_FILE:position(Fd, 143), + ?line ok = ?PRIM_FILE:write(Fd, End), + ?line ok = ?PRIM_FILE:close(Fd), + + %% Read the file and verify the contents. + + ?line {ok, Fd1} = ?PRIM_FILE:open(MyFile, [read, compressed]), + ?line {ok, Prefix} = ?PRIM_FILE:read(Fd1, length(Prefix)), + ?line Second = lists:duplicate(143-length(Prefix), 0) ++ End, + ?line {ok, Second} = ?PRIM_FILE:read(Fd1, length(Second)), + ?line ok = ?PRIM_FILE:close(Fd1), + + %% Ensure that the file is compressed. + + TotalSize = 143 + length(End), + case ?PRIM_FILE:read_file_info(MyFile) of + {ok, #file_info{size=Size}} when Size < TotalSize -> + ok; + {ok, #file_info{size=Size}} when Size == TotalSize -> + test_server:fail(file_not_compressed) + end, + + %% Write again to ensure that the file is truncated. + + ?line {ok, Fd2} = ?PRIM_FILE:open(MyFile, [write, compressed]), + ?line NewString = "aaaaaaaaaaa", + ?line ok = ?PRIM_FILE:write(Fd2, NewString), + ?line ok = ?PRIM_FILE:close(Fd2), + ?line {ok, Fd3} = ?PRIM_FILE:open(MyFile, [read, compressed]), + ?line {ok, NewString} = ?PRIM_FILE:read(Fd3, 1024), + ?line ok = ?PRIM_FILE:close(Fd3), + + %% Done. + + ?line test_server:timetrap_cancel(Dog), + ok. + +compress_errors(suite) -> []; +compress_errors(doc) -> []; +compress_errors(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line Data = ?config(data_dir, Config), + ?line {error, enoent} = ?PRIM_FILE:open("non_existing__", + [compressed, read]), + ?line {error, einval} = ?PRIM_FILE:open("non_existing__", + [compressed, read, write]), + + %% Read a corrupted .gz file. + + ?line Corrupted = filename:join(Data, "corrupted.gz"), + ?line {ok, Fd} = ?PRIM_FILE:open(Corrupted, [read, compressed]), + ?line {error, eio} = ?PRIM_FILE:read(Fd, 100), + ?line ?PRIM_FILE:close(Fd), + + ?line test_server:timetrap_cancel(Dog), + ok. + +links(doc) -> "Test the link functions."; +links(suite) -> + [make_link_a, make_link_b, + read_link_info_for_non_link, + symlinks_a, symlinks_b]. + +make_link_a(doc) -> "Test creating a hard link."; +make_link_a(suite) -> []; +make_link_a(Config) when is_list(Config) -> + make_link(Config, [], "_a"). + +make_link_b(doc) -> "Test creating a hard link."; +make_link_b(suite) -> []; +make_link_b(Config) when is_list(Config) -> + ?line {ok, Handle} = ?PRIM_FILE:start(), + Result = make_link(Config, Handle, "_b"), + ?line ok = ?PRIM_FILE:stop(Handle), + Result. + +make_link(Config, Handle, Suffix) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_make_link"++Suffix), + ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), + + ?line Name = filename:join(NewDir, "a_file"), + ?line ok = ?PRIM_FILE:write_file(Name, "some contents\n"), + + ?line Alias = filename:join(NewDir, "an_alias"), + ?line Result = + case ?PRIM_FILE_call(make_link, Handle, [Name, Alias]) of + {error, enotsup} -> + {skipped, "Links not supported on this platform"}; + ok -> + %% Note: We take the opportunity to test + %% ?PRIM_FILE:read_link_info/1, + %% which should in behave exactly as + %% ?PRIM_FILE:read_file_info/1 + %% since they are not used on symbolic links. + + ?line {ok, Info} = + ?PRIM_FILE_call(read_link_info, Handle, [Name]), + ?line {ok, Info} = + ?PRIM_FILE_call(read_link_info, Handle, [Alias]), + ?line #file_info{links = 2, type = regular} = Info, + ?line {error, eexist} = + ?PRIM_FILE_call(make_link, Handle, [Name, Alias]), + ok + end, + + ?line test_server:timetrap_cancel(Dog), + Result. + +read_link_info_for_non_link(doc) -> + "Test that reading link info for an ordinary file or directory works " + "(on all platforms)."; +read_link_info_for_non_link(suite) -> []; +read_link_info_for_non_link(Config) when is_list(Config) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + + ?line {ok, #file_info{type=directory}} = ?PRIM_FILE:read_link_info("."), + + ?line test_server:timetrap_cancel(Dog), + ok. + +symlinks_a(doc) -> "Test operations on symbolic links (for Unix)."; +symlinks_a(suite) -> []; +symlinks_a(Config) when is_list(Config) -> + symlinks(Config, [], "_a"). + +symlinks_b(doc) -> "Test operations on symbolic links (for Unix)."; +symlinks_b(suite) -> []; +symlinks_b(Config) when is_list(Config) -> + ?line {ok, Handle} = ?PRIM_FILE:start(), + Result = symlinks(Config, Handle, "_b"), + ?line ok = ?PRIM_FILE:stop(Handle), + Result. + +symlinks(Config, Handle, Suffix) -> + ?line Dog = test_server:timetrap(test_server:seconds(10)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE) + ++"_make_symlink"++Suffix), + ?line ok = ?PRIM_FILE_call(make_dir, Handle, [NewDir]), + + ?line Name = filename:join(NewDir, "a_plain_file"), + ?line ok = ?PRIM_FILE:write_file(Name, "some stupid content\n"), + + ?line Alias = filename:join(NewDir, "a_symlink_alias"), + ?line Result = + case ?PRIM_FILE_call(make_symlink, Handle, [Name, Alias]) of + {error, enotsup} -> + {skipped, "Links not supported on this platform"}; + ok -> + ?line {ok, Info1} = + ?PRIM_FILE_call(read_file_info, Handle, [Name]), + ?line {ok, Info1} = + ?PRIM_FILE_call(read_file_info, Handle, [Alias]), + ?line {ok, Info1} = + ?PRIM_FILE_call(read_link_info, Handle, [Name]), + ?line #file_info{links = 1, type = regular} = Info1, + + ?line {ok, Info2} = + ?PRIM_FILE_call(read_link_info, Handle, [Alias]), + ?line #file_info{links=1, type=symlink} = Info2, + ?line {ok, Name} = + ?PRIM_FILE_call(read_link, Handle, [Alias]), + ok + end, + + ?line test_server:timetrap_cancel(Dog), + Result. + +%% Creates as many files as possible during a certain time, +%% periodically calls list_dir/2 to check if it works, +%% then deletes all files. + +list_dir_limit(doc) -> + "Tests if large directories can be read"; +list_dir_limit(suite) -> + []; +list_dir_limit(Config) when is_list(Config) -> + ?line MaxTime = 120, + ?line MaxNumber = 20000, + ?line Dog = test_server:timetrap( + test_server:seconds(2*MaxTime + MaxTime)), + ?line RootDir = ?config(priv_dir, Config), + ?line NewDir = filename:join(RootDir, + atom_to_list(?MODULE)++"_list_dir_limit"), + ?line {ok, Handle1} = ?PRIM_FILE:start(), + ?line ok = ?PRIM_FILE_call(make_dir, Handle1, [NewDir]), + Ref = erlang:start_timer(MaxTime*1000, self(), []), + ?line Result = list_dir_limit_loop(NewDir, Handle1, Ref, MaxNumber, 0), + ?line Time = case erlang:cancel_timer(Ref) of + false -> MaxTime; + T -> MaxTime - (T div 1000) + end, + ?line Number = case Result of + {ok, N} -> N; + {error, _Reason, N} -> N; + _ -> 0 + end, + ?line {ok, Handle2} = ?PRIM_FILE:start(), + ?line list_dir_limit_cleanup(NewDir, Handle2, Number, 0), + ?line ok = ?PRIM_FILE:stop(Handle1), + ?line ok = ?PRIM_FILE:stop(Handle2), + ?line {ok, Number} = Result, + ?line test_server:timetrap_cancel(Dog), + {comment, + "Created " ++ integer_to_list(Number) ++ " files in " + ++ integer_to_list(Time) ++ " seconds."}. + +list_dir_limit_loop(Dir, Handle, _Ref, N, Cnt) when Cnt >= N -> + list_dir_check(Dir, Handle, Cnt); +list_dir_limit_loop(Dir, Handle, Ref, N, Cnt) -> + receive + {timeout, Ref, []} -> + list_dir_check(Dir, Handle, Cnt) + after 0 -> + Name = integer_to_list(Cnt), + case ?PRIM_FILE:write_file(filename:join(Dir, Name), Name) of + ok -> + Next = Cnt + 1, + case Cnt rem 100 of + 0 -> + case list_dir_check(Dir, Handle, Next) of + {ok, Next} -> + list_dir_limit_loop( + Dir, Handle, Ref, N, Next); + Other -> + Other + end; + _ -> + list_dir_limit_loop(Dir, Handle, Ref, N, Next) + end; + {error, Reason} -> + {error, Reason, Cnt} + end + end. + +list_dir_check(Dir, Handle, Cnt) -> + case ?PRIM_FILE:list_dir(Handle, Dir) of + {ok, ListDir} -> + case length(ListDir) of + Cnt -> + {ok, Cnt}; + X -> + {error, + {wrong_nof_files, X, ?LINE}, + Cnt} + end; + {error, Reason} -> + {error, Reason, Cnt} + end. + +%% Deletes N files while ignoring errors, then continues deleting +%% as long as they exist. + +list_dir_limit_cleanup(Dir, Handle, N, Cnt) when Cnt >= N -> + Name = integer_to_list(Cnt), + case ?PRIM_FILE:delete(Handle, filename:join(Dir, Name)) of + ok -> + list_dir_limit_cleanup(Dir, Handle, N, Cnt+1); + _ -> + ok + end; +list_dir_limit_cleanup(Dir, Handle, N, Cnt) -> + Name = integer_to_list(Cnt), + ?PRIM_FILE:delete(Handle, filename:join(Dir, Name)), + list_dir_limit_cleanup(Dir, Handle, N, Cnt+1). + diff --git a/lib/kernel/test/prim_file_SUITE_data/corrupted.gz b/lib/kernel/test/prim_file_SUITE_data/corrupted.gz new file mode 100644 index 0000000000..16331b350c --- /dev/null +++ b/lib/kernel/test/prim_file_SUITE_data/corrupted.gz @@ -0,0 +1,5 @@ + � +========================================== +This file has a correct GZIP magic ID, but the rest of the +header is corrupt. Reading this file should result in an +error. diff --git a/lib/kernel/test/prim_file_SUITE_data/realmen.html b/lib/kernel/test/prim_file_SUITE_data/realmen.html new file mode 100644 index 0000000000..c810a5d088 --- /dev/null +++ b/lib/kernel/test/prim_file_SUITE_data/realmen.html @@ -0,0 +1,520 @@ +<TITLE>Real Programmers Don't Use PASCAL</TITLE> + +<H2 align=center>Real Programmers Don't Use PASCAL</H2> + +<H4 align=center><em>Ed Post<br> +Graphic Software Systems<br> + +P.O. Box 673<br> +25117 S.W. Parkway<br> +Wilsonville, OR 97070<br> +Copyright (c) 1982<br> +</H4></EM> + + +<H4 align=center><KBD> (decvax | ucbvax | cbosg | pur-ee | lbl-unix)!teklabs!ogcvax!gss1144!evp</KBD></H4> + + +Back in the good old days -- the "Golden Era" of computers, it was +easy to separate the men from the boys (sometimes called "Real Men" +and "Quiche Eaters" in the literature). During this period, the Real +Men were the ones that understood computer programming, and the Quiche +Eaters were the ones that didn't. A real computer programmer said +things like <KBD>"DO 10 I=1,10"</KBD> and <KBD>"ABEND"</KBD> (they +actually talked in capital letters, you understand), and the rest of +the world said things like <EM>"computers are too complicated for +me"</EM> and <EM>"I can't relate to computers -- they're so +impersonal"</EM>. (A previous work [1] points out that Real Men don't +"relate" to anything, and aren't afraid of being impersonal.) <P> + +But, as usual, times change. We are faced today with a world in which +little old ladies can get computerized microwave ovens, 12 year old +kids can blow Real Men out of the water playing Asteroids and Pac-Man, +and anyone can buy and even understand their very own Personal +Computer. The Real Programmer is in danger of becoming extinct, of +being replaced by high-school students with TRASH-80s! <P> + +There is a clear need to point out the differences between the typical +high-school junior Pac-Man player and a Real Programmer. Understanding +these differences will give these kids something to aspire to -- a +role model, a Father Figure. It will also help employers of Real +Programmers to realize why it would be a mistake to replace the Real +Programmers on their staff with 12 year old Pac-Man players (at a +considerable salary savings). <P> + + +<H3>LANGUAGES</H3> + +The easiest way to tell a Real Programmer from the crowd is by the +programming language he (or she) uses. Real Programmers use FORTRAN. +Quiche Eaters use PASCAL. Nicklaus Wirth, the designer of PASCAL, was +once asked, <EM>"How do you pronounce your name?"</EM>. He replied +<EM>"You can either call me by name, pronouncing it 'Veert', or call +me by value, 'Worth'."</EM> One can tell immediately from this comment +that Nicklaus Wirth is a Quiche Eater. The only parameter passing +mechanism endorsed by Real Programmers is call-by-value-return, as +implemented in the IBM/370 FORTRAN G and H compilers. Real +programmers don't need abstract concepts to get their jobs done: they +are perfectly happy with a keypunch, a FORTRAN IV compiler, and a +beer. <P> + +<UL> +<LI> Real Programmers do List Processing in FORTRAN. + +<LI> Real Programmers do String Manipulation in FORTRAN. + +<LI> Real Programmers do Accounting (if they do it at all) in FORTRAN. + +<LI> Real Programmers do Artificial Intelligence programs in FORTRAN. +</UL> <P> + +If you can't do it in FORTRAN, do it in assembly language. If you can't do +it in assembly language, it isn't worth doing. <P> + + +<H3> STRUCTURED PROGRAMMING</H3> + +Computer science academicians have gotten into the "structured pro- +gramming" rut over the past several years. They claim that programs +are more easily understood if the programmer uses some special +language constructs and techniques. They don't all agree on exactly +which constructs, of course, and the examples they use to show their +particular point of view invariably fit on a single page of some +obscure journal or another -- clearly not enough of an example to +convince anyone. When I got out of school, I thought I was the best +programmer in the world. I could write an unbeatable tic-tac-toe +program, use five different computer languages, and create 1000 line +programs that WORKED. (Really!) Then I got out into the Real +World. My first task in the Real World was to read and understand a +200,000 line FORTRAN program, then speed it up by a factor of two. Any +Real Programmer will tell you that all the Structured Coding in the +world won't help you solve a problem like that -- it takes actual +talent. Some quick observations on Real Programmers and Structured +Programming: <P> + +<UL> +<LI> Real Programmers aren't afraid to use GOTOs. + +<LI> Real Programmers can write five page long DO loops without +getting confused. + +<LI> Real Programmers enjoy Arithmetic IF statements because they make +the code more interesting. + +<LI> Real Programmers write self-modifying code, especially if it +saves them 20 nanoseconds in the middle of a tight loop. + +<LI> Programmers don't need comments: the code is obvious. + +<LI> Since FORTRAN doesn't have a structured <KBD>IF, REPEAT +... UNTIL</KBD>, or <KBD>CASE</KBD> statement, Real Programmers don't +have to worry about not using them. Besides, they can be simulated +when necessary using assigned <KBD>GOTO</KBD>s. + +</UL> <P> + +Data structures have also gotten a lot of press lately. Abstract Data +Types, Structures, Pointers, Lists, and Strings have become popular in +certain circles. Wirth (the above-mentioned Quiche Eater) actually +wrote an entire book [2] contending that you could write a program +based on data structures, instead of the other way around. As all Real +Programmers know, the only useful data structure is the +array. Strings, lists, structures, sets -- these are all special cases +of arrays and and can be treated that way just as easily without +messing up your programing language with all sorts of +complications. The worst thing about fancy data types is that you have +to declare them, and Real Programming Languages, as we all know, have +implicit typing based on the first letter of the (six character) +variable name. <P> + + +<H3> OPERATING SYSTEMS</H3> + +What kind of operating system is used by a Real Programmer? CP/M? God +forbid -- CP/M, after all, is basically a toy operating system. Even +little old ladies and grade school students can understand and use +CP/M. <P> + +Unix is a lot more complicated of course -- the typical Unix hacker +never can remember what the <KBD>PRINT</KBD> command is called this +week -- but when it gets right down to it, Unix is a glorified video +game. People don't do Serious Work on Unix systems: they send jokes +around the world on USENET and write adventure games and research +papers. <P> + +No, your Real Programmer uses OS/370. A good programmer can find and +understand the description of the IJK305I error he just got in his JCL +manual. A great programmer can write JCL without referring to the +manual at all. A truly outstanding programmer can find bugs buried in +a 6 megabyte core dump without using a hex calculator. (I have +actually seen this done.) <P> + +OS/370 is a truly remarkable operating system. It's possible to des- +troy days of work with a single misplaced space, so alertness in the +programming staff is encouraged. The best way to approach the system +is through a keypunch. Some people claim there is a Time Sharing +system that runs on OS/370, but after careful study I have come to the +conclusion that they are mistaken. <P> + + +<H3> PROGRAMMING TOOLS</H3> + +What kind of tools does a Real Programmer use? In theory, a Real +Programmer could run his programs by keying them into the front panel +of the computer. Back in the days when computers had front panels, +this was actually done occasionally. Your typical Real Programmer +knew the entire bootstrap loader by memory in hex, and toggled it in +whenever it got destroyed by his program. (Back then, memory was +memory -- it didn't go away when the power went off. Today, memory +either forgets things when you don't want it to, or remembers things +long after they're better forgotten.) Legend has it that Seymour +Cray, inventor of the Cray I supercomputer and most of Control Data's +computers, actually toggled the first operating system for the CDC7600 +in on the front panel from memory when it was first powered +on. Seymour, needless to say, is a Real Programmer. <P> + +One of my favorite Real Programmers was a systems programmer for Texas +Instruments. One day, he got a long distance call from a user whose +system had crashed in the middle of some important work. Jim was able +to repair the damage over the phone, getting the user to toggle in +disk I/O instructions at the front panel, repairing system tables in +hex, reading register contents back over the phone. The moral of this +story: while a Real Programmer usually includes a keypunch and +lineprinter in his toolkit, he can get along with just a front panel +and a telephone in emergencies. <P> + +In some companies, text editing no longer consists of ten engineers +standing in line to use an 029 keypunch. In fact, the building I work +in doesn't contain a single keypunch. The Real Programmer in this +situation has to do his work with a text editor program. Most systems +supply several text editors to select from, and the Real Programmer +must be careful to pick one that reflects his personal style. Many +people believe that the best text editors in the world were written at +Xerox Palo Alto Research Center for use on their Alto and Dorado +computers [3]. Unfortunately, no Real Programmer would ever use a +computer whose operating system is called SmallTalk, and would +certainly not talk to the computer with a mouse. <P> + +Some of the concepts in these Xerox editors have been incorporated +into editors running on more reasonably named operating systems. EMACS +and VI are probably the most well known of this class of editors. The +problem with these editors is that Real Programmers consider "what you +see is what you get" to be just as bad a concept in text editors as it +is in women. No, the Real Programmer wants a "you asked for it, you +got it" text editor -- complicated, cryptic, powerful, unforgiving, +dangerous. TECO, to be precise. <P> + +It has been observed that a TECO command sequence more closely resem- +bles transmission line noise than readable text [4]. One of the more +entertaining games to play with TECO is to type your name in as a +command line and try to guess what it does. Just about any possible +typing error while talking with TECO will probably destroy your +program, or even worse -- introduce subtle and mysterious bugs in a +once working subroutine. <P> + +For this reason, Real Programmers are reluctant to actually edit a +program that is close to working. They find it much easier to just +patch the binary object code directly, using a wonderful program +called SUPERZAP (or its equivalent on non-IBM machines). This works so +well that many working programs on IBM systems bear no relation to +the original FORTRAN code. In many cases, the original source code is +no longer available. When it comes time to fix a program like this, no +manager would even think of sending anything less than a Real +Programmer to do the job -- no Quiche Eating structured programmer +would even know where to start. This is called "job security". <P> + +Some programming tools NOT used by Real Programmers: <P> +<UL> + +<LI> FORTRAN preprocessors like MORTRAN and RATFOR. The Cuisinarts of +programming -- great for making Quiche. See comments above on +structured programming. + +<LI> Source language debuggers. Real Programmers can read core dumps. + +<LI> Compilers with array bounds checking. They stifle creativity, +destroy most of the interesting uses for EQUIVALENCE, and make it +impossible to modify the operating system code with negative +subscripts. Worst of all, bounds checking is inefficient. + +<LI> Source code maintainance systems. A Real Programmer keeps his +code locked up in a card file, because it implies that its owner +cannot leave his important programs unguarded [5]. + +</UL> <P> + + +<H3> THE REAL PROGRAMMER AT WORK</H3> + +Where does the typical Real Programmer work? What kind of programs are +worthy of the efforts of so talented an individual? You can be sure +that no real Programmer would be caught dead writing +accounts-receivable programs in COBOL, or sorting mailing lists for +People magazine. A Real Programmer wants tasks of earth-shaking +importance (literally!): <P> + +<UL> + +<LI> Real Programmers work for Los Alamos National Laboratory, writing +atomic bomb simulations to run on Cray I supercomputers. + +<LI> Real Programmers work for the National Security Agency, decoding +Russian transmissions. + +<LI> It was largely due to the efforts of thousands of Real +Programmers working for NASA that our boys got to the moon and back +before the cosmonauts. + +<LI> The computers in the Space Shuttle were programmed by Real +Programmers. + +<LI> Programmers are at work for Boeing designing the operating +systems for cruise missiles. + +</UL> <P> + +Some of the most awesome Real Programmers of all work at the Jet Pro- +pulsion Laboratory in California. Many of them know the entire +operating system of the Pioneer and Voyager spacecraft by heart. With +a combination of large ground-based FORTRAN programs and small +spacecraft-based assembly language programs, they can to do incredible +feats of navigation and improvisation, such as hitting ten-kilometer +wide windows at Saturn after six years in space, and repairing or +bypassing damaged sensor platforms, radios, and batteries. Allegedly, +one Real Programmer managed to tuck a pattern-matching program into a +few hundred bytes of unused memory in a Voyager spacecraft that +searched for, located, and photographed a new moon of Jupiter. <P> + +One plan for the upcoming Galileo spacecraft mission is to use a grav- +ity assist trajectory past Mars on the way to Jupiter. This trajectory +passes within 80 +/- 3 kilometers of the surface of Mars. Nobody is +going to trust a PASCAL program (or PASCAL programmer) for navigation +to these tolerances. <P> + +As you can tell, many of the world's Real Programmers work for the +U.S. Government, mainly the Defense Department. This is as it should +be. Recently, however, a black cloud has formed on the Real +Programmer horizon. <P> + +It seems that some highly placed Quiche Eaters at the Defense +Department decided that all Defense programs should be written in some +grand unified language called "ADA" (registered trademark, DoD). For +a while, it seemed that ADA was destined to become a language that +went against all the precepts of Real Programming -- a language with +structure, a language with data types, strong typing, and +semicolons. In short, a language designed to cripple the creativity of +the typical Real Programmer. Fortunately, the language adopted by DoD +has enough interesting features to make it approachable: it's +incredibly complex, includes methods for messing with the operating +system and rearranging memory, and Edsgar Dijkstra doesn't like it +[6]. (Dijkstra, as I'm sure you know, was the author of <EM>"GoTos +Considered Harmful"</EM> -- a landmark work in programming +methodology, applauded by Pascal Programmers and Quiche Eaters alike.) +Besides, the determined Real Programmer can write FORTRAN programs in +any language. <P> + +The real programmer might compromise his principles and work on some- +thing slightly more trivial than the destruction of life as we know +it, providing there's enough money in it. There are several Real +Programmers building video games at Atari, for example. (But not +playing them. A Real Programmer knows how to beat the machine every +time: no challange in that.) Everyone working at LucasFilm is a Real +Programmer. (It would be crazy to turn down the money of 50 million +Star Wars fans.) The proportion of Real Programmers in Computer +Graphics is somewhat lower than the norm, mostly because nobody has +found a use for Computer Graphics yet. On the other hand, all +Computer Graphics is done in FORTRAN, so there are a fair number +people doing Graphics in order to avoid having to write COBOL +programs. <P> + + +<H3> THE REAL PROGRAMMER AT PLAY</H3> + +Generally, the Real Programmer plays the same way he works -- with +computers. He is constantly amazed that his employer actually pays +him to do what he would be doing for fun anyway, although he is +careful not to express this opinion out loud. Occasionally, the Real +Programmer does step out of the office for a breath of fresh air and a +beer or two. Some tips on recognizing real programmers away from the +computer room: <P> +<UL> + +<LI> At a party, the Real Programmers are the ones in the corner +talking about operating system security and how to get around it. + +<LI> At a football game, the Real Programmer is the one comparing the +plays against his simulations printed on 11 by 14 fanfold paper. + +<LI> At the beach, the Real Programmer is the one drawing flowcharts +in the sand. + +<LI> A Real Programmer goes to a disco to watch the light show. + +<LI> At a funeral, the Real Programmer is the one saying <EM>"Poor +George. And he almost had the sort routine working before the +coronary."</EM> + +<LI> In a grocery store, the Real Programmer is the one who insists on +running the cans past the laser checkout scanner himself, because he +never could trust keypunch operators to get it right the first time. + +</UL> <P> + + +<H3> THE REAL PROGRAMMER'S NATURAL HABITAT</H3> + +What sort of environment does the Real Programmer function best in? +This is an important question for the managers of Real +Programmers. Considering the amount of money it costs to keep one on +the staff, it's best to put him (or her) in an environment where he +can get his work done. <P> + +The typical Real Programmer lives in front of a computer terminal. +Surrounding this terminal are: <P> +<UL> + +<LI> Listings of all programs the Real Programmer has ever worked on, +piled in roughly chronological order on every flat surface in the office. + +<LI> Some half-dozen or so partly filled cups of cold +coffee. Occasionally, there will be cigarette butts floating in the +coffee. In some cases, the cups will contain Orange Crush. + +<LI> Unless he is very good, there will be copies of the OS JCL manual +and the Principles of Operation open to some particularly interesting +pages. + +<LI> Taped to the wall is a line-printer Snoopy calender for the year +1969. + +<LI> Strewn about the floor are several wrappers for peanut butter +filled cheese bars (the type that are made stale at the bakery so they +can't get any worse while waiting in the vending machine). + +<LI> Hiding in the top left-hand drawer of the desk is a stash of +double stuff Oreos for special occasions. + +<LI> Underneath the Oreos is a flow-charting template, left there by +the previous occupant of the office. (Real Programmers write programs, +not documentation. Leave that to the maintainence people.) + +</UL> <P> + +The Real Programmer is capable of working 30, 40, even 50 hours at a +stretch, under intense pressure. In fact, he prefers it that way. Bad +response time doesn't bother the Real Programmer -- it gives him a +chance to catch a little sleep between compiles. If there is not +enough schedule pressure on the Real Programmer, he tends to make +things more challenging by working on some small but interesting part +of the problem for the first nine weeks, then finishing the rest in +the last week, in two or three 50-hour marathons. This not only +inpresses his manager, who was despairing of ever getting the project +done on time, but creates a convenient excuse for not doing the +documentation. In general: <P> + +<UL> + +<LI> No Real Programmer works 9 to 5. (Unless it's 9 in the evening to +5 in the morning.) + +<LI> Real Programmers don't wear neckties. + +<LI> Real Programmers don't wear high heeled shoes. + +<LI> Real Programmers arrive at work in time for lunch. [9] + +<LI> A Real Programmer might or might not know his wife's name. He +does, however, know the entire ASCII (or EBCDIC) code table. + +<LI> Real Programmers don't know how to cook. Grocery stores aren't +often open at 3 a.m., so they survive on Twinkies and coffee. + +</UL> <P> + +<H3> THE FUTURE</H3> + +What of the future? It is a matter of some concern to Real Programmers +that the latest generation of computer programmers are not being +brought up with the same outlook on life as their elders. Many of them +have never seen a computer with a front panel. Hardly anyone +graduating from school these days can do hex arithmetic without a +calculator. College graduates these days are soft -- protected from +the realities of programming by source level debuggers, text editors +that count parentheses, and user friendly operating systems. Worst of +all, some of these alleged computer scientists manage to get degrees +without ever learning FORTRAN! Are we destined to become an industry +of Unix hackers and Pascal programmers? <P> + +On the contrary. From my experience, I can only report that the +future is bright for Real Programmers everywhere. Neither OS/370 nor +FORTRAN show any signs of dying out, despite all the efforts of +Pascal programmers the world over. Even more subtle tricks, like +adding structured coding constructs to FORTRAN have failed. Oh sure, +some computer vendors have come out with FORTRAN 77 compilers, but +every one of them has a way of converting itself back into a FORTRAN +66 compiler at the drop of an option card -- to compile DO loops like +God meant them to be. <P> + +Even Unix might not be as bad on Real Programmers as it once was. The +latest release of Unix has the potential of an operating system worthy +of any Real Programmer. It has two different and subtly incompatible +user interfaces, an arcane and complicated terminal driver, virtual +memory. If you ignore the fact that it's structured, even C +programming can be appreciated by the Real Programmer: after all, +there's no type checking, variable names are seven (ten? eight?) +characters long, and the added bonus of the Pointer data type is +thrown in. It's like having the best parts of FORTRAN and assembly +language in one place. (Not to mention some of the more creative uses +for <KBD>#define</KBD>.) <P> + +No, the future isn't all that bad. Why, in the past few years, the +popular press has even commented on the bright new crop of computer +nerds and hackers ([7] and [8]) leaving places like Stanford and +M.I.T. for the Real World. From all evidence, the spirit of Real +Programming lives on in these young men and women. As long as there +are ill-defined goals, bizarre bugs, and unrealistic schedules, there +will be Real Programmers willing to jump in and Solve The Problem, +saving the documentation for later. Long live FORTRAN! <P> + +<H3>ACKNOWLEGEMENT</H3> + +I would like to thank Jan E., Dave S., Rich G., Rich E. for their help +in characterizing the Real Programmer, Heather B. for the +illustration, Kathy E. for putting up with it, and <kbd>atd!avsdS:mark</kbd> for +the initial inspriration. <P> + +<H3>REFERENCES</H3> + +[1] Feirstein, B., <em>Real Men Don't Eat Quiche</em>, New York, + Pocket Books, 1982. <P> + +[2] Wirth, N., <em>Algorithms + Datastructures = Programs</em>, + Prentice Hall, 1976. <P> + +[3] Xerox PARC editors . . . <P> + +[4] Finseth, C., <em>Theory and Practice of Text Editors - + or - a Cookbook for an EMACS</em>, B.S. Thesis, + MIT/LCS/TM-165, Massachusetts Institute of Technology, + May 1980. <P> + +[5] Weinberg, G., <em>The Psychology of Computer Programming</em>, + New York, Van Nostrabd Reinhold, 1971, page 110. <P> + +[6] Dijkstra, E., <em>On the GREEN Language Submitted to the DoD</em>, + Sigplan notices, Volume 3, Number 10, October 1978. <P> + +[7] Rose, Frank, <em>Joy of Hacking</em>, Science 82, Volume 3, Number 9, + November 1982, pages 58 - 66. <P> + +[8] The Hacker Papers, <em>Psychology Today</em>, August 1980. <P> + +[9] <em>Datamation</em>, July, 1983, pp. 263-265. <P> + +<hr> + +<ADDRESS> <a href="index.html">Hacker's Wisdom</a>/ Real Programmers +Don't Use PASCAL </ADDRESS> + +<!-- hhmts start --> +Last modified: Wed Mar 27 17:48:50 EST 1996 diff --git a/lib/kernel/test/prim_file_SUITE_data/realmen.html.gz b/lib/kernel/test/prim_file_SUITE_data/realmen.html.gz Binary files differnew file mode 100644 index 0000000000..9c662ff3c0 --- /dev/null +++ b/lib/kernel/test/prim_file_SUITE_data/realmen.html.gz diff --git a/lib/kernel/test/ram_file_SUITE.erl b/lib/kernel/test/ram_file_SUITE.erl new file mode 100644 index 0000000000..55c9497670 --- /dev/null +++ b/lib/kernel/test/ram_file_SUITE.erl @@ -0,0 +1,651 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2001-2009. 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(ram_file_SUITE). + +-export([all/1, + %% init/1, fini/1, + init_per_testcase/2, fin_per_testcase/2]). +-export([open_modes/1, open_old_modes/1, pread_pwrite/1, position/1, + truncate/1, sync/1, get_set_file/1, compress/1, uuencode/1, + large_file_errors/1, large_file_light/1, large_file_heavy/1]). + +-include("test_server.hrl"). +-include_lib("kernel/include/file.hrl"). + +-define(FILE_MODULE, file). % Name of module to test +-define(RAM_FILE_MODULE, ram_file). % Name of module to test + +%%-------------------------------------------------------------------------- + +all(suite) -> + [open_modes, open_old_modes, pread_pwrite, position, + truncate, sync, get_set_file, compress, uuencode, + large_file_errors, large_file_light, large_file_heavy]. + +init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> + Time = + case Func of + large_file_heavy -> + ?t:minutes(5); + _ -> + ?t:seconds(10) + end, + Dog = ?t:timetrap(Time), + %% error_logger:info_msg("~p:~p *****~n", [?MODULE, Func]), + [{watchdog, Dog} | Config]. + +fin_per_testcase(_Func, Config) -> + %% error_logger:info_msg("~p:~p END *****~n", [?MODULE, Func]), + Dog = ?config(watchdog, Config), + ?t:timetrap_cancel(Dog). + +%%-------------------------------------------------------------------------- +%% Test suites + +open_modes(suite) -> + []; +open_modes(doc) -> + ["Test that the basic read, write and binary options works for open/2."]; +open_modes(Config) when is_list(Config) -> + ?line Str1 = "The quick brown fox ", + ?line Str2 = "jumps over a lazy dog ", + ?line Str = Str1 ++ Str2, + ?line Bin1 = list_to_binary(Str1), + ?line Bin2 = list_to_binary(Str2), + ?line Bin = list_to_binary(Str), + %% + open_read_write(?FILE_MODULE, Str1, [ram, read, write], Str2), + open_read(?FILE_MODULE, Str, [ram]), + open_read_write(?FILE_MODULE, Bin1, [ram, binary, read, write], Bin2), + open_read(?FILE_MODULE, Bin, [ram, binary, read]), + %% + ok. + +open_old_modes(suite) -> + []; +open_old_modes(doc) -> + ["Test that the old style read, write and binary options ", + "works for open/2."]; +open_old_modes(Config) when is_list(Config) -> + ?line Str1 = "The quick brown fox ", + ?line Str2 = "jumps over a lazy dog ", + ?line Str = Str1 ++ Str2, + ?line Bin1 = list_to_binary(Str1), + ?line Bin2 = list_to_binary(Str2), + ?line Bin = list_to_binary(Str), + %% + open_read_write(?RAM_FILE_MODULE, Str1, read_write, Str2), + open_read(?RAM_FILE_MODULE, Str, read), + open_read_write(?RAM_FILE_MODULE, Bin1, {binary, read_write}, Bin2), + open_read(?RAM_FILE_MODULE, Bin, {binary, read}), + %% + ok. + +open_read_write(Module, Data1, Options, Data2) -> + ?line io:format("~p:open_read_write(~p, ~p, ~p, ~p)~n", + [?MODULE, Module, Data1, Options, Data2]), + %% + ?line Size1 = sizeof(Data1), + ?line Size2 = sizeof(Data2), + ?line Data = append(Data1, Data2), + ?line Size = Size1 + Size2, + %% + ?line {ok, Fd} = Module:open(Data1, Options), + ?line {ok, Data1} = Module:read(Fd, Size1), + ?line eof = Module:read(Fd, 1), + ?line {ok, Zero} = Module:read(Fd, 0), + ?line 0 = sizeof(Zero), + ?line ok = Module:write(Fd, Data2), + ?line {ok, 0} = Module:position(Fd, bof), + ?line {ok, Data} = Module:read(Fd, Size), + ?line eof = Module:read(Fd, 1), + ?line {ok, Zero} = Module:read(Fd, 0), + ?line ok = Module:close(Fd), + %% + ?line ok. + +open_read(Module, Data, Options) -> + ?line io:format("~p:open_read(~p, ~p, ~p)~n", + [?MODULE, Module, Data, Options]), + %% + ?line Size = sizeof(Data), + %% + ?line {ok, Fd} = Module:open(Data, Options), + ?line {ok, Data} = Module:read(Fd, Size), + ?line eof = Module:read(Fd, 1), + ?line {ok, Zero} = Module:read(Fd, 0), + ?line 0 = sizeof(Zero), + ?line {error, ebadf} = Module:write(Fd, Data), + ?line {ok, 0} = Module:position(Fd, bof), + ?line {ok, Data} = Module:read(Fd, Size), + ?line eof = Module:read(Fd, 1), + ?line {ok, Zero} = Module:read(Fd, 0), + ?line ok = Module:close(Fd), + %% + ?line ok. + + + +pread_pwrite(suite) -> + []; +pread_pwrite(doc) -> + ["Test that pread/2,3 and pwrite/2,3 works."]; +pread_pwrite(Config) when is_list(Config) -> + ?line Str = "Flygande b�ckaziner s�ka hwila p� mjuqa tuvor x", + ?line Bin = list_to_binary(Str), + %% + pread_pwrite_test(?FILE_MODULE, Str, [ram, read, write]), + pread_pwrite_test(?FILE_MODULE, Bin, [ram, binary, read, write]), + pread_pwrite_test(?RAM_FILE_MODULE, Str, [read, write]), + pread_pwrite_test(?RAM_FILE_MODULE, Bin, {binary, read_write}), + %% + ok. + +pread_pwrite_test(Module, Data, Options) -> + ?line io:format("~p:pread_pwrite_test(~p, ~p, ~p)~n", + [?MODULE, Module, Data, Options]), + %% + ?line Size = sizeof(Data), + %% + ?line {ok, Fd} = Module:open([], Options), + ?line ok = Module:pwrite(Fd, 0, Data), + ?line {ok, Data} = Module:pread(Fd, 0, Size+1), + ?line eof = Module:pread(Fd, Size+1, 1), + ?line {ok, Zero} = Module:pread(Fd, Size+1, 0), + ?line 0 = sizeof(Zero), + ?line ok = Module:pwrite(Fd, [{0, Data}, {Size+17, Data}]), + ?line {ok, [Data, + eof, + Data, + Zero]} = Module:pread(Fd, [{Size+17, Size+1}, + {2*Size+17+1, 1}, + {0, Size}, + {2*Size+17+1, 0}]), + ?line ok = Module:close(Fd), + %% + ?line ok. + +position(suite) -> + []; +position(doc) -> + ["Test that position/2 works."]; +position(Config) when is_list(Config) -> + ?line Str = "Att vara eller icke vara, det �r fr�gan. ", + ?line Bin = list_to_binary(Str), + %% + position_test(?FILE_MODULE, Str, [ram, read]), + position_test(?FILE_MODULE, Bin, [ram, binary]), + position_test(?RAM_FILE_MODULE, Str, [read]), + position_test(?RAM_FILE_MODULE, Bin, {binary, read}), + %% + ok. + +position_test(Module, Data, Options) -> + ?line io:format("~p:position_test(~p, ~p, ~p)~n", + [?MODULE, Module, Data, Options]), + %% + ?line Size = sizeof(Data), + ?line Size_7 = Size+7, + %% + ?line Slice_0_2 = slice(Data, 0, 2), + ?line Slice_0_3 = slice(Data, 0, 3), + ?line Slice_2_5 = slice(Data, 2, 5), + ?line Slice_3_4 = slice(Data, 3, 4), + ?line Slice_5 = slice(Data, 5, Size), + %% + ?line {ok, Fd} = Module:open(Data, Options), + %% + ?line io:format("CUR positions"), + ?line {ok, Slice_0_2} = Module:read(Fd, 2), + ?line {ok, 2} = Module:position(Fd, cur), + ?line {ok, Slice_2_5} = Module:read(Fd, 5), + ?line {ok, 3} = Module:position(Fd, {cur, -4}), + ?line {ok, Slice_3_4} = Module:read(Fd, 4), + ?line {ok, 0} = Module:position(Fd, {cur, -7}), + ?line {ok, Slice_0_3} = Module:read(Fd, 3), + ?line {ok, 0} = Module:position(Fd, {cur, -3}), + ?line {error, einval} = Module:position(Fd, {cur, -1}), + ?line {ok, 0} = Module:position(Fd, 0), + ?line {ok, 2} = Module:position(Fd, {cur, 2}), + ?line {ok, Slice_2_5} = Module:read(Fd, 5), + ?line {ok, Size_7} = Module:position(Fd, {cur, Size}), + ?line {ok, Zero} = Module:read(Fd, 0), + ?line 0 = sizeof(Zero), + ?line eof = Module:read(Fd, 1), + %% + ?line io:format("Absolute and BOF positions"), + ?line {ok, Size} = Module:position(Fd, Size), + ?line eof = Module:read(Fd, 1), + ?line {ok, 5} = Module:position(Fd, 5), + ?line {ok, Slice_5} = Module:read(Fd, Size), + ?line {ok, 2} = Module:position(Fd, {bof, 2}), + ?line {ok, Slice_2_5} = Module:read(Fd, 5), + ?line {ok, 3} = Module:position(Fd, 3), + ?line {ok, Slice_3_4} = Module:read(Fd, 4), + ?line {ok, 0} = Module:position(Fd, bof), + ?line {ok, Slice_0_2} = Module:read(Fd, 2), + ?line {ok, Size_7} = Module:position(Fd, {bof, Size_7}), + ?line {ok, Zero} = Module:read(Fd, 0), + %% + ?line io:format("EOF positions"), + ?line {ok, Size} = Module:position(Fd, eof), + ?line eof = Module:read(Fd, 1), + ?line {ok, 5} = Module:position(Fd, {eof, -Size+5}), + ?line {ok, Slice_5} = Module:read(Fd, Size), + ?line {ok, 2} = Module:position(Fd, {eof, -Size+2}), + ?line {ok, Slice_2_5} = Module:read(Fd, 5), + ?line {ok, 3} = Module:position(Fd, {eof, -Size+3}), + ?line {ok, Slice_3_4} = Module:read(Fd, 4), + ?line {ok, 0} = Module:position(Fd, {eof, -Size}), + ?line {ok, Slice_0_2} = Module:read(Fd, 2), + ?line {ok, Size_7} = Module:position(Fd, {eof, 7}), + ?line {ok, Zero} = Module:read(Fd, 0), + ?line eof = Module:read(Fd, 1), + %% + ?line ok. + + + +truncate(suite) -> + []; +truncate(doc) -> + ["Test that truncate/1 works."]; +truncate(Config) when is_list(Config) -> + ?line Str = "M�n �dlare att lida och f�rdraga " + ++ "ett bittert �des stygn av pilar, ", + ?line Bin = list_to_binary(Str), + %% + ok = truncate_test(?FILE_MODULE, Str, [ram, read, write]), + ok = truncate_test(?FILE_MODULE, Bin, [ram, binary, read, write]), + ok = truncate_test(?RAM_FILE_MODULE, Str, read_write), + ok = truncate_test(?RAM_FILE_MODULE, Bin, [binary, read, write]), + %% + {error, eacces} = truncate_test(?FILE_MODULE, Str, [ram]), + {error, eacces} = truncate_test(?FILE_MODULE, Bin, [ram, binary, read]), + {error, eacces} = truncate_test(?RAM_FILE_MODULE, Str, read), + {error, eacces} = truncate_test(?RAM_FILE_MODULE, Bin, {binary, read}), + %% + ok. + +truncate_test(Module, Data, Options) -> + ?line io:format("~p:truncate_test(~p, ~p, ~p)~n", + [?MODULE, Module, Data, Options]), + %% + ?line Size = sizeof(Data), + ?line Size1 = Size-2, + ?line Data1 = slice(Data, 0, Size1), + %% + ?line {ok, Fd} = Module:open(Data, Options), + ?line {ok, Size1} = Module:position(Fd, Size1), + ?line case Module:truncate(Fd) of + ok -> + ?line {ok, 0} = Module:position(Fd, 0), + ?line {ok, Data1} = Module:read(Fd, Size), + ?line ok = Module:close(Fd), + ?line ok; + Error -> + ?line ok = Module:close(Fd), + ?line Error + end. + + + +sync(suite) -> + []; +sync(doc) -> + ["Test that sync/1 at least does not crash."]; +sync(Config) when is_list(Config) -> + ?line Str = "�n att ta till vapen mot ett hav av kval. ", + ?line Bin = list_to_binary(Str), + %% + sync_test(?FILE_MODULE, Str, [ram, read, write]), + sync_test(?FILE_MODULE, Bin, [ram, binary, read, write]), + sync_test(?RAM_FILE_MODULE, Str, read_write), + sync_test(?RAM_FILE_MODULE, Bin, [binary, read, write]), + %% + sync_test(?FILE_MODULE, Str, [ram]), + sync_test(?FILE_MODULE, Bin, [ram, binary, read]), + sync_test(?RAM_FILE_MODULE, Str, read), + sync_test(?RAM_FILE_MODULE, Bin, {binary, read}), + %% + ok. + +sync_test(Module, Data, Options) -> + ?line io:format("~p:sync_test(~p, ~p, ~p)~n", + [?MODULE, Module, Data, Options]), + %% + ?line Size = sizeof(Data), + %% + ?line {ok, Fd} = Module:open(Data, Options), + ?line ok = Module:sync(Fd), + ?line {ok, Data} = Module:read(Fd, Size+1), + ?line ok. + + + +get_set_file(suite) -> + []; +get_set_file(doc) -> + ["Tests get_file/1, set_file/2, get_file_close/1 and get_size/1."]; +get_set_file(Config) when is_list(Config) -> + %% These two strings should not be of equal length. + ?line Str = "N�r h�gan nord blir sn�bet�ckt, ", + ?line Str2 = "f�r alla harar byta dr�kt. ", + ?line Bin = list_to_binary(Str), + ?line Bin2 = list_to_binary(Str2), + %% + ok = get_set_file_test(Str, read_write, Str2), + ok = get_set_file_test(Bin, [binary, read, write], Bin2), + ok = get_set_file_test(Str, read, Str2), + ok = get_set_file_test(Bin, [binary, read], Bin2), + %% + ok. + +get_set_file_test(Data, Options, Data2) -> + ?line io:format("~p:get_set_file_test(~p, ~p, ~p)~n", + [?MODULE, Data, Options, Data2]), + %% + ?line Size = sizeof(Data), + ?line Size2 = sizeof(Data2), + %% + ?line {ok, Fd} = ?RAM_FILE_MODULE:open(Data, Options), + ?line {ok, Size} = ?RAM_FILE_MODULE:get_size(Fd), + ?line {ok, Data} = ?RAM_FILE_MODULE:get_file(Fd), + ?line {ok, Data} = ?RAM_FILE_MODULE:get_file_close(Fd), + ?line {error, einval} = ?RAM_FILE_MODULE:get_size(Fd), + ?line {ok, Fd2} = ?RAM_FILE_MODULE:open(Data, Options), + ?line case ?RAM_FILE_MODULE:set_file(Fd2, Data2) of + {ok, Size2} -> + ?line {ok, Size2} = ?RAM_FILE_MODULE:get_size(Fd2), + ?line {ok, Data2} = ?RAM_FILE_MODULE:get_file(Fd2), + ?line {ok, Data2} = ?RAM_FILE_MODULE:get_file_close(Fd2), + ?line ok; + {error, _} = Error -> + ?line {ok, Data} = ?RAM_FILE_MODULE:get_file_close(Fd2), + ?line Error + end. + + + +compress(suite) -> + []; +compress(doc) -> + ["Test that compress/1 and uncompress/1 works."]; +compress(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line Real = filename:join(Data, "realmen.html"), + ?line RealGz = filename:join(Data, "realmen.html.gz"), + %% + %% Uncompress test + %% + ?line {ok, FdReal} = ?FILE_MODULE:open(Real, []), + ?line {ok, Fd} = ?FILE_MODULE:open([], [ram, read, write]), + ?line {ok, FdRealGz} = ?FILE_MODULE:open(RealGz, []), + %% + ?line {ok, SzGz} = ?FILE_MODULE:copy(FdRealGz, Fd), + ?line {ok, Sz} = ?RAM_FILE_MODULE:uncompress(Fd), + ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof), + ?line true = compare(FdReal, Fd), + %% + ?line true = (SzGz =< Sz), + %% + %% Compress and uncompress test + %% + ?line {ok, 0} = ?FILE_MODULE:position(FdReal, bof), + ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof), + ?line ok = ?FILE_MODULE:truncate(Fd), + ?line {ok, Sz} = ?FILE_MODULE:copy(FdReal, Fd), + ?line {ok, SzGz} = ?RAM_FILE_MODULE:compress(Fd), + ?line {ok, Sz} = ?RAM_FILE_MODULE:uncompress(Fd), + ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof), + ?line {ok, 0} = ?FILE_MODULE:position(FdReal, bof), + ?line true = compare(FdReal, Fd), + %% + ?line ok = ?FILE_MODULE:close(FdReal), + ?line ok = ?FILE_MODULE:close(Fd), + ?line ok = ?FILE_MODULE:close(FdRealGz), + + + %% Test uncompressing data that will be expanded many times. + ?line Huge = iolist_to_binary(mk_42(18)), + ?line HugeSize = byte_size(Huge), + ?line HugeGz = zlib:gzip(Huge), + + ?line {ok,HugeFd} = ?FILE_MODULE:open([], [ram,read,write,binary]), + ?line ok = ?FILE_MODULE:write(HugeFd, HugeGz), + ?line {ok,HugeSize} = ?RAM_FILE_MODULE:uncompress(HugeFd), + ?line {ok,0} = ?FILE_MODULE:position(HugeFd, bof), + ?line {ok,Huge} = ?FILE_MODULE:read(HugeFd, HugeSize), + + %% Uncompressing again should do nothing. + ?line {ok,HugeSize} = ?RAM_FILE_MODULE:uncompress(HugeFd), + ?line {ok,0} = ?FILE_MODULE:position(HugeFd, bof), + ?line {ok,Huge} = ?FILE_MODULE:read(HugeFd, HugeSize), + + ?line ok = ?FILE_MODULE:close(HugeFd), + + ok. + +mk_42(0) -> + [42]; +mk_42(N) -> + B = mk_42(N-1), + [B|B]. + +uuencode(suite) -> + []; +uuencode(doc) -> + ["Test that uuencode/1 and uudecode/1 works."]; +uuencode(Config) when is_list(Config) -> + ?line Data = ?config(data_dir, Config), + ?line Real = filename:join(Data, "realmen.html"), + ?line RealUu = filename:join(Data, "realmen.html.uu"), + %% + %% Uudecode test + %% + ?line {ok, FdReal} = ?FILE_MODULE:open(Real, []), + ?line {ok, Fd} = ?FILE_MODULE:open([], [ram, read, write]), + ?line {ok, FdRealUu} = ?FILE_MODULE:open(RealUu, []), + %% + ?line {ok, SzUu} = ?FILE_MODULE:copy(FdRealUu, Fd), + ?line {ok, Sz} = ?RAM_FILE_MODULE:uudecode(Fd), + ?line true = (Sz =< SzUu), + ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof), + ?line true = compare(FdReal, Fd), + %% + %% Uuencode and decode test + %% + ?line {ok, 0} = ?FILE_MODULE:position(FdReal, bof), + ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof), + ?line ok = ?FILE_MODULE:truncate(Fd), + ?line {ok, Sz} = ?FILE_MODULE:copy(FdReal, Fd), + ?line {ok, SzUu} = ?RAM_FILE_MODULE:uuencode(Fd), + ?line true = (Sz =< SzUu), + ?line {ok, Sz } = ?RAM_FILE_MODULE:uudecode(Fd), + ?line {ok, 0} = ?FILE_MODULE:position(FdReal, bof), + ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof), + ?line true = compare(FdReal, Fd), + %% + ?line ok = ?FILE_MODULE:close(FdReal), + ?line ok = ?FILE_MODULE:close(Fd), + ?line ok = ?FILE_MODULE:close(FdRealUu), + ok. + + + +large_file_errors(suite) -> + []; +large_file_errors(doc) -> + ["Test error checking of large file offsets."]; +large_file_errors(Config) when is_list(Config) -> + ?line TwoGig = 1 bsl 31, + ?line {ok,Fd} = ?RAM_FILE_MODULE:open("1234567890", [read,write]), + ?line {error, einval} = ?FILE_MODULE:read(Fd, TwoGig), + ?line {error, badarg} = ?FILE_MODULE:read(Fd, -1), + ?line {error, einval} = ?FILE_MODULE:position(Fd, {bof,TwoGig}), + ?line {error, einval} = ?FILE_MODULE:position(Fd, {bof,-TwoGig-1}), + ?line {error, einval} = ?FILE_MODULE:position(Fd, {bof,-1}), + ?line {error, einval} = ?FILE_MODULE:position(Fd, {cur,TwoGig}), + ?line {error, einval} = ?FILE_MODULE:position(Fd, {cur,-TwoGig-1}), + ?line {error, einval} = ?FILE_MODULE:position(Fd, {eof,TwoGig}), + ?line {error, einval} = ?FILE_MODULE:position(Fd, {eof,-TwoGig-1}), + ?line {error, einval} = ?FILE_MODULE:pread(Fd, TwoGig, 1), + ?line {error, einval} = ?FILE_MODULE:pread(Fd, -TwoGig-1, 1), + ?line {error, einval} = ?FILE_MODULE:pread(Fd, -1, 1), + ?line {error, einval} = ?FILE_MODULE:pwrite(Fd, TwoGig, "@"), + ?line {error, einval} = ?FILE_MODULE:pwrite(Fd, -TwoGig-1, "@"), + ?line {error, einval} = ?FILE_MODULE:pwrite(Fd, -1, "@"), + ?line {error, einval} = ?FILE_MODULE:pread(Fd, TwoGig, 0), + ?line {error, einval} = ?FILE_MODULE:pread(Fd, -TwoGig-1, 0), + ?line {error, einval} = ?FILE_MODULE:pread(Fd, -1, 0), + ?line ok = ?FILE_MODULE:close(Fd), + ok. + + + +large_file_light(suite) -> + []; +large_file_light(doc) -> + ["Test light operations on a \"large\" ram_file."]; +large_file_light(Config) when is_list(Config) -> + ?line PrivDir = ?config(priv_dir, Config), + %% Marker for next test case that is to heavy to run in a suite. + ?line ok = ?FILE_MODULE:write_file( + filename:join(PrivDir, large_file_light), + <<"TAG">>), + %% + ?line Data = "abcdefghijklmnopqrstuvwzyz", + ?line Size = sizeof(Data), + ?line Max = (1 bsl 31) - 1, + ?line Max__1 = Max - 1, + ?line {ok, Fd} = ?RAM_FILE_MODULE:open(Data, [read]), + ?line {ok, Data} = ?FILE_MODULE:read(Fd, Size+1), + ?line {ok, Max__1} = ?FILE_MODULE:position(Fd, {eof, Max-Size-1}), + ?line eof = ?FILE_MODULE:read(Fd, 1), + ?line {ok, Max} = ?FILE_MODULE:position(Fd, {bof, Max}), + ?line {ok, Zero} = ?FILE_MODULE:read(Fd, 0), + ?line 0 = sizeof(Zero), + ?line eof = ?FILE_MODULE:read(Fd, 1), + ?line eof = ?FILE_MODULE:pread(Fd, Max__1, 1), + ?line {ok, Zero} = ?FILE_MODULE:pread(Fd, Max, 0), + ?line eof = ?FILE_MODULE:pread(Fd, Max, 1), + ok. + + + +large_file_heavy(suite) -> + []; +large_file_heavy(doc) -> + ["Test operations on a maximum size (2 GByte - 1) ram_file."]; +large_file_heavy(Config) when is_list(Config) -> + ?line PrivDir = ?config(priv_dir, Config), + %% Check previous test case marker. + case ?FILE_MODULE:read_file_info( + filename:join(PrivDir, large_file_light)) of + {ok,_} -> + {skipped,"Too heavy for casual testing!"}; + _ -> + do_large_file_heavy(Config) + end. + +do_large_file_heavy(_Config) -> + ?line Data = "qwertyuiopasdfghjklzxcvbnm", + ?line Size = sizeof(Data), + ?line Max = (1 bsl 31) - 1, + ?line Max__1 = Max - 1, + ?line Max__3 = Max - 3, + ?line {ok, Fd} = ?RAM_FILE_MODULE:open(Data, [read,write]), + ?line {ok, Data} = ?FILE_MODULE:read(Fd, Size+1), + ?line {ok, Max} = ?FILE_MODULE:position(Fd, {eof, Max-Size}), + ?line eof = ?FILE_MODULE:read(Fd, 1), + ?line erlang:display({allocating,2,'GByte',please,be,patient,'...'}), + ?line ok = ?FILE_MODULE:write(Fd, ""), + ?line erlang:display({allocating,2,'GByte',succeeded}), + ?line {ok, Max__1} = ?FILE_MODULE:position(Fd, {eof, -1}), + ?line {ok, [0]} = ?FILE_MODULE:read(Fd, 1), + ?line {ok, []} = ?FILE_MODULE:read(Fd, 0), + ?line eof = ?FILE_MODULE:read(Fd, 1), + ?line ok = ?FILE_MODULE:pwrite(Fd, Max-3, "TAG"), + ?line {ok, Max} = ?FILE_MODULE:position(Fd, cur), + ?line {ok, Max__3} = ?FILE_MODULE:position(Fd, {eof, -3}), + ?line {ok, "TAG"} = ?FILE_MODULE:read(Fd, 3+1), + ?line {ok, Max__3} = ?FILE_MODULE:position(Fd, {cur, -3}), + ?line ok = ?FILE_MODULE:write(Fd, "tag"), + ?line {ok, Max} = ?FILE_MODULE:position(Fd, cur), + ?line {ok, 0} = ?FILE_MODULE:position(Fd, bof), + ?line {ok, "tag"} = ?FILE_MODULE:pread(Fd, Max__3, 3+1), + ?line {ok, 0} = ?FILE_MODULE:position(Fd, cur), + ?line ok = ?FILE_MODULE:close(Fd), + ok. + +%%-------------------------------------------------------------------------- +%% Utility functions + +compare(FdA, FdB) -> + Size = 65536, + case {?FILE_MODULE:read(FdA, Size), ?FILE_MODULE:read(FdB, Size)} of + {{error, _} = Error, _} -> + Error; + {_, {error, _} = Error} -> + Error; + {{ok, A}, {ok, B}} -> + case compare_data(A, B) of + true -> + compare(FdA, FdB); + false -> + false + end; + {eof, eof} -> + true; + _ -> + false + end. + +compare_data(A, B) when is_list(A), is_list(B) -> + list_to_binary(A) == list_to_binary(B); +compare_data(A, B) when is_list(A), is_binary(B) -> + list_to_binary(A) == B; +compare_data(A, B) when is_binary(A), is_list(B) -> + A == list_to_binary(B); +compare_data(A, B) when is_binary(A), is_binary(B) -> + A == B. + +sizeof(Data) when is_list(Data) -> + length(Data); +sizeof(Data) when is_binary(Data) -> + byte_size(Data). + +append(Data1, Data2) when is_list(Data1), is_list(Data2) -> + Data1 ++ Data2; +append(Data1, Data2) when is_binary(Data1), is_binary(Data2) -> + list_to_binary([Data1 | Data2]). + +slice(Data, Start, Length) when is_list(Data) -> + lists:sublist(Data, Start+1, Length); +slice(Data, Start, Length) when is_binary(Data) -> + {_, Bin} = split_binary(Data, Start), + if + Length >= byte_size(Bin) -> + Bin; + true -> + {B, _} = split_binary(Bin, Length), + B + end. + diff --git a/lib/kernel/test/ram_file_SUITE_data/corrupted.gz b/lib/kernel/test/ram_file_SUITE_data/corrupted.gz new file mode 100644 index 0000000000..16331b350c --- /dev/null +++ b/lib/kernel/test/ram_file_SUITE_data/corrupted.gz @@ -0,0 +1,5 @@ + � +========================================== +This file has a correct GZIP magic ID, but the rest of the +header is corrupt. Reading this file should result in an +error. diff --git a/lib/kernel/test/ram_file_SUITE_data/corrupted.uu b/lib/kernel/test/ram_file_SUITE_data/corrupted.uu new file mode 100644 index 0000000000..213cd22320 --- /dev/null +++ b/lib/kernel/test/ram_file_SUITE_data/corrupted.uu @@ -0,0 +1,528 @@ +M/%1)5$Q%/E)E86P@4')O9W)A;6UE<G,@1&]N)W0@57-E(%!!4T-!3#PO5$E4 +M3$4^"@H\2#(@86QI9VX]8V5N=&5R/E)E86P@4')O9W)A;6UE<G,@1&]N)W0@ +M57-E(%!!4T-!3#PO2#(^"@H\2#0@86QI9VX]8V5N=&5R/CQE;3Y%9"!0;W-T +M/&)R/@I'<F%P:&EC(%-O9G1W87)E(%-Y<W1E;7,\8G(^"@I0+D\N($)O>" V +M-S,\8G(^"C(U,3$W(%,N5RX@4&%R:W=A>3QB<CX*5VEL<V]N=FEL;&4L($]2 +M(#DW,#<P/&)R/@I#;W!Y<FEG:'0@*&,I(#$Y.#(\8G(^"CPO2#0^/"]%33X* +M"@H\2#0@86QI9VX]8V5N=&5R/CQ+0D0^("AD96-V87@@?"!U8V)V87@@?"!C +M8F]S9R!\('!U<BUE92!\(&QB;"UU;FEX*2%T96ML86)S(6]G8W9A>"%G<W,Q +M,30T(65V<#PO2T)$/CPO2#0^"@H*0F%C:R!I;B!T:&4@9V]O9"!O;&0@9&%Y +M<R M+2!T:&4@(D=O;&1E;B!%<F$B(&]F(&-O;7!U=&5R<RP@:70@=V%S"F5A +M<WD@=&\@<V5P87)A=&4@=&AE(&UE;B!F<F]M('1H92!B;WES("AS;VUE=&EM +M97,@8V%L;&5D(")296%L($UE;B(*86YD(")1=6EC:&4@16%T97)S(B!I;B!T +M:&4@;&ET97)A='5R92DN($1U<FEN9R!T:&ES('!E<FEO9"P@=&AE(%)E86P* +M365N('=E<F4@=&AE(&]N97,@=&AA="!U;F1E<G-T;V]D(&-O;7!U=&5R('!R +M;V=R86UM:6YG+"!A;F0@=&AE(%%U:6-H90I%871E<G,@=V5R92!T:&4@;VYE +M<R!T:&%T(&1I9&XG="X@02!R96%L(&-O;7!U=&5R('!R;V=R86UM97(@<V%I +M9 IT:&EN9W,@;&EK92 \2T)$/B)$3R Q,"!)/3$L,3 B/"]+0D0^(&%N9" \ +M2T)$/B)!0D5.1"(\+TM"1#X@*'1H97D*86-T=6%L;'D@=&%L:V5D(&EN(&-A +M<&ET86P@;&5T=&5R<RP@>6]U('5N9&5R<W1A;F0I+"!A;F0@=&AE(')E<W0@ +M;V8*=&AE('=O<FQD('-A:60@=&AI;F=S(&QI:V4@/$5-/B)C;VUP=71E<G,@ +M87)E('1O;R!C;VUP;&EC871E9"!F;W(*;64B/"]%33X@86YD(#Q%33XB22!C +M86XG="!R96QA=&4@=&\@8V]M<'5T97)S("TM('1H97DG<F4@<V\*:6UP97)S +M;VYA;"(\+T5-/BX@("A!('!R979I;W5S('=O<FL@6S%=('!O:6YT<R!O=70@ +M=&AA="!296%L($UE;B!D;VXG= HB<F5L871E(B!T;R!A;GET:&EN9RP@86YD +M(&%R96XG="!A9G)A:60@;V8@8F5I;F<@:6UP97)S;VYA;"XI(#Q0/@H*0G5T +M+"!A<R!U<W5A;"P@=&EM97,@8VAA;F=E+B!792!A<F4@9F%C960@=&]D87D@ +M=VET:"!A('=O<FQD(&EN('=H:6-H"FQI='1L92!O;&0@;&%D:65S(&-A;B!G +M970@8V]M<'5T97)I>F5D(&UI8W)O=V%V92!O=F5N<RP@,3(@>65A<B!O;&0* +M:VED<R!C86X@8FQO=R!296%L($UE;B!O=70@;V8@=&AE('=A=&5R('!L87EI +M;F<@07-T97)O:61S(&%N9"!086,M36%N+ IA;F0@86YY;VYE(&-A;B!B=7D@ +M86YD(&5V96X@=6YD97)S=&%N9"!T:&5I<B!V97)Y(&]W;B!097)S;VYA; I# +M;VUP=71E<BX@5&AE(%)E86P@4')O9W)A;6UE<B!I<R!I;B!D86YG97(@;V8@ +M8F5C;VUI;F<@97AT:6YC="P@;V8*8F5I;F<@<F5P;&%C960@8GD@:&EG:"US +M8VAO;VP@<W1U9&5N=',@=VET:"!44D%32"TX,',A(#Q0/@H*5&AE<F4@:7,@ +M82!C;&5A<B!N965D('1O('!O:6YT(&]U="!T:&4@9&EF9F5R96YC97,@8F5T +M=V5E;B!T:&4@='EP:6-A; IH:6=H+7-C:&]O;"!J=6YI;W(@4&%C+4UA;B!P +M;&%Y97(@86YD(&$@4F5A;"!0<F]G<F%M;65R+B!5;F1E<G-T86YD:6YG"G1H +M97-E(&1I9F9E<F5N8V5S('=I;&P@9VEV92!T:&5S92!K:61S('-O;65T:&EN +M9R!T;R!A<W!I<F4@=&\@+2T@80IR;VQE(&UO9&5L+"!A($9A=&AE<B!&:6=U +M<F4N($ET('=I;&P@86QS;R!H96QP(&5M<&QO>65R<R!O9B!296%L"E!R;V=R +M86UM97)S('1O(')E86QI>F4@=VAY(&ET('=O=6QD(&)E(&$@;6ES=&%K92!T +M;R!R97!L86-E('1H92!296%L"E!R;V=R86UM97)S(&]N('1H96ER('-T869F +M('=I=&@@,3(@>65A<B!O;&0@4&%C+4UA;B!P;&%Y97)S("AA="!A"F-O;G-I +M9&5R86)L92!S86QA<GD@<V%V:6YG<RDN(#Q0/@H*"CQ(,SY,04Y'54%'15,\ +M+T@S/@H*5&AE(&5A<VEE<W0@=V%Y('1O('1E;&P@82!296%L(%!R;V=R86UM +M97(@9G)O;2!T:&4@8W)O=V0@:7,@8GD@=&AE"G!R;V=R86UM:6YG(&QA;F=U +M86=E(&AE("AO<B!S:&4I('5S97,N("!296%L(%!R;V=R86UM97)S('5S92!& +M3U)44D%.+@I1=6EC:&4@16%T97)S('5S92!005-#04PN($YI8VML875S(%=I +M<G1H+"!T:&4@9&5S:6=N97(@;V8@4$%30T%,+"!W87,*;VYC92!A<VME9"P@ +M/$5-/B)(;W<@9&\@>6]U('!R;VYO=6YC92!Y;W5R(&YA;64_(CPO14T^+B!( +M92!R97!L:65D"CQ%33XB66]U(&-A;B!E:71H97(@8V%L;"!M92!B>2!N86UE +M+"!P<F]N;W5N8VEN9R!I=" G5F5E<G0G+"!O<B!C86QL"FUE(&)Y('9A;'5E +M+" G5V]R=&@G+B(\+T5-/B!/;F4@8V%N('1E;&P@:6UM961I871E;'D@9G)O +M;2!T:&ES(&-O;6UE;G0*=&AA="!.:6-K;&%U<R!7:7)T:"!I<R!A(%%U:6-H +M92!%871E<BX@(%1H92!O;FQY('!A<F%M971E<B!P87-S:6YG"FUE8VAA;FES +M;2!E;F1O<G-E9"!B>2!296%L(%!R;V=R86UM97)S(&ES(&-A;&PM8GDM=F%L +M=64M<F5T=7)N+"!A<PII;7!L96UE;G1E9"!I;B!T:&4@24)-+S,W,"!&3U)4 +M4D%.($<@86YD($@@8V]M<&EL97)S+B @4F5A; IP<F]G<F%M;65R<R!D;VXG +M="!N965D(&%B<W1R86-T(&-O;F-E<'1S('1O(&=E="!T:&5I<B!J;V)S(&1O +M;F4Z('1H97D*87)E('!E<F9E8W1L>2!H87!P>2!W:71H(&$@:V5Y<'5N8V@L +M(&$@1D]25%)!3B!)5B!C;VUP:6QE<BP@86YD(&$*8F5E<BX@/% ^"@H\54P^ +M"CQ,23X@4F5A;"!0<F]G<F%M;65R<R!D;R!,:7-T(%!R;V-E<W-I;F<@:6X@ +M1D]25%)!3BX*"CQ,23X@(%)E86P@4')O9W)A;6UE<G,@9&\@4W1R:6YG($UA +M;FEP=6QA=&EO;B!I;B!&3U)44D%.+@H*/$Q)/B @4F5A;"!0<F]G<F%M;65R +M<R!D;R!!8V-O=6YT:6YG("AI9B!T:&5Y(&1O(&ET(&%T(&%L;"D@:6X@1D]2 +M5%)!3BX*"CQ,23X@(%)E86P@4')O9W)A;6UE<G,@9&\@07)T:69I8VEA;"!) +M;G1E;&QI9V5N8V4@<')O9W)A;7,@:6X@1D]25%)!3BX*/"]53#X@/% ^"@I) +M9B!Y;W4@8V%N)W0@9&\@:70@:6X@1D]25%)!3BP@9&\@:70@:6X@87-S96UB +M;'D@;&%N9W5A9V4N($EF('EO=2!C86XG=" @9&\*:70@:6X@87-S96UB;'D@ +M;&%N9W5A9V4L(&ET(&ES;B=T('=O<G1H(&1O:6YG+B \4#X*"@H\2#,^("!3 +M5%)50U154D5$(%!23T=204U-24Y'/"](,SX*"D-O;7!U=&5R('-C:65N8V4@ +M86-A9&5M:6-I86YS(&AA=F4@9V]T=&5N(&EN=&\@=&AE(")S=')U8W1U<F5D +M('!R;RT*9W)A;6UI;F<B(')U="!O=F5R('1H92!P87-T('-E=F5R86P@>65A +M<G,N(%1H97D@8VQA:6T@=&AA="!P<F]G<F%M<PIA<F4@;6]R92!E87-I;'D@ +M=6YD97)S=&]O9"!I9B!T:&4@<')O9W)A;6UE<B!U<V5S('-O;64@<W!E8VEA +M; IL86YG=6%G92!C;VYS=')U8W1S(&%N9"!T96-H;FEQ=65S+B!4:&5Y(&1O +M;B=T(&%L;"!A9W)E92!O;B!E>&%C=&QY"G=H:6-H(&-O;G-T<G5C=',L(&]F +M(&-O=7)S92P@86YD('1H92!E>&%M<&QE<R!T:&5Y('5S92!T;R!S:&]W('1H +M96ER"G!A<G1I8W5L87(@<&]I;G0@;V8@=FEE=R!I;G9A<FEA8FQY(&9I="!O +M;B!A('-I;F=L92!P86=E(&]F('-O;64*;V)S8W5R92!J;W5R;F%L(&]R(&%N +M;W1H97(@+2T@8VQE87)L>2!N;W0@96YO=6=H(&]F(&%N(&5X86UP;&4@=&\* +M8V]N=FEN8V4@86YY;VYE+B @5VAE;B!)(&=O="!O=70@;V8@<V-H;V]L+"!) +M('1H;W5G:'0@22!W87,@=&AE(&)E<W0*<')O9W)A;6UE<B!I;B!T:&4@=V]R +M;&0N($D@8V]U;&0@=W)I=&4@86X@=6YB96%T86)L92!T:6,M=&%C+71O90IP +M<F]G<F%M+"!U<V4@9FEV92!D:69F97)E;G0@8V]M<'5T97(@;&%N9W5A9V5S +M+"!A;F0@8W)E871E(#$P,# @;&EN90IP<F]G<F%M<R!T:&%T(%=/4DM%1"X@ +M("A296%L;'DA*2!4:&5N($D@9V]T(&]U="!I;G1O('1H92!296%L"E=O<FQD +M+B!->2!F:7)S="!T87-K(&EN('1H92!296%L(%=O<FQD('=A<R!T;R!R96%D +M(&%N9"!U;F1E<G-T86YD(&$*,C P+# P,"!L:6YE($9/4E1204X@<')O9W)A +M;2P@=&AE;B!S<&5E9"!I="!U<"!B>2!A(&9A8W1O<B!O9B!T=V\N($%N>0I2 +M96%L(%!R;V=R86UM97(@=VEL;"!T96QL('EO=2!T:&%T(&%L;"!T:&4@4W1R +M=6-T=7)E9"!#;V1I;F<@:6X@=&AE"G=O<FQD('=O;B=T(&AE;' @>6]U('-O +M;'9E(&$@<')O8FQE;2!L:6ME('1H870@+2T@:70@=&%K97,@86-T=6%L"G1A +M;&5N="X@4V]M92!Q=6EC:R!O8G-E<G9A=&EO;G,@;VX@4F5A;"!0<F]G<F%M +M;65R<R!A;F0@4W1R=6-T=7)E9 I0<F]G<F%M;6EN9SH@/% ^"@H\54P^"CQ, +M23X@4F5A;"!0<F]G<F%M;65R<R!A<F5N)W0@869R86ED('1O('5S92!'3U1/ +M<RX*"CQ,23X@4F5A;"!0<F]G<F%M;65R<R!C86X@=W)I=&4@9FEV92!P86=E +M(&QO;F<@1$\@;&]O<',@=VET:&]U= IG971T:6YG(&-O;F9U<V5D+@H*/$Q) +M/B!296%L(%!R;V=R86UM97)S(&5N:F]Y($%R:71H;65T:6,@248@<W1A=&5M +M96YT<R!B96-A=7-E('1H97D@;6%K90IT:&4@8V]D92!M;W)E(&EN=&5R97-T +M:6YG+@H*/$Q)/B!296%L(%!R;V=R86UM97)S('=R:71E('-E;&8M;6]D:69Y +M:6YG(&-O9&4L(&5S<&5C:6%L;'D@:68@:70*<V%V97,@=&AE;2 R,"!N86YO +M<V5C;VYD<R!I;B!T:&4@;6ED9&QE(&]F(&$@=&EG:'0@;&]O<"X*"CQ,23X@ +M(%!R;V=R86UM97)S(&1O;B=T(&YE960@8V]M;65N=',Z('1H92!C;V1E(&ES +M(&]B=FEO=7,N"@H\3$D^(%-I;F-E($9/4E1204X@9&]E<VXG="!H879E(&$@ +M<W1R=6-T=7)E9" \2T)$/DE&+"!215!%050*+BXN(%5.5$E,/"]+0D0^+"!O +M<B \2T)$/D-!4T4\+TM"1#X@<W1A=&5M96YT+"!296%L(%!R;V=R86UM97)S +M(&1O;B=T"FAA=F4@=&\@=V]R<GD@86)O=70@;F]T('5S:6YG('1H96TN($)E +M<VED97,L('1H97D@8V%N(&)E('-I;75L871E9 IW:&5N(&YE8V5S<V%R>2!U +M<VEN9R!A<W-I9VYE9" \2T)$/D=/5$\\+TM"1#YS+@H*/"]53#X@/% ^"@I$ +M871A('-T<G5C='5R97,@:&%V92!A;'-O(&=O='1E;B!A(&QO="!O9B!P<F5S +M<R!L871E;'DN($%B<W1R86-T($1A=&$*5'EP97,L(%-T<G5C='5R97,L(%!O +M:6YT97)S+"!,:7-T<RP@86YD(%-T<FEN9W,@:&%V92!B96-O;64@<&]P=6QA +M<B!I;@IC97)T86EN(&-I<F-L97,N(%=I<G1H("AT:&4@86)O=F4M;65N=&EO +M;F5D(%%U:6-H92!%871E<BD@86-T=6%L;'D*=W)O=&4@86X@96YT:7)E(&)O +M;VL@6S)=(&-O;G1E;F1I;F<@=&AA="!Y;W4@8V]U;&0@=W)I=&4@82!P<F]G +M<F%M"F)A<V5D(&]N(&1A=&$@<W1R=6-T=7)E<RP@:6YS=&5A9"!O9B!T:&4@ +M;W1H97(@=V%Y(&%R;W5N9"X@07,@86QL(%)E86P*4')O9W)A;6UE<G,@:VYO +M=RP@=&AE(&]N;'D@=7-E9G5L(&1A=&$@<W1R=6-T=7)E(&ES('1H90IA<G)A +M>2X@4W1R:6YG<RP@;&ES=',L('-T<G5C='5R97,L('-E=',@+2T@=&AE<V4@ +M87)E(&%L;"!S<&5C:6%L(&-A<V5S"F]F(&%R<F%Y<R!A;F0@86YD(&-A;B!B +M92!T<F5A=&5D('1H870@=V%Y(&IU<W0@87,@96%S:6QY('=I=&AO=70*;65S +M<VEN9R!U<"!Y;W5R('!R;V=R86UI;F<@;&%N9W5A9V4@=VET:"!A;&P@<V]R +M=',@;V8*8V]M<&QI8V%T:6]N<RX@5&AE('=O<G-T('1H:6YG(&%B;W5T(&9A +M;F-Y(&1A=&$@='EP97,@:7,@=&AA="!Y;W4@:&%V90IT;R!D96-L87)E('1H +M96TL(&%N9"!296%L(%!R;V=R86UM:6YG($QA;F=U86=E<RP@87,@=V4@86QL +M(&MN;W<L(&AA=F4*:6UP;&EC:70@='EP:6YG(&)A<V5D(&]N('1H92!F:7)S +M="!L971T97(@;V8@=&AE("AS:7@@8VAA<F%C=&5R*0IV87)I86)L92!N86UE +M+B \4#X*"@H\2#,^("!/4$52051)3D<@4UE35$5-4SPO2#,^"@I7:&%T(&MI +M;F0@;V8@;W!E<F%T:6YG('-Y<W1E;2!I<R!U<V5D(&)Y(&$@4F5A;"!0<F]G +M<F%M;65R/R @0U O33\@1V]D"F9O<F)I9" M+2!#4"]-+"!A9G1E<B!A;&PL +M(&ES(&)A<VEC86QL>2!A('1O>2!O<&5R871I;F<@<WES=&5M+B @179E;@IL +M:71T;&4@;VQD(&QA9&EE<R!A;F0@9W)A9&4@<V-H;V]L('-T=61E;G1S(&-A +M;B!U;F1E<G-T86YD(&%N9"!U<V4*0U O32X@/% ^"@I5;FEX(&ES(&$@;&]T +M(&UO<F4@8V]M<&QI8V%T960@;V8@8V]U<G-E("TM('1H92!T>7!I8V%L(%5N +M:7@@:&%C:V5R"FYE=F5R(&-A;B!R96UE;6)E<B!W:&%T('1H92 \2T)$/E!2 +M24Y4/"]+0D0^(&-O;6UA;F0@:7,@8V%L;&5D('1H:7,*=V5E:R M+2!B=70@ +M=VAE;B!I="!G971S(')I9VAT(&1O=VX@=&\@:70L(%5N:7@@:7,@82!G;&]R +M:69I960@=FED96\*9V%M92X@4&5O<&QE(&1O;B=T(&1O(%-E<FEO=7,@5V]R +M:R!O;B!5;FEX('-Y<W1E;7,Z('1H97D@<V5N9"!J;VME<PIA<F]U;F0@=&AE +M('=O<FQD(&]N(%5314Y%5"!A;F0@=W)I=&4@861V96YT=7)E(&=A;65S(&%N +M9"!R97-E87)C: IP87!E<G,N(#Q0/@H*3F\L('EO=7(@4F5A;"!0<F]G<F%M +M;65R('5S97,@3U,O,S<P+B!!(&=O;V0@<')O9W)A;6UE<B!C86X@9FEN9"!A +M;F0*=6YD97)S=&%N9"!T:&4@9&5S8W)I<'1I;VX@;V8@=&AE($E*2S,P-4D@ +M97)R;W(@:&4@:G5S="!G;W0@:6X@:&ES($I#3 IM86YU86PN("!!(&=R96%T +M('!R;V=R86UM97(@8V%N('=R:71E($I#3"!W:71H;W5T(')E9F5R<FEN9R!T +M;R!T:&4*;6%N=6%L(&%T(&%L;"X@02!T<G5L>2!O=71S=&%N9&EN9R!P<F]G +M<F%M;65R(&-A;B!F:6YD(&)U9W,@8G5R:65D(&EN"F$@-B!M96=A8GET92!C +M;W)E(&1U;7 @=VET:&]U="!U<VEN9R!A(&AE>"!C86QC=6QA=&]R+B H22!H +M879E"F%C='5A;&QY('-E96X@=&AI<R!D;VYE+BD@/% ^"@I/4R\S-S @:7,@ +M82!T<G5L>2!R96UA<FMA8FQE(&]P97)A=&EN9R!S>7-T96TN($ET)W,@<&]S +M<VEB;&4@=&\@9&5S+0IT<F]Y(&1A>7,@;V8@=V]R:R!W:71H(&$@<VEN9VQE +M(&UI<W!L86-E9"!S<&%C92P@<V\@86QE<G1N97-S(&EN('1H90IP<F]G<F%M +M;6EN9R!S=&%F9B!I<R!E;F-O=7)A9V5D+B!4:&4@8F5S="!W87D@=&\@87!P +M<F]A8V@@=&AE('-Y<W1E;0II<R!T:')O=6=H(&$@:V5Y<'5N8V@N("!3;VUE +M('!E;W!L92!C;&%I;2!T:&5R92!I<R!A(%1I;64@4VAA<FEN9PIS>7-T96T@ +M=&AA="!R=6YS(&]N($]3+S,W,"P@8G5T(&%F=&5R(&-A<F5F=6P@<W1U9'D@ +M22!H879E(&-O;64@=&\@=&AE"F-O;F-L=7-I;VX@=&AA="!T:&5Y(&%R92!M +M:7-T86ME;BX@/% ^"@H*/$@S/B @4%)/1U)!34U)3D<@5$]/3%,\+T@S/@H* +M5VAA="!K:6YD(&]F('1O;VQS(&1O97,@82!296%L(%!R;V=R86UM97(@=7-E +M/R!);B!T:&5O<GDL(&$@4F5A; I0<F]G<F%M;65R(&-O=6QD(')U;B!H:7,@ +M<')O9W)A;7,@8GD@:V5Y:6YG('1H96T@:6YT;R!T:&4@9G)O;G0@<&%N96P* +M;V8@=&AE(&-O;7!U=&5R+B!"86-K(&EN('1H92!D87ES('=H96X@8V]M<'5T +M97)S(&AA9"!F<F]N="!P86YE;',L"G1H:7,@=V%S(&%C='5A;&QY(&1O;F4@ +M;V-C87-I;VYA;&QY+B @66]U<B!T>7!I8V%L(%)E86P@4')O9W)A;6UE<@IK +M;F5W('1H92!E;G1I<F4@8F]O='-T<F%P(&QO861E<B!B>2!M96UO<GD@:6X@ +M:&5X+"!A;F0@=&]G9VQE9"!I="!I;@IW:&5N979E<B!I="!G;W0@9&5S=')O +M>65D(&)Y(&AI<R!P<F]G<F%M+B H0F%C:R!T:&5N+"!M96UO<GD@=V%S"FUE +M;6]R>2 M+2!I="!D:61N)W0@9V\@87=A>2!W:&5N('1H92!P;W=E<B!W96YT +M(&]F9BX@5&]D87DL(&UE;6]R>0IE:71H97(@9F]R9V5T<R!T:&EN9W,@=VAE +M;B!Y;W4@9&]N)W0@=V%N="!I="!T;RP@;W(@<F5M96UB97)S('1H:6YG<PIL +M;VYG(&%F=&5R('1H97DG<F4@8F5T=&5R(&9O<F=O='1E;BXI("!,96=E;F0@ +M:&%S(&ET('1H870@4V5Y;6]U<@I#<F%Y+"!I;G9E;G1O<B!O9B!T:&4@0W)A +M>2!)('-U<&5R8V]M<'5T97(@86YD(&UO<W0@;V8@0V]N=')O;"!$871A)W,* +M8V]M<'5T97)S+"!A8W1U86QL>2!T;V=G;&5D('1H92!F:7)S="!O<&5R871I +M;F<@<WES=&5M(&9O<B!T:&4@0T1#-S8P, II;B!O;B!T:&4@9G)O;G0@<&%N +M96P@9G)O;2!M96UO<GD@=VAE;B!I="!W87,@9FER<W0@<&]W97)E9 IO;BX@ +M4V5Y;6]U<BP@;F5E9&QE<W,@=&\@<V%Y+"!I<R!A(%)E86P@4')O9W)A;6UE +M<BX@/% ^"@I/;F4@;V8@;7D@9F%V;W)I=&4@4F5A;"!0<F]G<F%M;65R<R!W +M87,@82!S>7-T96US('!R;V=R86UM97(@9F]R(%1E>&%S"DEN<W1R=6UE;G1S +M+B @3VYE(&1A>2P@:&4@9V]T(&$@;&]N9R!D:7-T86YC92!C86QL(&9R;VT@ +M82!U<V5R('=H;W-E"G-Y<W1E;2!H860@8W)A<VAE9"!I;B!T:&4@;6ED9&QE +M(&]F('-O;64@:6UP;W)T86YT('=O<FLN($II;2!W87,@86)L90IT;R!R97!A +M:7(@=&AE(&1A;6%G92!O=F5R('1H92!P:&]N92P@9V5T=&EN9R!T:&4@=7-E +M<B!T;R!T;V=G;&4@:6X*9&ES:R!)+T\@:6YS=')U8W1I;VYS(&%T('1H92!F +M<F]N="!P86YE;"P@<F5P86ER:6YG('-Y<W1E;2!T86)L97,@:6X*:&5X+"!R +M96%D:6YG(')E9VES=&5R(&-O;G1E;G1S(&)A8VL@;W9E<B!T:&4@<&AO;F4N +M(%1H92!M;W)A;"!O9B!T:&ES"G-T;W)Y.B!W:&EL92!A(%)E86P@4')O9W)A +M;6UE<B!U<W5A;&QY(&EN8VQU9&5S(&$@:V5Y<'5N8V@@86YD"FQI;F5P<FEN +M=&5R(&EN(&AI<R!T;V]L:VET+"!H92!C86X@9V5T(&%L;VYG('=I=&@@:G5S +M="!A(&9R;VYT('!A;F5L"F%N9"!A('1E;&5P:&]N92!I;B!E;65R9V5N8VEE +M<RX@/% ^"@I);B!S;VUE(&-O;7!A;FEE<RP@=&5X="!E9&ET:6YG(&YO(&QO +M;F=E<B!C;VYS:7-T<R!O9B!T96X@96YG:6YE97)S"G-T86YD:6YG(&EN(&QI +M;F4@=&\@=7-E(&%N(# R.2!K97EP=6YC:"X@26X@9F%C="P@=&AE(&)U:6QD +M:6YG($D@=V]R:PII;B!D;V5S;B=T(&-O;G1A:6X@82!S:6YG;&4@:V5Y<'5N +M8V@N(%1H92!296%L(%!R;V=R86UM97(@:6X@=&AI<PIS:71U871I;VX@:&%S +M('1O(&1O(&AI<R!W;W)K('=I=&@@82!T97AT(&5D:71O<B!P<F]G<F%M+B!- +M;W-T('-Y<W1E;7,*<W5P<&QY('-E=F5R86P@=&5X="!E9&ET;W)S('1O('-E +M;&5C="!F<F]M+"!A;F0@=&AE(%)E86P@4')O9W)A;6UE<@IM=7-T(&)E(&-A +M<F5F=6P@=&\@<&EC:R!O;F4@=&AA="!R969L96-T<R!H:7,@<&5R<V]N86P@ +M<W1Y;&4N($UA;GD*<&5O<&QE(&)E;&EE=F4@=&AA="!T:&4@8F5S="!T97AT +M(&5D:71O<G,@:6X@=&AE('=O<FQD('=E<F4@=W)I='1E;B!A= I897)O>"!0 +M86QO($%L=&\@4F5S96%R8V@@0V5N=&5R(&9O<B!U<V4@;VX@=&AE:7(@06QT +M;R!A;F0@1&]R861O"F-O;7!U=&5R<R!;,UTN(%5N9F]R='5N871E;'DL(&YO +M(%)E86P@4')O9W)A;6UE<B!W;W5L9"!E=F5R('5S92!A"F-O;7!U=&5R('=H +M;W-E(&]P97)A=&EN9R!S>7-T96T@:7,@8V%L;&5D(%-M86QL5&%L:RP@86YD +M('=O=6QD"F-E<G1A:6YL>2!N;W0@=&%L:R!T;R!T:&4@8V]M<'5T97(@=VET +M:"!A(&UO=7-E+B \4#X*"E-O;64@;V8@=&AE(&-O;F-E<'1S(&EN('1H97-E +M(%AE<F]X(&5D:71O<G,@:&%V92!B965N(&EN8V]R<&]R871E9 II;G1O(&5D +M:71O<G,@<G5N;FEN9R!O;B!M;W)E(')E87-O;F%B;'D@;F%M960@;W!E<F%T +M:6YG('-Y<W1E;7,N($5-04-3"F%N9"!622!A<F4@<')O8F%B;'D@=&AE(&UO +M<W0@=V5L;"!K;F]W;B!O9B!T:&ES(&-L87-S(&]F(&5D:71O<G,N("!4:&4* +M<')O8FQE;2!W:71H('1H97-E(&5D:71O<G,@:7,@=&AA="!296%L(%!R;V=R +M86UM97)S(&-O;G-I9&5R(")W:&%T('EO=0IS964@:7,@=VAA="!Y;W4@9V5T +M(B!T;R!B92!J=7-T(&%S(&)A9"!A(&-O;F-E<'0@:6X@=&5X="!E9&ET;W)S +M(&%S(&ET"FES(&EN('=O;65N+B!.;RP@=&AE(%)E86P@4')O9W)A;6UE<B!W +M86YT<R!A(")Y;W4@87-K960@9F]R(&ET+"!Y;W4*9V]T(&ET(B!T97AT(&5D +M:71O<B M+2!C;VUP;&EC871E9"P@8W)Y<'1I8RP@<&]W97)F=6PL('5N9F]R +M9VEV:6YG+ ID86YG97)O=7,N(%1%0T\L('1O(&)E('!R96-I<V4N(#Q0/@H* +M270@:&%S(&)E96X@;V)S97)V960@=&AA="!A(%1%0T\@8V]M;6%N9"!S97%U +M96YC92!M;W)E(&-L;W-E;'D@<F5S96TM"F)L97,@=')A;G-M:7-S:6]N(&QI +M;F4@;F]I<V4@=&AA;B!R96%D86)L92!T97AT(%LT72X@3VYE(&]F('1H92!M +M;W)E"F5N=&5R=&%I;FEN9R!G86UE<R!T;R!P;&%Y('=I=&@@5$5#3R!I<R!T +M;R!T>7!E('EO=7(@;F%M92!I;B!A<R!A"F-O;6UA;F0@;&EN92!A;F0@=')Y +M('1O(&=U97-S('=H870@:70@9&]E<RX@2G5S="!A8F]U="!A;GD@<&]S<VEB +M;&4*='EP:6YG(&5R<F]R('=H:6QE('1A;&MI;F<@=VET:"!414-/('=I;&P@ +M<')O8F%B;'D@9&5S=')O>2!Y;W5R"G!R;V=R86TL(&]R(&5V96X@=V]R<V4@ +M+2T@:6YT<F]D=6-E('-U8G1L92!A;F0@;7ES=&5R:6]U<R!B=6=S(&EN(&$* +M;VYC92!W;W)K:6YG('-U8G)O=71I;F4N(#Q0/@H*1F]R('1H:7,@<F5A<V]N +M+"!296%L(%!R;V=R86UM97)S(&%R92!R96QU8W1A;G0@=&\@86-T=6%L;'D@ +M961I="!A"G!R;V=R86T@=&AA="!I<R!C;&]S92!T;R!W;W)K:6YG+B!4:&5Y +M(&9I;F0@:70@;75C:"!E87-I97(@=&\@:G5S= IP871C:"!T:&4@8FEN87)Y +M(&]B:F5C="!C;V1E(&1I<F5C=&QY+"!U<VEN9R!A('=O;F1E<F9U;"!P<F]G +M<F%M"F-A;&QE9"!355!%4EI!4" H;W(@:71S(&5Q=6EV86QE;G0@;VX@;F]N +M+4E"32!M86-H:6YE<RDN(%1H:7,@=V]R:W,@<V\*=V5L;"!T:&%T(&UA;GD@ +M=V]R:VEN9R!P<F]G<F%M<R!O;B!)0DT@<WES=&5M<R!B96%R(&YO(')E;&%T +M:6]N('1O"G1H92!O<FEG:6YA;"!&3U)44D%.(&-O9&4N("!);B!M86YY(&-A +M<V5S+"!T:&4@;W)I9VEN86P@<V]U<F-E(&-O9&4@:7,*;F\@;&]N9V5R(&%V +M86EL86)L92X@5VAE;B!I="!C;VUE<R!T:6UE('1O(&9I>"!A('!R;V=R86T@ +M;&EK92!T:&ES+"!N;PIM86YA9V5R('=O=6QD(&5V96X@=&AI;FL@;V8@<V5N +M9&EN9R!A;GET:&EN9R!L97-S('1H86X@82!296%L"E!R;V=R86UM97(@=&\@ +M9&\@=&AE(&IO8B M+2!N;R!1=6EC:&4@16%T:6YG('-T<G5C='5R960@<')O +M9W)A;6UE<@IW;W5L9"!E=F5N(&MN;W<@=VAE<F4@=&\@<W1A<G0N(%1H:7,@ +M:7,@8V%L;&5D(")J;V(@<V5C=7)I='DB+B \4#X*"E-O;64@<')O9W)A;6UI +M;F<@=&]O;',@3D]4('5S960@8GD@4F5A;"!0<F]G<F%M;65R<SH@/% ^"CQ5 +M3#X*"CQ,23X@1D]25%)!3B!P<F5P<F]C97-S;W)S(&QI:V4@34]25%)!3B!A +M;F0@4D%41D]2+B!4:&4@0W5I<VEN87)T<R!O9@IP<F]G<F%M;6EN9R M+2!G +M<F5A="!F;W(@;6%K:6YG(%%U:6-H92X@4V5E(&-O;6UE;G1S(&%B;W9E(&]N +M"G-T<G5C='5R960@<')O9W)A;6UI;F<N"@H\3$D^("!3;W5R8V4@;&%N9W5A +M9V4@9&5B=6=G97)S+B!296%L(%!R;V=R86UM97)S(&-A;B!R96%D(&-O<F4@ +M9'5M<',N"@H\3$D^($-O;7!I;&5R<R!W:71H(&%R<F%Y(&)O=6YD<R!C:&5C +M:VEN9RX@5&AE>2!S=&EF;&4@8W)E871I=FET>2P*9&5S=')O>2!M;W-T(&]F +M('1H92!I;G1E<F5S=&EN9R!U<V5S(&9O<B!%455)5D%,14Y#12P@86YD(&UA +M:V4@:70*:6UP;W-S:6)L92!T;R!M;V1I9GD@=&AE(&]P97)A=&EN9R!S>7-T +M96T@8V]D92!W:71H(&YE9V%T:79E"G-U8G-C<FEP=',N(%=O<G-T(&]F(&%L +M;"P@8F]U;F1S(&-H96-K:6YG(&ES(&EN969F:6-I96YT+@H*/$Q)/B!3;W5R +M8V4@8V]D92!M86EN=&%I;F%N8V4@<WES=&5M<RX@02!296%L(%!R;V=R86UM +M97(@:V5E<',@:&ES"F-O9&4@;&]C:V5D('5P(&EN(&$@8V%R9"!F:6QE+"!B +M96-A=7-E(&ET(&EM<&QI97,@=&AA="!I=',@;W=N97(*8V%N;F]T(&QE879E +M(&AI<R!I;7!O<G1A;G0@<')O9W)A;7,@=6YG=6%R9&5D(%LU72X*"CPO54P^ +M(#Q0/@H*"CQ(,SX@(%1(12!214%,(%!23T=204U-15(@050@5T]22SPO2#,^ +M"@I7:&5R92!D;V5S('1H92!T>7!I8V%L(%)E86P@4')O9W)A;6UE<B!W;W)K +M/R!7:&%T(&MI;F0@;V8@<')O9W)A;7,@87)E"G=O<G1H>2!O9B!T:&4@969F +M;W)T<R!O9B!S;R!T86QE;G1E9"!A;B!I;F1I=FED=6%L/R!9;W4@8V%N(&)E +M('-U<F4*=&AA="!N;R!R96%L(%!R;V=R86UM97(@=V]U;&0@8F4@8V%U9VAT +M(&1E860@=W)I=&EN9PIA8V-O=6YT<RUR96-E:79A8FQE('!R;V=R86US(&EN +M($-/0D],+"!O<B!S;W)T:6YG(&UA:6QI;F<@;&ES=',@9F]R"E!E;W!L92!M +M86=A>FEN92X@02!296%L(%!R;V=R86UM97(@=V%N=',@=&%S:W,@;V8@96%R +M=&@M<VAA:VEN9PII;7!O<G1A;F-E("AL:71E<F%L;'DA*3H@/% ^"@H\54P^ +M"@H\3$D^(%)E86P@4')O9W)A;6UE<G,@=V]R:R!F;W(@3&]S($%L86UO<R!. +M871I;VYA;"!,86)O<F%T;W)Y+"!W<FET:6YG"F%T;VUI8R!B;VUB('-I;75L +M871I;VYS('1O(')U;B!O;B!#<F%Y($D@<W5P97)C;VUP=71E<G,N"@H\3$D^ +M(%)E86P@4')O9W)A;6UE<G,@=V]R:R!F;W(@=&AE($YA=&EO;F%L(%-E8W5R +M:71Y($%G96YC>2P@9&5C;V1I;F<*4G5S<VEA;B!T<F%N<VUI<W-I;VYS+@H* +M/$Q)/B!)="!W87,@;&%R9V5L>2!D=64@=&\@=&AE(&5F9F]R=',@;V8@=&AO +M=7-A;F1S(&]F(%)E86P*4')O9W)A;6UE<G,@=V]R:VEN9R!F;W(@3D%302!T +M:&%T(&]U<B!B;WES(&=O="!T;R!T:&4@;6]O;B!A;F0@8F%C:PIB969O<F4@ +M=&AE(&-O<VUO;F%U=',N"@H\3$D^(%1H92!C;VUP=71E<G,@:6X@=&AE(%-P +M86-E(%-H=71T;&4@=V5R92!P<F]G<F%M;65D(&)Y(%)E86P*4')O9W)A;6UE +M<G,N"B @(" */$Q)/B!0<F]G<F%M;65R<R!A<F4@870@=V]R:R!F;W(@0F]E +M:6YG(&1E<VEG;FEN9R!T:&4@;W!E<F%T:6YG"G-Y<W1E;7,@9F]R(&-R=6ES +M92!M:7-S:6QE<RX*"CPO54P^(#Q0/@H*4V]M92!O9B!T:&4@;6]S="!A=V5S +M;VUE(%)E86P@4')O9W)A;6UE<G,@;V8@86QL('=O<FL@870@=&AE($IE="!0 +M<F\M"G!U;'-I;VX@3&%B;W)A=&]R>2!I;B!#86QI9F]R;FEA+B!-86YY(&]F +M('1H96T@:VYO=R!T:&4@96YT:7)E"F]P97)A=&EN9R!S>7-T96T@;V8@=&AE +M(%!I;VYE97(@86YD(%9O>6%G97(@<W!A8V5C<F%F="!B>2!H96%R="X@5VET +M: IA(&-O;6)I;F%T:6]N(&]F(&QA<F=E(&=R;W5N9"UB87-E9"!&3U)44D%. +M('!R;V=R86US(&%N9"!S;6%L; IS<&%C96-R869T+6)A<V5D(&%S<V5M8FQY +M(&QA;F=U86=E('!R;V=R86US+"!T:&5Y(&-A;B!T;R!D;R!I;F-R961I8FQE +M"F9E871S(&]F(&YA=FEG871I;VX@86YD(&EM<')O=FES871I;VXL('-U8V@@ +M87,@:&ET=&EN9R!T96XM:VEL;VUE=&5R"G=I9&4@=VEN9&]W<R!A="!3871U +M<FX@869T97(@<VEX('EE87)S(&EN('-P86-E+"!A;F0@<F5P86ER:6YG(&]R +M"F)Y<&%S<VEN9R!D86UA9V5D('-E;G-O<B!P;&%T9F]R;7,L(')A9&EO<RP@ +M86YD(&)A='1E<FEE<RX@($%L;&5G961L>2P*;VYE(%)E86P@4')O9W)A;6UE +M<B!M86YA9V5D('1O('1U8VL@82!P871T97)N+6UA=&-H:6YG('!R;V=R86T@ +M:6YT;R!A"F9E=R!H=6YD<F5D(&)Y=&5S(&]F('5N=7-E9"!M96UO<GD@:6X@ +M82!6;WEA9V5R('-P86-E8W)A9G0@=&AA= IS96%R8VAE9"!F;W(L(&QO8V%T +M960L(&%N9"!P:&]T;V=R87!H960@82!N97<@;6]O;B!O9B!*=7!I=&5R+B \ +M4#X*"D]N92!P;&%N(&9O<B!T:&4@=7!C;VUI;F<@1V%L:6QE;R!S<&%C96-R +M869T(&UI<W-I;VX@:7,@=&\@=7-E(&$@9W)A=BT*:71Y(&%S<VES="!T<F%J +M96-T;W)Y('!A<W0@36%R<R!O;B!T:&4@=V%Y('1O($IU<&ET97(N(%1H:7,@ +M=')A:F5C=&]R>0IP87-S97,@=VET:&EN(#@P("LO+2 S(&MI;&]M971E<G,@ +M;V8@=&AE('-U<F9A8V4@;V8@36%R<RX@3F]B;V1Y(&ES"F=O:6YG('1O('1R +M=7-T(&$@4$%30T%,('!R;V=R86T@*&]R(%!!4T-!3"!P<F]G<F%M;65R*2!F +M;W(@;F%V:6=A=&EO;@IT;R!T:&5S92!T;VQE<F%N8V5S+B \4#X@"@I!<R!Y +M;W4@8V%N('1E;&PL(&UA;GD@;V8@=&AE('=O<FQD)W,@4F5A;"!0<F]G<F%M +M;65R<R!W;W)K(&9O<B!T:&4*52Y3+B @1V]V97)N;65N="P@;6%I;FQY('1H +M92!$969E;G-E($1E<&%R=&UE;G0N(%1H:7,@:7,@87,@:70@<VAO=6QD"F)E +M+B @4F5C96YT;'DL(&AO=V5V97(L(&$@8FQA8VL@8VQO=60@:&%S(&9O<FUE +M9"!O;B!T:&4@4F5A; I0<F]G<F%M;65R(&AO<FEZ;VXN(#Q0/@H*270@<V5E +M;7,@=&AA="!S;VUE(&AI9VAL>2!P;&%C960@475I8VAE($5A=&5R<R!A="!T +M:&4@1&5F96YS90I$97!A<G1M96YT(&1E8VED960@=&AA="!A;&P@1&5F96YS +M92!P<F]G<F%M<R!S:&]U;&0@8F4@=W)I='1E;B!I;B!S;VUE"F=R86YD('5N +M:69I960@;&%N9W5A9V4@8V%L;&5D(")!1$$B("AR96=I<W1E<F5D('1R861E +M;6%R:RP@1&]$*2X@($9O<@IA('=H:6QE+"!I="!S965M960@=&AA="!!1$$@ +M=V%S(&1E<W1I;F5D('1O(&)E8V]M92!A(&QA;F=U86=E('1H870*=V5N="!A +M9V%I;G-T(&%L;"!T:&4@<')E8V5P=',@;V8@4F5A;"!0<F]G<F%M;6EN9R M +M+2!A(&QA;F=U86=E('=I=&@*<W1R=6-T=7)E+"!A(&QA;F=U86=E('=I=&@@ +M9&%T82!T>7!E<RP@<W1R;VYG('1Y<&EN9RP@86YD"G-E;6EC;VQO;G,N($EN +M('-H;W)T+"!A(&QA;F=U86=E(&1E<VEG;F5D('1O(&-R:7!P;&4@=&AE(&-R +M96%T:79I='D@;V8*=&AE('1Y<&EC86P@4F5A;"!0<F]G<F%M;65R+B @1F]R +M='5N871E;'DL('1H92!L86YG=6%G92!A9&]P=&5D(&)Y($1O1 IH87,@96YO +M=6=H(&EN=&5R97-T:6YG(&9E871U<F5S('1O(&UA:V4@:70@87!P<F]A8VAA +M8FQE.B!I="=S"FEN8W)E9&EB;'D@8V]M<&QE>"P@:6YC;'5D97,@;65T:&]D +M<R!F;W(@;65S<VEN9R!W:71H('1H92!O<&5R871I;F<*<WES=&5M(&%N9"!R +M96%R<F%N9VEN9R!M96UO<GDL(&%N9"!%9'-G87(@1&EJ:W-T<F$@9&]E<VXG +M="!L:6ME(&ET"ELV72X@*$1I:FMS=')A+"!A<R!))VT@<W5R92!Y;W4@:VYO +M=RP@=V%S('1H92!A=71H;W(@;V8@/$5-/B)';U1O<PI#;VYS:61E<F5D($AA +M<FUF=6PB/"]%33X@+2T@82!L86YD;6%R:R!W;W)K(&EN('!R;V=R86UM:6YG +M"FUE=&AO9&]L;V=Y+"!A<'!L875D960@8GD@4&%S8V%L(%!R;V=R86UM97)S +M(&%N9"!1=6EC:&4@16%T97)S(&%L:6ME+BD*0F5S:61E<RP@=&AE(&1E=&5R +M;6EN960@4F5A;"!0<F]G<F%M;65R(&-A;B!W<FET92!&3U)44D%.('!R;V=R +M86US(&EN"F%N>2!L86YG=6%G92X@/% ^"@I4:&4@<F5A;"!P<F]G<F%M;65R +M(&UI9VAT(&-O;7!R;VUI<V4@:&ES('!R:6YC:7!L97,@86YD('=O<FL@;VX@ +M<V]M92T*=&AI;F<@<VQI9VAT;'D@;6]R92!T<FEV:6%L('1H86X@=&AE(&1E +M<W1R=6-T:6]N(&]F(&QI9F4@87,@=V4@:VYO=PII="P@<')O=FED:6YG('1H +M97)E)W,@96YO=6=H(&UO;F5Y(&EN(&ET+B!4:&5R92!A<F4@<V5V97)A;"!2 +M96%L"E!R;V=R86UM97)S(&)U:6QD:6YG('9I9&5O(&=A;65S(&%T($%T87)I +M+"!F;W(@97AA;7!L92X@*$)U="!N;W0*<&QA>6EN9R!T:&5M+B!!(%)E86P@ +M4')O9W)A;6UE<B!K;F]W<R!H;W<@=&\@8F5A="!T:&4@;6%C:&EN92!E=F5R +M>0IT:6UE.B!N;R!C:&%L;&%N9V4@:6X@=&AA="XI("!%=F5R>6]N92!W;W)K +M:6YG(&%T($QU8V%S1FEL;2!I<R!A(%)E86P*4')O9W)A;6UE<BX@*$ET('=O +M=6QD(&)E(&-R87IY('1O('1U<FX@9&]W;B!T:&4@;6]N97D@;V8@-3 @;6EL +M;&EO;@I3=&%R(%=A<G,@9F%N<RXI(%1H92!P<F]P;W)T:6]N(&]F(%)E86P@ +M4')O9W)A;6UE<G,@:6X@0V]M<'5T97(*1W)A<&AI8W,@:7,@<V]M97=H870@ +M;&]W97(@=&AA;B!T:&4@;F]R;2P@;6]S=&QY(&)E8V%U<V4@;F]B;V1Y(&AA +M<PIF;W5N9"!A('5S92!F;W(@0V]M<'5T97(@1W)A<&AI8W,@>65T+B @3VX@ +M=&AE(&]T:&5R(&AA;F0L(&%L; I#;VUP=71E<B!'<F%P:&EC<R!I<R!D;VYE +M(&EN($9/4E1204XL('-O('1H97)E(&%R92!A(&9A:7(@;G5M8F5R"G!E;W!L +M92!D;VEN9R!'<F%P:&EC<R!I;B!O<F1E<B!T;R!A=F]I9"!H879I;F<@=&\@ +M=W)I=&4@0T]"3TP*<')O9W)A;7,N(#Q0/@H*"CQ(,SX@(%1(12!214%,(%!2 +M3T=204U-15(@050@4$Q!63PO2#,^"@I'96YE<F%L;'DL('1H92!296%L(%!R +M;V=R86UM97(@<&QA>7,@=&AE('-A;64@=V%Y(&AE('=O<FMS("TM('=I=&@* +M8V]M<'5T97)S+B @2&4@:7,@8V]N<W1A;G1L>2!A;6%Z960@=&AA="!H:7,@ +M96UP;&]Y97(@86-T=6%L;'D@<&%Y<PIH:6T@=&\@9&\@=VAA="!H92!W;W5L +M9"!B92!D;VEN9R!F;W(@9G5N(&%N>7=A>2P@86QT:&]U9V@@:&4@:7,*8V%R +M969U;"!N;W0@=&\@97AP<F5S<R!T:&ES(&]P:6YI;VX@;W5T(&QO=60N($]C +M8V%S:6]N86QL>2P@=&AE(%)E86P*4')O9W)A;6UE<B!D;V5S('-T97 @;W5T +M(&]F('1H92!O9F9I8V4@9F]R(&$@8G)E871H(&]F(&9R97-H(&%I<B!A;F0@ +M80IB965R(&]R('1W;RX@4V]M92!T:7!S(&]N(')E8V]G;FEZ:6YG(')E86P@ +M<')O9W)A;6UE<G,@87=A>2!F<F]M('1H90IC;VUP=71E<B!R;V]M.B \4#X* +M/%5,/@H*/$Q)/B!!="!A('!A<G1Y+"!T:&4@4F5A;"!0<F]G<F%M;65R<R!A +M<F4@=&AE(&]N97,@:6X@=&AE(&-O<FYE<@IT86QK:6YG(&%B;W5T(&]P97)A +M=&EN9R!S>7-T96T@<V5C=7)I='D@86YD(&AO=R!T;R!G970@87)O=6YD(&ET +M+@H*/$Q)/B!!="!A(&9O;W1B86QL(&=A;64L('1H92!296%L(%!R;V=R86UM +M97(@:7,@=&AE(&]N92!C;VUP87)I;F<@=&AE"G!L87ES(&%G86EN<W0@:&ES +M('-I;75L871I;VYS('!R:6YT960@;VX@,3$@8GD@,30@9F%N9F]L9"!P87!E +M<BX*"CQ,23X@070@=&AE(&)E86-H+"!T:&4@4F5A;"!0<F]G<F%M;65R(&ES +M('1H92!O;F4@9')A=VEN9R!F;&]W8VAA<G1S"FEN('1H92!S86YD+@H*/$Q) +M/B!!(%)E86P@4')O9W)A;6UE<B!G;V5S('1O(&$@9&ES8V\@=&\@=V%T8V@@ +M=&AE(&QI9VAT('-H;W<N"@H\3$D^($%T(&$@9G5N97)A;"P@=&AE(%)E86P@ +M4')O9W)A;6UE<B!I<R!T:&4@;VYE('-A>6EN9R \14T^(E!O;W(*1V5O<F=E +M+B @06YD(&AE(&%L;6]S="!H860@=&AE('-O<G0@<F]U=&EN92!W;W)K:6YG +M(&)E9F]R92!T:&4*8V]R;VYA<GDN(CPO14T^"@H\3$D^($EN(&$@9W)O8V5R +M>2!S=&]R92P@=&AE(%)E86P@4')O9W)A;6UE<B!I<R!T:&4@;VYE('=H;R!I +M;G-I<W1S(&]N"G)U;FYI;F<@=&AE(&-A;G,@<&%S="!T:&4@;&%S97(@8VAE +M8VMO=70@<V-A;FYE<B!H:6US96QF+"!B96-A=7-E(&AE"FYE=F5R(&-O=6QD +M('1R=7-T(&ME>7!U;F-H(&]P97)A=&]R<R!T;R!G970@:70@<FEG:'0@=&AE +M(&9I<G-T('1I;64N"@H\+U5,/B \4#X*"@H\2#,^("!42$4@4D5!3"!04D]' +M4D%-3452)U,@3D%455)!3"!(04))5$%4/"](,SX*"E=H870@<V]R="!O9B!E +M;G9I<F]N;65N="!D;V5S('1H92!296%L(%!R;V=R86UM97(@9G5N8W1I;VX@ +M8F5S="!I;C\*5&AI<R!I<R!A;B!I;7!O<G1A;G0@<75E<W1I;VX@9F]R('1H +M92!M86YA9V5R<R!O9B!296%L"E!R;V=R86UM97)S+B!#;VYS:61E<FEN9R!T +M:&4@86UO=6YT(&]F(&UO;F5Y(&ET(&-O<W1S('1O(&ME97 @;VYE(&]N"G1H +M92!S=&%F9BP@:70G<R!B97-T('1O('!U="!H:6T@*&]R(&AE<BD@:6X@86X@ +M96YV:7)O;FUE;G0@=VAE<F4@:&4*8V%N(&=E="!H:7,@=V]R:R!D;VYE+B \ +M4#X*"E1H92!T>7!I8V%L(%)E86P@4')O9W)A;6UE<B!L:79E<R!I;B!F<F]N +M="!O9B!A(&-O;7!U=&5R('1E<FUI;F%L+@I3=7)R;W5N9&EN9R!T:&ES('1E +M<FUI;F%L(&%R93H@/% ^"CQ53#X*"CQ,23X@3&ES=&EN9W,@;V8@86QL('!R +M;V=R86US('1H92!296%L(%!R;V=R86UM97(@:&%S(&5V97(@=V]R:V5D(&]N +M+ IP:6QE9"!I;B!R;W5G:&QY(&-H<F]N;VQO9VEC86P@;W)D97(@;VX@979E +M<GD@9FQA="!S=7)F86-E(&EN('1H92!O9F9I8V4N"@H\3$D^(%-O;64@:&%L +M9BUD;WIE;B!O<B!S;R!P87)T;'D@9FEL;&5D(&-U<',@;V8@8V]L9 IC;V9F +M964N($]C8V%S:6]N86QL>2P@=&AE<F4@=VEL;"!B92!C:6=A<F5T=&4@8G5T +M=',@9FQO871I;F<@:6X@=&AE"F-O9F9E92X@26X@<V]M92!C87-E<RP@=&AE +M(&-U<',@=VEL;"!C;VYT86EN($]R86YG92!#<G5S:"X*"CQ,23X@56YL97-S +M(&AE(&ES('9E<GD@9V]O9"P@=&AE<F4@=VEL;"!B92!C;W!I97,@;V8@=&AE +M($]3($I#3"!M86YU86P*86YD('1H92!0<FEN8VEP;&5S(&]F($]P97)A=&EO +M;B!O<&5N('1O('-O;64@<&%R=&EC=6QA<FQY(&EN=&5R97-T:6YG"G!A9V5S +M+@H*/$Q)/B!487!E9"!T;R!T:&4@=V%L;"!I<R!A(&QI;F4M<')I;G1E<B!3 +M;F]O<'D@8V%L96YD97(@9F]R('1H92!Y96%R"C$Y-CDN"@H\3$D^(%-T<F5W +M;B!A8F]U="!T:&4@9FQO;W(@87)E('-E=F5R86P@=W)A<'!E<G,@9F]R('!E +M86YU="!B=71T97(*9FEL;&5D(&-H965S92!B87)S("AT:&4@='EP92!T:&%T +M(&%R92!M861E('-T86QE(&%T('1H92!B86ME<GD@<V\@=&AE>0IC86XG="!G +M970@86YY('=O<G-E('=H:6QE('=A:71I;F<@:6X@=&AE('9E;F1I;F<@;6%C +M:&EN92DN"@H\3$D^($AI9&EN9R!I;B!T:&4@=&]P(&QE9G0M:&%N9"!D<F%W +M97(@;V8@=&AE(&1E<VL@:7,@82!S=&%S:"!O9@ID;W5B;&4@<W1U9F8@3W)E +M;W,@9F]R('-P96-I86P@;V-C87-I;VYS+@H*/$Q)/B!5;F1E<FYE871H('1H +M92!/<F5O<R!I<R!A(&9L;W<M8VAA<G1I;F<@=&5M<&QA=&4L(&QE9G0@=&AE +M<F4@8GD*=&AE('!R979I;W5S(&]C8W5P86YT(&]F('1H92!O9F9I8V4N("A2 +M96%L(%!R;V=R86UM97)S('=R:71E('!R;V=R86US+ IN;W0@9&]C=6UE;G1A +M=&EO;BX@3&5A=F4@=&AA="!T;R!T:&4@;6%I;G1A:6YE;F-E('!E;W!L92XI +M"@H\+U5,/B \4#X*"E1H92!296%L(%!R;V=R86UM97(@:7,@8V%P86)L92!O +M9B!W;W)K:6YG(#,P+" T,"P@979E;B U,"!H;W5R<R!A="!A"G-T<F5T8V@L +M('5N9&5R(&EN=&5N<V4@<')E<W-U<F4N("!);B!F86-T+"!H92!P<F5F97)S +M(&ET('1H870@=V%Y+B!"860*<F5S<&]N<V4@=&EM92!D;V5S;B=T(&)O=&AE +M<B!T:&4@4F5A;"!0<F]G<F%M;65R("TM(&ET(&=I=F5S(&AI;2!A"F-H86YC +M92!T;R!C871C:"!A(&QI='1L92!S;&5E<"!B971W965N(&-O;7!I;&5S+B!) +M9B!T:&5R92!I<R!N;W0*96YO=6=H('-C:&5D=6QE('!R97-S=7)E(&]N('1H +M92!296%L(%!R;V=R86UM97(L(&AE('1E;F1S('1O(&UA:V4*=&AI;F=S(&UO +M<F4@8VAA;&QE;F=I;F<@8GD@=V]R:VEN9R!O;B!S;VUE('-M86QL(&)U="!I +M;G1E<F5S=&EN9R!P87)T"F]F('1H92!P<F]B;&5M(&9O<B!T:&4@9FER<W0@ +M;FEN92!W965K<RP@=&AE;B!F:6YI<VAI;F<@=&AE(')E<W0@:6X*=&AE(&QA +M<W0@=V5E:RP@:6X@='=O(&]R('1H<F5E(#4P+6AO=7(@;6%R871H;VYS+B!4 +M:&ES(&YO="!O;FQY"FEN<')E<W-E<R!H:7,@;6%N86=E<BP@=VAO('=A<R!D +M97-P86ER:6YG(&]F(&5V97(@9V5T=&EN9R!T:&4@<')O:F5C= ID;VYE(&]N +M('1I;64L(&)U="!C<F5A=&5S(&$@8V]N=F5N:65N="!E>&-U<V4@9F]R(&YO +M="!D;VEN9R!T:&4*9&]C=6UE;G1A=&EO;BX@26X@9V5N97)A;#H@/% ^"@H\ +M54P^"@H\3$D^($YO(%)E86P@4')O9W)A;6UE<B!W;W)K<R Y('1O(#4N("A5 +M;FQE<W,@:70G<R Y(&EN('1H92!E=F5N:6YG('1O"C4@:6X@=&AE(&UO<FYI +M;F<N*0H*/$Q)/B!296%L(%!R;V=R86UM97)S(&1O;B=T('=E87(@;F5C:W1I +M97,N"@H\3$D^("!296%L(%!R;V=R86UM97)S(&1O;B=T('=E87(@:&EG:"!H +M965L960@<VAO97,N"@H\3$D^("!296%L(%!R;V=R86UM97)S(&%R<FEV92!A +M="!W;W)K(&EN('1I;64@9F]R(&QU;F-H+B!;.5T*"CQ,23X@02!296%L(%!R +M;V=R86UM97(@;6EG:'0@;W(@;6EG:'0@;F]T(&MN;W<@:&ES('=I9F4G<R!N +M86UE+B @2&4*9&]E<RP@:&]W979E<BP@:VYO=R!T:&4@96YT:7)E($%30TE) +M("AO<B!%0D-$24,I(&-O9&4@=&%B;&4N"@H\3$D^(%)E86P@4')O9W)A;6UE +M<G,@9&]N)W0@:VYO=R!H;W<@=&\@8V]O:RX@1W)O8V5R>2!S=&]R97,@87)E +M;B=T"F]F=&5N(&]P96X@870@,R!A+FTN+"!S;R!T:&5Y('-U<G9I=F4@;VX@ +M5'=I;FMI97,@86YD(&-O9F9E92X*"CPO54P^(#Q0/@H*/$@S/B!42$4@1E54 +M55)%/"](,SX*"E=H870@;V8@=&AE(&9U='5R93\@270@:7,@82!M871T97(@ +M;V8@<V]M92!C;VYC97)N('1O(%)E86P@4')O9W)A;6UE<G,*=&AA="!T:&4@ +M;&%T97-T(&=E;F5R871I;VX@;V8@8V]M<'5T97(@<')O9W)A;6UE<G,@87)E +M(&YO="!B96EN9PIB<F]U9VAT('5P('=I=&@@=&AE('-A;64@;W5T;&]O:R!O +M;B!L:69E(&%S('1H96ER(&5L9&5R<RX@36%N>2!O9B!T:&5M"FAA=F4@;F5V +M97(@<V5E;B!A(&-O;7!U=&5R('=I=&@@82!F<F]N="!P86YE;"X@2&%R9&QY +M(&%N>6]N90IG<F%D=6%T:6YG(&9R;VT@<V-H;V]L('1H97-E(&1A>7,@8V%N +M(&1O(&AE>"!A<FET:&UE=&EC('=I=&AO=70@80IC86QC=6QA=&]R+B @0V]L +M;&5G92!G<F%D=6%T97,@=&AE<V4@9&%Y<R!A<F4@<V]F=" M+2!P<F]T96-T +M960@9G)O;0IT:&4@<F5A;&ET:65S(&]F('!R;V=R86UM:6YG(&)Y('-O=7)C +M92!L979E;"!D96)U9V=E<G,L('1E>'0@961I=&]R<PIT:&%T(&-O=6YT('!A +M<F5N=&AE<V5S+"!A;F0@=7-E<B!F<FEE;F1L>2!O<&5R871I;F<@<WES=&5M +M<RX@(%=O<G-T(&]F"F%L;"P@<V]M92!O9B!T:&5S92!A;&QE9V5D(&-O;7!U +M=&5R('-C:65N=&ES=',@;6%N86=E('1O(&=E="!D96=R965S"G=I=&AO=70@ +M979E<B!L96%R;FEN9R!&3U)44D%.(2 @07)E('=E(&1E<W1I;F5D('1O(&)E +M8V]M92!A;B!I;F1U<W1R>0IO9B!5;FEX(&AA8VME<G,@86YD(%!A<V-A;"!P +M<F]G<F%M;65R<S\@/% ^"@I/;B!T:&4@8V]N=')A<GDN("!&<F]M(&UY(&5X +M<&5R:65N8V4L($D@8V%N(&]N;'D@<F5P;W)T('1H870@=&AE"F9U='5R92!I +M<R!B<FEG:'0@9F]R(%)E86P@4')O9W)A;6UE<G,@979E<GEW:&5R92X@3F5I +M=&AE<B!/4R\S-S @;F]R"D9/4E1204X@<VAO=R!A;GD@<VEG;G,@;V8@9'EI +M;F<@;W5T+"!D97-P:71E(&%L;"!T:&4@969F;W)T<R!O9@I087-C86P@<')O +M9W)A;6UE<G,@=&AE('=O<FQD(&]V97(N($5V96X@;6]R92!S=6)T;&4@=')I +M8VMS+"!L:6ME"F%D9&EN9R!S=')U8W1U<F5D(&-O9&EN9R!C;VYS=')U8W1S +M('1O($9/4E1204X@:&%V92!F86EL960N("!/:"!S=7)E+ IS;VUE(&-O;7!U +M=&5R('9E;F1O<G,@:&%V92!C;VUE(&]U="!W:71H($9/4E1204X@-S<@8V]M +M<&EL97)S+"!B=70*979E<GD@;VYE(&]F('1H96T@:&%S(&$@=V%Y(&]F(&-O +M;G9E<G1I;F<@:71S96QF(&)A8VL@:6YT;R!A($9/4E1204X*-C8@8V]M<&EL +M97(@870@=&AE(&1R;W @;V8@86X@;W!T:6]N(&-A<F0@+2T@=&\@8V]M<&EL +M92!$3R!L;V]P<R!L:6ME"D=O9"!M96%N="!T:&5M('1O(&)E+B \4#X*"D5V +M96X@56YI>"!M:6=H="!N;W0@8F4@87,@8F%D(&]N(%)E86P@4')O9W)A;6UE +M<G,@87,@:70@;VYC92!W87,N(%1H90IL871E<W0@<F5L96%S92!O9B!5;FEX +M(&AA<R!T:&4@<&]T96YT:6%L(&]F(&%N(&]P97)A=&EN9R!S>7-T96T@=V]R +M=&AY"F]F(&%N>2!296%L(%!R;V=R86UM97(N($ET(&AA<R!T=V\@9&EF9F5R +M96YT(&%N9"!S=6)T;'D@:6YC;VUP871I8FQE"G5S97(@:6YT97)F86-E<RP@ +M86X@87)C86YE(&%N9"!C;VUP;&EC871E9"!T97)M:6YA;"!D<FEV97(L('9I +M<G1U86P*;65M;W)Y+B!)9B!Y;W4@:6=N;W)E('1H92!F86-T('1H870@:70G +M<R!S=')U8W1U<F5D+"!E=F5N($,*<')O9W)A;6UI;F<@8V%N(&)E(&%P<')E +M8VEA=&5D(&)Y('1H92!296%L(%!R;V=R86UM97(Z(&%F=&5R(&%L;"P*=&AE +M<F4G<R!N;R!T>7!E(&-H96-K:6YG+"!V87)I86)L92!N86UE<R!A<F4@<V5V +M96X@*'1E;C\@(&5I9VAT/RD*8VAA<F%C=&5R<R!L;VYG+"!A;F0@=&AE(&%D +M9&5D(&)O;G5S(&]F('1H92!0;VEN=&5R(&1A=&$@='EP92!I<PIT:')O=VX@ +M:6XN($ET)W,@;&EK92!H879I;F<@=&AE(&)E<W0@<&%R=',@;V8@1D]25%)! +M3B!A;F0@87-S96UB;'D*;&%N9W5A9V4@:6X@;VYE('!L86-E+B @*$YO="!T +M;R!M96YT:6]N('-O;64@;V8@=&AE(&UO<F4@8W)E871I=F4@=7-E<PIF;W(@ +M/$M"1#XC9&5F:6YE/"]+0D0^+BD@/% ^"@I.;RP@=&AE(&9U='5R92!I<VXG +M="!A;&P@=&AA="!B860N("!7:'DL(&EN('1H92!P87-T(&9E=R!Y96%R<RP@ +M=&AE"G!O<'5L87(@<')E<W,@:&%S(&5V96X@8V]M;65N=&5D(&]N('1H92!B +M<FEG:'0@;F5W(&-R;W @;V8@8V]M<'5T97(*;F5R9',@86YD(&AA8VME<G,@ +M*%LW72!A;F0@6SA=*2!L96%V:6YG('!L86-E<R!L:6ME(%-T86YF;W)D(&%N +M9 I-+DDN5"X@(&9O<B!T:&4@4F5A;"!7;W)L9"X@($9R;VT@86QL(&5V:61E +M;F-E+"!T:&4@<W!I<FET(&]F(%)E86P*4')O9W)A;6UI;F<@;&EV97,@;VX@ +M:6X@=&AE<V4@>6]U;F<@;65N(&%N9"!W;VUE;BX@($%S(&QO;F<@87,@=&AE +M<F4*87)E(&EL;"UD969I;F5D(&=O86QS+"!B:7IA<G)E(&)U9W,L(&%N9"!U +M;G)E86QI<W1I8R!S8VAE9'5L97,L('1H97)E"G=I;&P@8F4@4F5A;"!0<F]G +M<F%M;65R<R!W:6QL:6YG('1O(&IU;7 @:6X@86YD(%-O;'9E(%1H92!0<F]B +M;&5M+ IS879I;F<@=&AE(&1O8W5M96YT871I;VX@9F]R(&QA=&5R+B @3&]N +M9R!L:79E($9/4E1204XA(#Q0/@H*/$@S/D%#2TY/5TQ%1T5-14Y4/"](,SX* +M"DD@=V]U;&0@;&EK92!T;R!T:&%N:R!*86X@12XL($1A=F4@4RXL(%)I8V@@ +M1RXL(%)I8V@@12X@9F]R('1H96ER(&AE;' *:6X@8VAA<F%C=&5R:7II;F<@ +M=&AE(%)E86P@4')O9W)A;6UE<BP@2&5A=&AE<B!"+B!F;W(@=&AE"FEL;'5S +M=')A=&EO;BP@2V%T:'D@12X@9F]R('!U='1I;F<@=7 @=VET:"!I="P@86YD +M(#QK8F0^871D(6%V<V13.FUA<FL\+VMB9#X@9F]R"G1H92!I;FET:6%L(&EN +M<W!R:7)A=&EO;BX@/% ^"@H\2#,^4D5&15)%3D-%4SPO2#,^"@I;,5T@(" @ +M1F5I<G-T96EN+"!"+BP@/&5M/E)E86P@365N($1O;B=T($5A="!1=6EC:&4\ +M+V5M/BP@3F5W(%EO<FLL"B @(" @("!0;V-K970@0F]O:W,L(#$Y.#(N(#Q0 +M/@H*6S)=(" @(%=I<G1H+"!.+BP@/&5M/D%L9V]R:71H;7,@*R!$871A<W1R +M=6-T=7)E<R ](%!R;V=R86US/"]E;3XL"B @(" @("!0<F5N=&EC92!(86QL +M+" Q.3<V+B \4#X*"ELS72 @("!897)O>"!005)#(&5D:71O<G,@+B N("X@ +M/% ^"@I;-%T@(" @1FEN<V5T:"P@0RXL(#QE;3Y4:&5O<GD@86YD(%!R86-T +M:6-E(&]F(%1E>'0@161I=&]R<R M"B @(" @("!O<B M(&$@0V]O:V)O;VL@ +M9F]R(&%N($5-04-3/"]E;3XL($(N4RX@5&AE<VES+ H@(" @(" @34E4+TQ# +M4R]432TQ-C4L($UA<W-A8VAU<V5T=',@26YS=&ET=71E(&]F(%1E8VAN;VQO +M9WDL"B @(" @("!-87D@,3DX,"X@/% ^"@I;-5T@(" @5V5I;F)E<F<L($<N +M+" \96T^5&AE(%!S>6-H;VQO9WD@;V8@0V]M<'5T97(@4')O9W)A;6UI;F<\ +M+V5M/BP*(" @(" @($YE=R!9;W)K+"!686X@3F]S=')A8F0@4F5I;FAO;&0L +M(#$Y-S$L('!A9V4@,3$P+B \4#X*"ELV72 @("!$:6IK<W1R82P@12XL(#QE +M;3Y/;B!T:&4@1U)%14X@3&%N9W5A9V4@4W5B;6ET=&5D('1O('1H92!$;T0\ +M+V5M/BP*(" @(" @(%-I9W!L86X@;F]T:6-E<RP@5F]L=6UE(#,L($YU;6)E +M<B Q,"P@3V-T;V)E<B Q.3<X+B \4#X*"ELW72 @("!2;W-E+"!&<F%N:RP@ +M/&5M/DIO>2!O9B!(86-K:6YG/"]E;3XL(%-C:65N8V4@.#(L(%9O;'5M92 S +M+"!.=6UB97(@.2P*(" @(" @($YO=F5M8F5R(#$Y.#(L('!A9V5S(#4X("T@ +M-C8N(#Q0/@H*6SA=(" @(%1H92!(86-K97(@4&%P97)S+" \96T^4'-Y8VAO +M;&]G>2!4;V1A>3PO96T^+"!!=6=U<W0@,3DX,"X@/% ^"@I;.5T@(" @/&5M +M/D1A=&%M871I;VX\+V5M/BP@2G5L>2P@,3DX,RP@<' N(#(V,RTR-C4N(#Q0 +M/@H*/&AR/@H*/$%$1%)%4U,^(#QA(&AR968](FEN9&5X+FAT;6PB/DAA8VME +M<B=S(%=I<V1O;3PO83XO(%)E86P@4')O9W)A;6UE<G,*1&]N)W0@57-E(%!! +M4T-!3" \+T%$1%)%4U,^"@H\(2TM(&AH;71S('-T87)T("TM/@I,87-T(&UO +E9&EF:65D.B!7960@36%R(#(W(#$W.C0X.C4P($535" Q.3DV"@ diff --git a/lib/kernel/test/ram_file_SUITE_data/realmen.html b/lib/kernel/test/ram_file_SUITE_data/realmen.html new file mode 100644 index 0000000000..c810a5d088 --- /dev/null +++ b/lib/kernel/test/ram_file_SUITE_data/realmen.html @@ -0,0 +1,520 @@ +<TITLE>Real Programmers Don't Use PASCAL</TITLE> + +<H2 align=center>Real Programmers Don't Use PASCAL</H2> + +<H4 align=center><em>Ed Post<br> +Graphic Software Systems<br> + +P.O. Box 673<br> +25117 S.W. Parkway<br> +Wilsonville, OR 97070<br> +Copyright (c) 1982<br> +</H4></EM> + + +<H4 align=center><KBD> (decvax | ucbvax | cbosg | pur-ee | lbl-unix)!teklabs!ogcvax!gss1144!evp</KBD></H4> + + +Back in the good old days -- the "Golden Era" of computers, it was +easy to separate the men from the boys (sometimes called "Real Men" +and "Quiche Eaters" in the literature). During this period, the Real +Men were the ones that understood computer programming, and the Quiche +Eaters were the ones that didn't. A real computer programmer said +things like <KBD>"DO 10 I=1,10"</KBD> and <KBD>"ABEND"</KBD> (they +actually talked in capital letters, you understand), and the rest of +the world said things like <EM>"computers are too complicated for +me"</EM> and <EM>"I can't relate to computers -- they're so +impersonal"</EM>. (A previous work [1] points out that Real Men don't +"relate" to anything, and aren't afraid of being impersonal.) <P> + +But, as usual, times change. We are faced today with a world in which +little old ladies can get computerized microwave ovens, 12 year old +kids can blow Real Men out of the water playing Asteroids and Pac-Man, +and anyone can buy and even understand their very own Personal +Computer. The Real Programmer is in danger of becoming extinct, of +being replaced by high-school students with TRASH-80s! <P> + +There is a clear need to point out the differences between the typical +high-school junior Pac-Man player and a Real Programmer. Understanding +these differences will give these kids something to aspire to -- a +role model, a Father Figure. It will also help employers of Real +Programmers to realize why it would be a mistake to replace the Real +Programmers on their staff with 12 year old Pac-Man players (at a +considerable salary savings). <P> + + +<H3>LANGUAGES</H3> + +The easiest way to tell a Real Programmer from the crowd is by the +programming language he (or she) uses. Real Programmers use FORTRAN. +Quiche Eaters use PASCAL. Nicklaus Wirth, the designer of PASCAL, was +once asked, <EM>"How do you pronounce your name?"</EM>. He replied +<EM>"You can either call me by name, pronouncing it 'Veert', or call +me by value, 'Worth'."</EM> One can tell immediately from this comment +that Nicklaus Wirth is a Quiche Eater. The only parameter passing +mechanism endorsed by Real Programmers is call-by-value-return, as +implemented in the IBM/370 FORTRAN G and H compilers. Real +programmers don't need abstract concepts to get their jobs done: they +are perfectly happy with a keypunch, a FORTRAN IV compiler, and a +beer. <P> + +<UL> +<LI> Real Programmers do List Processing in FORTRAN. + +<LI> Real Programmers do String Manipulation in FORTRAN. + +<LI> Real Programmers do Accounting (if they do it at all) in FORTRAN. + +<LI> Real Programmers do Artificial Intelligence programs in FORTRAN. +</UL> <P> + +If you can't do it in FORTRAN, do it in assembly language. If you can't do +it in assembly language, it isn't worth doing. <P> + + +<H3> STRUCTURED PROGRAMMING</H3> + +Computer science academicians have gotten into the "structured pro- +gramming" rut over the past several years. They claim that programs +are more easily understood if the programmer uses some special +language constructs and techniques. They don't all agree on exactly +which constructs, of course, and the examples they use to show their +particular point of view invariably fit on a single page of some +obscure journal or another -- clearly not enough of an example to +convince anyone. When I got out of school, I thought I was the best +programmer in the world. I could write an unbeatable tic-tac-toe +program, use five different computer languages, and create 1000 line +programs that WORKED. (Really!) Then I got out into the Real +World. My first task in the Real World was to read and understand a +200,000 line FORTRAN program, then speed it up by a factor of two. Any +Real Programmer will tell you that all the Structured Coding in the +world won't help you solve a problem like that -- it takes actual +talent. Some quick observations on Real Programmers and Structured +Programming: <P> + +<UL> +<LI> Real Programmers aren't afraid to use GOTOs. + +<LI> Real Programmers can write five page long DO loops without +getting confused. + +<LI> Real Programmers enjoy Arithmetic IF statements because they make +the code more interesting. + +<LI> Real Programmers write self-modifying code, especially if it +saves them 20 nanoseconds in the middle of a tight loop. + +<LI> Programmers don't need comments: the code is obvious. + +<LI> Since FORTRAN doesn't have a structured <KBD>IF, REPEAT +... UNTIL</KBD>, or <KBD>CASE</KBD> statement, Real Programmers don't +have to worry about not using them. Besides, they can be simulated +when necessary using assigned <KBD>GOTO</KBD>s. + +</UL> <P> + +Data structures have also gotten a lot of press lately. Abstract Data +Types, Structures, Pointers, Lists, and Strings have become popular in +certain circles. Wirth (the above-mentioned Quiche Eater) actually +wrote an entire book [2] contending that you could write a program +based on data structures, instead of the other way around. As all Real +Programmers know, the only useful data structure is the +array. Strings, lists, structures, sets -- these are all special cases +of arrays and and can be treated that way just as easily without +messing up your programing language with all sorts of +complications. The worst thing about fancy data types is that you have +to declare them, and Real Programming Languages, as we all know, have +implicit typing based on the first letter of the (six character) +variable name. <P> + + +<H3> OPERATING SYSTEMS</H3> + +What kind of operating system is used by a Real Programmer? CP/M? God +forbid -- CP/M, after all, is basically a toy operating system. Even +little old ladies and grade school students can understand and use +CP/M. <P> + +Unix is a lot more complicated of course -- the typical Unix hacker +never can remember what the <KBD>PRINT</KBD> command is called this +week -- but when it gets right down to it, Unix is a glorified video +game. People don't do Serious Work on Unix systems: they send jokes +around the world on USENET and write adventure games and research +papers. <P> + +No, your Real Programmer uses OS/370. A good programmer can find and +understand the description of the IJK305I error he just got in his JCL +manual. A great programmer can write JCL without referring to the +manual at all. A truly outstanding programmer can find bugs buried in +a 6 megabyte core dump without using a hex calculator. (I have +actually seen this done.) <P> + +OS/370 is a truly remarkable operating system. It's possible to des- +troy days of work with a single misplaced space, so alertness in the +programming staff is encouraged. The best way to approach the system +is through a keypunch. Some people claim there is a Time Sharing +system that runs on OS/370, but after careful study I have come to the +conclusion that they are mistaken. <P> + + +<H3> PROGRAMMING TOOLS</H3> + +What kind of tools does a Real Programmer use? In theory, a Real +Programmer could run his programs by keying them into the front panel +of the computer. Back in the days when computers had front panels, +this was actually done occasionally. Your typical Real Programmer +knew the entire bootstrap loader by memory in hex, and toggled it in +whenever it got destroyed by his program. (Back then, memory was +memory -- it didn't go away when the power went off. Today, memory +either forgets things when you don't want it to, or remembers things +long after they're better forgotten.) Legend has it that Seymour +Cray, inventor of the Cray I supercomputer and most of Control Data's +computers, actually toggled the first operating system for the CDC7600 +in on the front panel from memory when it was first powered +on. Seymour, needless to say, is a Real Programmer. <P> + +One of my favorite Real Programmers was a systems programmer for Texas +Instruments. One day, he got a long distance call from a user whose +system had crashed in the middle of some important work. Jim was able +to repair the damage over the phone, getting the user to toggle in +disk I/O instructions at the front panel, repairing system tables in +hex, reading register contents back over the phone. The moral of this +story: while a Real Programmer usually includes a keypunch and +lineprinter in his toolkit, he can get along with just a front panel +and a telephone in emergencies. <P> + +In some companies, text editing no longer consists of ten engineers +standing in line to use an 029 keypunch. In fact, the building I work +in doesn't contain a single keypunch. The Real Programmer in this +situation has to do his work with a text editor program. Most systems +supply several text editors to select from, and the Real Programmer +must be careful to pick one that reflects his personal style. Many +people believe that the best text editors in the world were written at +Xerox Palo Alto Research Center for use on their Alto and Dorado +computers [3]. Unfortunately, no Real Programmer would ever use a +computer whose operating system is called SmallTalk, and would +certainly not talk to the computer with a mouse. <P> + +Some of the concepts in these Xerox editors have been incorporated +into editors running on more reasonably named operating systems. EMACS +and VI are probably the most well known of this class of editors. The +problem with these editors is that Real Programmers consider "what you +see is what you get" to be just as bad a concept in text editors as it +is in women. No, the Real Programmer wants a "you asked for it, you +got it" text editor -- complicated, cryptic, powerful, unforgiving, +dangerous. TECO, to be precise. <P> + +It has been observed that a TECO command sequence more closely resem- +bles transmission line noise than readable text [4]. One of the more +entertaining games to play with TECO is to type your name in as a +command line and try to guess what it does. Just about any possible +typing error while talking with TECO will probably destroy your +program, or even worse -- introduce subtle and mysterious bugs in a +once working subroutine. <P> + +For this reason, Real Programmers are reluctant to actually edit a +program that is close to working. They find it much easier to just +patch the binary object code directly, using a wonderful program +called SUPERZAP (or its equivalent on non-IBM machines). This works so +well that many working programs on IBM systems bear no relation to +the original FORTRAN code. In many cases, the original source code is +no longer available. When it comes time to fix a program like this, no +manager would even think of sending anything less than a Real +Programmer to do the job -- no Quiche Eating structured programmer +would even know where to start. This is called "job security". <P> + +Some programming tools NOT used by Real Programmers: <P> +<UL> + +<LI> FORTRAN preprocessors like MORTRAN and RATFOR. The Cuisinarts of +programming -- great for making Quiche. See comments above on +structured programming. + +<LI> Source language debuggers. Real Programmers can read core dumps. + +<LI> Compilers with array bounds checking. They stifle creativity, +destroy most of the interesting uses for EQUIVALENCE, and make it +impossible to modify the operating system code with negative +subscripts. Worst of all, bounds checking is inefficient. + +<LI> Source code maintainance systems. A Real Programmer keeps his +code locked up in a card file, because it implies that its owner +cannot leave his important programs unguarded [5]. + +</UL> <P> + + +<H3> THE REAL PROGRAMMER AT WORK</H3> + +Where does the typical Real Programmer work? What kind of programs are +worthy of the efforts of so talented an individual? You can be sure +that no real Programmer would be caught dead writing +accounts-receivable programs in COBOL, or sorting mailing lists for +People magazine. A Real Programmer wants tasks of earth-shaking +importance (literally!): <P> + +<UL> + +<LI> Real Programmers work for Los Alamos National Laboratory, writing +atomic bomb simulations to run on Cray I supercomputers. + +<LI> Real Programmers work for the National Security Agency, decoding +Russian transmissions. + +<LI> It was largely due to the efforts of thousands of Real +Programmers working for NASA that our boys got to the moon and back +before the cosmonauts. + +<LI> The computers in the Space Shuttle were programmed by Real +Programmers. + +<LI> Programmers are at work for Boeing designing the operating +systems for cruise missiles. + +</UL> <P> + +Some of the most awesome Real Programmers of all work at the Jet Pro- +pulsion Laboratory in California. Many of them know the entire +operating system of the Pioneer and Voyager spacecraft by heart. With +a combination of large ground-based FORTRAN programs and small +spacecraft-based assembly language programs, they can to do incredible +feats of navigation and improvisation, such as hitting ten-kilometer +wide windows at Saturn after six years in space, and repairing or +bypassing damaged sensor platforms, radios, and batteries. Allegedly, +one Real Programmer managed to tuck a pattern-matching program into a +few hundred bytes of unused memory in a Voyager spacecraft that +searched for, located, and photographed a new moon of Jupiter. <P> + +One plan for the upcoming Galileo spacecraft mission is to use a grav- +ity assist trajectory past Mars on the way to Jupiter. This trajectory +passes within 80 +/- 3 kilometers of the surface of Mars. Nobody is +going to trust a PASCAL program (or PASCAL programmer) for navigation +to these tolerances. <P> + +As you can tell, many of the world's Real Programmers work for the +U.S. Government, mainly the Defense Department. This is as it should +be. Recently, however, a black cloud has formed on the Real +Programmer horizon. <P> + +It seems that some highly placed Quiche Eaters at the Defense +Department decided that all Defense programs should be written in some +grand unified language called "ADA" (registered trademark, DoD). For +a while, it seemed that ADA was destined to become a language that +went against all the precepts of Real Programming -- a language with +structure, a language with data types, strong typing, and +semicolons. In short, a language designed to cripple the creativity of +the typical Real Programmer. Fortunately, the language adopted by DoD +has enough interesting features to make it approachable: it's +incredibly complex, includes methods for messing with the operating +system and rearranging memory, and Edsgar Dijkstra doesn't like it +[6]. (Dijkstra, as I'm sure you know, was the author of <EM>"GoTos +Considered Harmful"</EM> -- a landmark work in programming +methodology, applauded by Pascal Programmers and Quiche Eaters alike.) +Besides, the determined Real Programmer can write FORTRAN programs in +any language. <P> + +The real programmer might compromise his principles and work on some- +thing slightly more trivial than the destruction of life as we know +it, providing there's enough money in it. There are several Real +Programmers building video games at Atari, for example. (But not +playing them. A Real Programmer knows how to beat the machine every +time: no challange in that.) Everyone working at LucasFilm is a Real +Programmer. (It would be crazy to turn down the money of 50 million +Star Wars fans.) The proportion of Real Programmers in Computer +Graphics is somewhat lower than the norm, mostly because nobody has +found a use for Computer Graphics yet. On the other hand, all +Computer Graphics is done in FORTRAN, so there are a fair number +people doing Graphics in order to avoid having to write COBOL +programs. <P> + + +<H3> THE REAL PROGRAMMER AT PLAY</H3> + +Generally, the Real Programmer plays the same way he works -- with +computers. He is constantly amazed that his employer actually pays +him to do what he would be doing for fun anyway, although he is +careful not to express this opinion out loud. Occasionally, the Real +Programmer does step out of the office for a breath of fresh air and a +beer or two. Some tips on recognizing real programmers away from the +computer room: <P> +<UL> + +<LI> At a party, the Real Programmers are the ones in the corner +talking about operating system security and how to get around it. + +<LI> At a football game, the Real Programmer is the one comparing the +plays against his simulations printed on 11 by 14 fanfold paper. + +<LI> At the beach, the Real Programmer is the one drawing flowcharts +in the sand. + +<LI> A Real Programmer goes to a disco to watch the light show. + +<LI> At a funeral, the Real Programmer is the one saying <EM>"Poor +George. And he almost had the sort routine working before the +coronary."</EM> + +<LI> In a grocery store, the Real Programmer is the one who insists on +running the cans past the laser checkout scanner himself, because he +never could trust keypunch operators to get it right the first time. + +</UL> <P> + + +<H3> THE REAL PROGRAMMER'S NATURAL HABITAT</H3> + +What sort of environment does the Real Programmer function best in? +This is an important question for the managers of Real +Programmers. Considering the amount of money it costs to keep one on +the staff, it's best to put him (or her) in an environment where he +can get his work done. <P> + +The typical Real Programmer lives in front of a computer terminal. +Surrounding this terminal are: <P> +<UL> + +<LI> Listings of all programs the Real Programmer has ever worked on, +piled in roughly chronological order on every flat surface in the office. + +<LI> Some half-dozen or so partly filled cups of cold +coffee. Occasionally, there will be cigarette butts floating in the +coffee. In some cases, the cups will contain Orange Crush. + +<LI> Unless he is very good, there will be copies of the OS JCL manual +and the Principles of Operation open to some particularly interesting +pages. + +<LI> Taped to the wall is a line-printer Snoopy calender for the year +1969. + +<LI> Strewn about the floor are several wrappers for peanut butter +filled cheese bars (the type that are made stale at the bakery so they +can't get any worse while waiting in the vending machine). + +<LI> Hiding in the top left-hand drawer of the desk is a stash of +double stuff Oreos for special occasions. + +<LI> Underneath the Oreos is a flow-charting template, left there by +the previous occupant of the office. (Real Programmers write programs, +not documentation. Leave that to the maintainence people.) + +</UL> <P> + +The Real Programmer is capable of working 30, 40, even 50 hours at a +stretch, under intense pressure. In fact, he prefers it that way. Bad +response time doesn't bother the Real Programmer -- it gives him a +chance to catch a little sleep between compiles. If there is not +enough schedule pressure on the Real Programmer, he tends to make +things more challenging by working on some small but interesting part +of the problem for the first nine weeks, then finishing the rest in +the last week, in two or three 50-hour marathons. This not only +inpresses his manager, who was despairing of ever getting the project +done on time, but creates a convenient excuse for not doing the +documentation. In general: <P> + +<UL> + +<LI> No Real Programmer works 9 to 5. (Unless it's 9 in the evening to +5 in the morning.) + +<LI> Real Programmers don't wear neckties. + +<LI> Real Programmers don't wear high heeled shoes. + +<LI> Real Programmers arrive at work in time for lunch. [9] + +<LI> A Real Programmer might or might not know his wife's name. He +does, however, know the entire ASCII (or EBCDIC) code table. + +<LI> Real Programmers don't know how to cook. Grocery stores aren't +often open at 3 a.m., so they survive on Twinkies and coffee. + +</UL> <P> + +<H3> THE FUTURE</H3> + +What of the future? It is a matter of some concern to Real Programmers +that the latest generation of computer programmers are not being +brought up with the same outlook on life as their elders. Many of them +have never seen a computer with a front panel. Hardly anyone +graduating from school these days can do hex arithmetic without a +calculator. College graduates these days are soft -- protected from +the realities of programming by source level debuggers, text editors +that count parentheses, and user friendly operating systems. Worst of +all, some of these alleged computer scientists manage to get degrees +without ever learning FORTRAN! Are we destined to become an industry +of Unix hackers and Pascal programmers? <P> + +On the contrary. From my experience, I can only report that the +future is bright for Real Programmers everywhere. Neither OS/370 nor +FORTRAN show any signs of dying out, despite all the efforts of +Pascal programmers the world over. Even more subtle tricks, like +adding structured coding constructs to FORTRAN have failed. Oh sure, +some computer vendors have come out with FORTRAN 77 compilers, but +every one of them has a way of converting itself back into a FORTRAN +66 compiler at the drop of an option card -- to compile DO loops like +God meant them to be. <P> + +Even Unix might not be as bad on Real Programmers as it once was. The +latest release of Unix has the potential of an operating system worthy +of any Real Programmer. It has two different and subtly incompatible +user interfaces, an arcane and complicated terminal driver, virtual +memory. If you ignore the fact that it's structured, even C +programming can be appreciated by the Real Programmer: after all, +there's no type checking, variable names are seven (ten? eight?) +characters long, and the added bonus of the Pointer data type is +thrown in. It's like having the best parts of FORTRAN and assembly +language in one place. (Not to mention some of the more creative uses +for <KBD>#define</KBD>.) <P> + +No, the future isn't all that bad. Why, in the past few years, the +popular press has even commented on the bright new crop of computer +nerds and hackers ([7] and [8]) leaving places like Stanford and +M.I.T. for the Real World. From all evidence, the spirit of Real +Programming lives on in these young men and women. As long as there +are ill-defined goals, bizarre bugs, and unrealistic schedules, there +will be Real Programmers willing to jump in and Solve The Problem, +saving the documentation for later. Long live FORTRAN! <P> + +<H3>ACKNOWLEGEMENT</H3> + +I would like to thank Jan E., Dave S., Rich G., Rich E. for their help +in characterizing the Real Programmer, Heather B. for the +illustration, Kathy E. for putting up with it, and <kbd>atd!avsdS:mark</kbd> for +the initial inspriration. <P> + +<H3>REFERENCES</H3> + +[1] Feirstein, B., <em>Real Men Don't Eat Quiche</em>, New York, + Pocket Books, 1982. <P> + +[2] Wirth, N., <em>Algorithms + Datastructures = Programs</em>, + Prentice Hall, 1976. <P> + +[3] Xerox PARC editors . . . <P> + +[4] Finseth, C., <em>Theory and Practice of Text Editors - + or - a Cookbook for an EMACS</em>, B.S. Thesis, + MIT/LCS/TM-165, Massachusetts Institute of Technology, + May 1980. <P> + +[5] Weinberg, G., <em>The Psychology of Computer Programming</em>, + New York, Van Nostrabd Reinhold, 1971, page 110. <P> + +[6] Dijkstra, E., <em>On the GREEN Language Submitted to the DoD</em>, + Sigplan notices, Volume 3, Number 10, October 1978. <P> + +[7] Rose, Frank, <em>Joy of Hacking</em>, Science 82, Volume 3, Number 9, + November 1982, pages 58 - 66. <P> + +[8] The Hacker Papers, <em>Psychology Today</em>, August 1980. <P> + +[9] <em>Datamation</em>, July, 1983, pp. 263-265. <P> + +<hr> + +<ADDRESS> <a href="index.html">Hacker's Wisdom</a>/ Real Programmers +Don't Use PASCAL </ADDRESS> + +<!-- hhmts start --> +Last modified: Wed Mar 27 17:48:50 EST 1996 diff --git a/lib/kernel/test/ram_file_SUITE_data/realmen.html.gz b/lib/kernel/test/ram_file_SUITE_data/realmen.html.gz Binary files differnew file mode 100644 index 0000000000..040ef59b72 --- /dev/null +++ b/lib/kernel/test/ram_file_SUITE_data/realmen.html.gz diff --git a/lib/kernel/test/ram_file_SUITE_data/realmen.html.uu b/lib/kernel/test/ram_file_SUITE_data/realmen.html.uu new file mode 100644 index 0000000000..dcaaad512d --- /dev/null +++ b/lib/kernel/test/ram_file_SUITE_data/realmen.html.uu @@ -0,0 +1,529 @@ +M/%1)5$Q%/E)E86P@4')O9W)A;6UE<G,@1&]N)W0@57-E(%!!4T-!3#PO5$E4 +M3$4^"@H\2#(@86QI9VX]8V5N=&5R/E)E86P@4')O9W)A;6UE<G,@1&]N)W0@ +M57-E(%!!4T-!3#PO2#(^"@H\2#0@86QI9VX]8V5N=&5R/CQE;3Y%9"!0;W-T +M/&)R/@I'<F%P:&EC(%-O9G1W87)E(%-Y<W1E;7,\8G(^"@I0+D\N($)O>" V +M-S,\8G(^"C(U,3$W(%,N5RX@4&%R:W=A>3QB<CX*5VEL<V]N=FEL;&4L($]2 +M(#DW,#<P/&)R/@I#;W!Y<FEG:'0@*&,I(#$Y.#(\8G(^"CPO2#0^/"]%33X* +M"@H\2#0@86QI9VX]8V5N=&5R/CQ+0D0^("AD96-V87@@?"!U8V)V87@@?"!C +M8F]S9R!\('!U<BUE92!\(&QB;"UU;FEX*2%T96ML86)S(6]G8W9A>"%G<W,Q +M,30T(65V<#PO2T)$/CPO2#0^"@H*0F%C:R!I;B!T:&4@9V]O9"!O;&0@9&%Y +M<R M+2!T:&4@(D=O;&1E;B!%<F$B(&]F(&-O;7!U=&5R<RP@:70@=V%S"F5A +M<WD@=&\@<V5P87)A=&4@=&AE(&UE;B!F<F]M('1H92!B;WES("AS;VUE=&EM +M97,@8V%L;&5D(")296%L($UE;B(*86YD(")1=6EC:&4@16%T97)S(B!I;B!T +M:&4@;&ET97)A='5R92DN($1U<FEN9R!T:&ES('!E<FEO9"P@=&AE(%)E86P* +M365N('=E<F4@=&AE(&]N97,@=&AA="!U;F1E<G-T;V]D(&-O;7!U=&5R('!R +M;V=R86UM:6YG+"!A;F0@=&AE(%%U:6-H90I%871E<G,@=V5R92!T:&4@;VYE +M<R!T:&%T(&1I9&XG="X@02!R96%L(&-O;7!U=&5R('!R;V=R86UM97(@<V%I +M9 IT:&EN9W,@;&EK92 \2T)$/B)$3R Q,"!)/3$L,3 B/"]+0D0^(&%N9" \ +M2T)$/B)!0D5.1"(\+TM"1#X@*'1H97D*86-T=6%L;'D@=&%L:V5D(&EN(&-A +M<&ET86P@;&5T=&5R<RP@>6]U('5N9&5R<W1A;F0I+"!A;F0@=&AE(')E<W0@ +M;V8*=&AE('=O<FQD('-A:60@=&AI;F=S(&QI:V4@/$5-/B)C;VUP=71E<G,@ +M87)E('1O;R!C;VUP;&EC871E9"!F;W(*;64B/"]%33X@86YD(#Q%33XB22!C +M86XG="!R96QA=&4@=&\@8V]M<'5T97)S("TM('1H97DG<F4@<V\*:6UP97)S +M;VYA;"(\+T5-/BX@("A!('!R979I;W5S('=O<FL@6S%=('!O:6YT<R!O=70@ +M=&AA="!296%L($UE;B!D;VXG= HB<F5L871E(B!T;R!A;GET:&EN9RP@86YD +M(&%R96XG="!A9G)A:60@;V8@8F5I;F<@:6UP97)S;VYA;"XI(#Q0/@H*0G5T +M+"!A<R!U<W5A;"P@=&EM97,@8VAA;F=E+B!792!A<F4@9F%C960@=&]D87D@ +M=VET:"!A('=O<FQD(&EN('=H:6-H"FQI='1L92!O;&0@;&%D:65S(&-A;B!G +M970@8V]M<'5T97)I>F5D(&UI8W)O=V%V92!O=F5N<RP@,3(@>65A<B!O;&0* +M:VED<R!C86X@8FQO=R!296%L($UE;B!O=70@;V8@=&AE('=A=&5R('!L87EI +M;F<@07-T97)O:61S(&%N9"!086,M36%N+ IA;F0@86YY;VYE(&-A;B!B=7D@ +M86YD(&5V96X@=6YD97)S=&%N9"!T:&5I<B!V97)Y(&]W;B!097)S;VYA; I# +M;VUP=71E<BX@5&AE(%)E86P@4')O9W)A;6UE<B!I<R!I;B!D86YG97(@;V8@ +M8F5C;VUI;F<@97AT:6YC="P@;V8*8F5I;F<@<F5P;&%C960@8GD@:&EG:"US +M8VAO;VP@<W1U9&5N=',@=VET:"!44D%32"TX,',A(#Q0/@H*5&AE<F4@:7,@ +M82!C;&5A<B!N965D('1O('!O:6YT(&]U="!T:&4@9&EF9F5R96YC97,@8F5T +M=V5E;B!T:&4@='EP:6-A; IH:6=H+7-C:&]O;"!J=6YI;W(@4&%C+4UA;B!P +M;&%Y97(@86YD(&$@4F5A;"!0<F]G<F%M;65R+B!5;F1E<G-T86YD:6YG"G1H +M97-E(&1I9F9E<F5N8V5S('=I;&P@9VEV92!T:&5S92!K:61S('-O;65T:&EN +M9R!T;R!A<W!I<F4@=&\@+2T@80IR;VQE(&UO9&5L+"!A($9A=&AE<B!&:6=U +M<F4N($ET('=I;&P@86QS;R!H96QP(&5M<&QO>65R<R!O9B!296%L"E!R;V=R +M86UM97)S('1O(')E86QI>F4@=VAY(&ET('=O=6QD(&)E(&$@;6ES=&%K92!T +M;R!R97!L86-E('1H92!296%L"E!R;V=R86UM97)S(&]N('1H96ER('-T869F +M('=I=&@@,3(@>65A<B!O;&0@4&%C+4UA;B!P;&%Y97)S("AA="!A"F-O;G-I +M9&5R86)L92!S86QA<GD@<V%V:6YG<RDN(#Q0/@H*"CQ(,SY,04Y'54%'15,\ +M+T@S/@H*5&AE(&5A<VEE<W0@=V%Y('1O('1E;&P@82!296%L(%!R;V=R86UM +M97(@9G)O;2!T:&4@8W)O=V0@:7,@8GD@=&AE"G!R;V=R86UM:6YG(&QA;F=U +M86=E(&AE("AO<B!S:&4I('5S97,N("!296%L(%!R;V=R86UM97)S('5S92!& +M3U)44D%.+@I1=6EC:&4@16%T97)S('5S92!005-#04PN($YI8VML875S(%=I +M<G1H+"!T:&4@9&5S:6=N97(@;V8@4$%30T%,+"!W87,*;VYC92!A<VME9"P@ +M/$5-/B)(;W<@9&\@>6]U('!R;VYO=6YC92!Y;W5R(&YA;64_(CPO14T^+B!( +M92!R97!L:65D"CQ%33XB66]U(&-A;B!E:71H97(@8V%L;"!M92!B>2!N86UE +M+"!P<F]N;W5N8VEN9R!I=" G5F5E<G0G+"!O<B!C86QL"FUE(&)Y('9A;'5E +M+" G5V]R=&@G+B(\+T5-/B!/;F4@8V%N('1E;&P@:6UM961I871E;'D@9G)O +M;2!T:&ES(&-O;6UE;G0*=&AA="!.:6-K;&%U<R!7:7)T:"!I<R!A(%%U:6-H +M92!%871E<BX@(%1H92!O;FQY('!A<F%M971E<B!P87-S:6YG"FUE8VAA;FES +M;2!E;F1O<G-E9"!B>2!296%L(%!R;V=R86UM97)S(&ES(&-A;&PM8GDM=F%L +M=64M<F5T=7)N+"!A<PII;7!L96UE;G1E9"!I;B!T:&4@24)-+S,W,"!&3U)4 +M4D%.($<@86YD($@@8V]M<&EL97)S+B @4F5A; IP<F]G<F%M;65R<R!D;VXG +M="!N965D(&%B<W1R86-T(&-O;F-E<'1S('1O(&=E="!T:&5I<B!J;V)S(&1O +M;F4Z('1H97D*87)E('!E<F9E8W1L>2!H87!P>2!W:71H(&$@:V5Y<'5N8V@L +M(&$@1D]25%)!3B!)5B!C;VUP:6QE<BP@86YD(&$*8F5E<BX@/% ^"@H\54P^ +M"CQ,23X@4F5A;"!0<F]G<F%M;65R<R!D;R!,:7-T(%!R;V-E<W-I;F<@:6X@ +M1D]25%)!3BX*"CQ,23X@(%)E86P@4')O9W)A;6UE<G,@9&\@4W1R:6YG($UA +M;FEP=6QA=&EO;B!I;B!&3U)44D%.+@H*/$Q)/B @4F5A;"!0<F]G<F%M;65R +M<R!D;R!!8V-O=6YT:6YG("AI9B!T:&5Y(&1O(&ET(&%T(&%L;"D@:6X@1D]2 +M5%)!3BX*"CQ,23X@(%)E86P@4')O9W)A;6UE<G,@9&\@07)T:69I8VEA;"!) +M;G1E;&QI9V5N8V4@<')O9W)A;7,@:6X@1D]25%)!3BX*/"]53#X@/% ^"@I) +M9B!Y;W4@8V%N)W0@9&\@:70@:6X@1D]25%)!3BP@9&\@:70@:6X@87-S96UB +M;'D@;&%N9W5A9V4N($EF('EO=2!C86XG=" @9&\*:70@:6X@87-S96UB;'D@ +M;&%N9W5A9V4L(&ET(&ES;B=T('=O<G1H(&1O:6YG+B \4#X*"@H\2#,^("!3 +M5%)50U154D5$(%!23T=204U-24Y'/"](,SX*"D-O;7!U=&5R('-C:65N8V4@ +M86-A9&5M:6-I86YS(&AA=F4@9V]T=&5N(&EN=&\@=&AE(")S=')U8W1U<F5D +M('!R;RT*9W)A;6UI;F<B(')U="!O=F5R('1H92!P87-T('-E=F5R86P@>65A +M<G,N(%1H97D@8VQA:6T@=&AA="!P<F]G<F%M<PIA<F4@;6]R92!E87-I;'D@ +M=6YD97)S=&]O9"!I9B!T:&4@<')O9W)A;6UE<B!U<V5S('-O;64@<W!E8VEA +M; IL86YG=6%G92!C;VYS=')U8W1S(&%N9"!T96-H;FEQ=65S+B!4:&5Y(&1O +M;B=T(&%L;"!A9W)E92!O;B!E>&%C=&QY"G=H:6-H(&-O;G-T<G5C=',L(&]F +M(&-O=7)S92P@86YD('1H92!E>&%M<&QE<R!T:&5Y('5S92!T;R!S:&]W('1H +M96ER"G!A<G1I8W5L87(@<&]I;G0@;V8@=FEE=R!I;G9A<FEA8FQY(&9I="!O +M;B!A('-I;F=L92!P86=E(&]F('-O;64*;V)S8W5R92!J;W5R;F%L(&]R(&%N +M;W1H97(@+2T@8VQE87)L>2!N;W0@96YO=6=H(&]F(&%N(&5X86UP;&4@=&\* +M8V]N=FEN8V4@86YY;VYE+B @5VAE;B!)(&=O="!O=70@;V8@<V-H;V]L+"!) +M('1H;W5G:'0@22!W87,@=&AE(&)E<W0*<')O9W)A;6UE<B!I;B!T:&4@=V]R +M;&0N($D@8V]U;&0@=W)I=&4@86X@=6YB96%T86)L92!T:6,M=&%C+71O90IP +M<F]G<F%M+"!U<V4@9FEV92!D:69F97)E;G0@8V]M<'5T97(@;&%N9W5A9V5S +M+"!A;F0@8W)E871E(#$P,# @;&EN90IP<F]G<F%M<R!T:&%T(%=/4DM%1"X@ +M("A296%L;'DA*2!4:&5N($D@9V]T(&]U="!I;G1O('1H92!296%L"E=O<FQD +M+B!->2!F:7)S="!T87-K(&EN('1H92!296%L(%=O<FQD('=A<R!T;R!R96%D +M(&%N9"!U;F1E<G-T86YD(&$*,C P+# P,"!L:6YE($9/4E1204X@<')O9W)A +M;2P@=&AE;B!S<&5E9"!I="!U<"!B>2!A(&9A8W1O<B!O9B!T=V\N($%N>0I2 +M96%L(%!R;V=R86UM97(@=VEL;"!T96QL('EO=2!T:&%T(&%L;"!T:&4@4W1R +M=6-T=7)E9"!#;V1I;F<@:6X@=&AE"G=O<FQD('=O;B=T(&AE;' @>6]U('-O +M;'9E(&$@<')O8FQE;2!L:6ME('1H870@+2T@:70@=&%K97,@86-T=6%L"G1A +M;&5N="X@4V]M92!Q=6EC:R!O8G-E<G9A=&EO;G,@;VX@4F5A;"!0<F]G<F%M +M;65R<R!A;F0@4W1R=6-T=7)E9 I0<F]G<F%M;6EN9SH@/% ^"@H\54P^"CQ, +M23X@4F5A;"!0<F]G<F%M;65R<R!A<F5N)W0@869R86ED('1O('5S92!'3U1/ +M<RX*"CQ,23X@4F5A;"!0<F]G<F%M;65R<R!C86X@=W)I=&4@9FEV92!P86=E +M(&QO;F<@1$\@;&]O<',@=VET:&]U= IG971T:6YG(&-O;F9U<V5D+@H*/$Q) +M/B!296%L(%!R;V=R86UM97)S(&5N:F]Y($%R:71H;65T:6,@248@<W1A=&5M +M96YT<R!B96-A=7-E('1H97D@;6%K90IT:&4@8V]D92!M;W)E(&EN=&5R97-T +M:6YG+@H*/$Q)/B!296%L(%!R;V=R86UM97)S('=R:71E('-E;&8M;6]D:69Y +M:6YG(&-O9&4L(&5S<&5C:6%L;'D@:68@:70*<V%V97,@=&AE;2 R,"!N86YO +M<V5C;VYD<R!I;B!T:&4@;6ED9&QE(&]F(&$@=&EG:'0@;&]O<"X*"CQ,23X@ +M(%!R;V=R86UM97)S(&1O;B=T(&YE960@8V]M;65N=',Z('1H92!C;V1E(&ES +M(&]B=FEO=7,N"@H\3$D^(%-I;F-E($9/4E1204X@9&]E<VXG="!H879E(&$@ +M<W1R=6-T=7)E9" \2T)$/DE&+"!215!%050*+BXN(%5.5$E,/"]+0D0^+"!O +M<B \2T)$/D-!4T4\+TM"1#X@<W1A=&5M96YT+"!296%L(%!R;V=R86UM97)S +M(&1O;B=T"FAA=F4@=&\@=V]R<GD@86)O=70@;F]T('5S:6YG('1H96TN($)E +M<VED97,L('1H97D@8V%N(&)E('-I;75L871E9 IW:&5N(&YE8V5S<V%R>2!U +M<VEN9R!A<W-I9VYE9" \2T)$/D=/5$\\+TM"1#YS+@H*/"]53#X@/% ^"@I$ +M871A('-T<G5C='5R97,@:&%V92!A;'-O(&=O='1E;B!A(&QO="!O9B!P<F5S +M<R!L871E;'DN($%B<W1R86-T($1A=&$*5'EP97,L(%-T<G5C='5R97,L(%!O +M:6YT97)S+"!,:7-T<RP@86YD(%-T<FEN9W,@:&%V92!B96-O;64@<&]P=6QA +M<B!I;@IC97)T86EN(&-I<F-L97,N(%=I<G1H("AT:&4@86)O=F4M;65N=&EO +M;F5D(%%U:6-H92!%871E<BD@86-T=6%L;'D*=W)O=&4@86X@96YT:7)E(&)O +M;VL@6S)=(&-O;G1E;F1I;F<@=&AA="!Y;W4@8V]U;&0@=W)I=&4@82!P<F]G +M<F%M"F)A<V5D(&]N(&1A=&$@<W1R=6-T=7)E<RP@:6YS=&5A9"!O9B!T:&4@ +M;W1H97(@=V%Y(&%R;W5N9"X@07,@86QL(%)E86P*4')O9W)A;6UE<G,@:VYO +M=RP@=&AE(&]N;'D@=7-E9G5L(&1A=&$@<W1R=6-T=7)E(&ES('1H90IA<G)A +M>2X@4W1R:6YG<RP@;&ES=',L('-T<G5C='5R97,L('-E=',@+2T@=&AE<V4@ +M87)E(&%L;"!S<&5C:6%L(&-A<V5S"F]F(&%R<F%Y<R!A;F0@86YD(&-A;B!B +M92!T<F5A=&5D('1H870@=V%Y(&IU<W0@87,@96%S:6QY('=I=&AO=70*;65S +M<VEN9R!U<"!Y;W5R('!R;V=R86UI;F<@;&%N9W5A9V4@=VET:"!A;&P@<V]R +M=',@;V8*8V]M<&QI8V%T:6]N<RX@5&AE('=O<G-T('1H:6YG(&%B;W5T(&9A +M;F-Y(&1A=&$@='EP97,@:7,@=&AA="!Y;W4@:&%V90IT;R!D96-L87)E('1H +M96TL(&%N9"!296%L(%!R;V=R86UM:6YG($QA;F=U86=E<RP@87,@=V4@86QL +M(&MN;W<L(&AA=F4*:6UP;&EC:70@='EP:6YG(&)A<V5D(&]N('1H92!F:7)S +M="!L971T97(@;V8@=&AE("AS:7@@8VAA<F%C=&5R*0IV87)I86)L92!N86UE +M+B \4#X*"@H\2#,^("!/4$52051)3D<@4UE35$5-4SPO2#,^"@I7:&%T(&MI +M;F0@;V8@;W!E<F%T:6YG('-Y<W1E;2!I<R!U<V5D(&)Y(&$@4F5A;"!0<F]G +M<F%M;65R/R @0U O33\@1V]D"F9O<F)I9" M+2!#4"]-+"!A9G1E<B!A;&PL +M(&ES(&)A<VEC86QL>2!A('1O>2!O<&5R871I;F<@<WES=&5M+B @179E;@IL +M:71T;&4@;VQD(&QA9&EE<R!A;F0@9W)A9&4@<V-H;V]L('-T=61E;G1S(&-A +M;B!U;F1E<G-T86YD(&%N9"!U<V4*0U O32X@/% ^"@I5;FEX(&ES(&$@;&]T +M(&UO<F4@8V]M<&QI8V%T960@;V8@8V]U<G-E("TM('1H92!T>7!I8V%L(%5N +M:7@@:&%C:V5R"FYE=F5R(&-A;B!R96UE;6)E<B!W:&%T('1H92 \2T)$/E!2 +M24Y4/"]+0D0^(&-O;6UA;F0@:7,@8V%L;&5D('1H:7,*=V5E:R M+2!B=70@ +M=VAE;B!I="!G971S(')I9VAT(&1O=VX@=&\@:70L(%5N:7@@:7,@82!G;&]R +M:69I960@=FED96\*9V%M92X@4&5O<&QE(&1O;B=T(&1O(%-E<FEO=7,@5V]R +M:R!O;B!5;FEX('-Y<W1E;7,Z('1H97D@<V5N9"!J;VME<PIA<F]U;F0@=&AE +M('=O<FQD(&]N(%5314Y%5"!A;F0@=W)I=&4@861V96YT=7)E(&=A;65S(&%N +M9"!R97-E87)C: IP87!E<G,N(#Q0/@H*3F\L('EO=7(@4F5A;"!0<F]G<F%M +M;65R('5S97,@3U,O,S<P+B!!(&=O;V0@<')O9W)A;6UE<B!C86X@9FEN9"!A +M;F0*=6YD97)S=&%N9"!T:&4@9&5S8W)I<'1I;VX@;V8@=&AE($E*2S,P-4D@ +M97)R;W(@:&4@:G5S="!G;W0@:6X@:&ES($I#3 IM86YU86PN("!!(&=R96%T +M('!R;V=R86UM97(@8V%N('=R:71E($I#3"!W:71H;W5T(')E9F5R<FEN9R!T +M;R!T:&4*;6%N=6%L(&%T(&%L;"X@02!T<G5L>2!O=71S=&%N9&EN9R!P<F]G +M<F%M;65R(&-A;B!F:6YD(&)U9W,@8G5R:65D(&EN"F$@-B!M96=A8GET92!C +M;W)E(&1U;7 @=VET:&]U="!U<VEN9R!A(&AE>"!C86QC=6QA=&]R+B H22!H +M879E"F%C='5A;&QY('-E96X@=&AI<R!D;VYE+BD@/% ^"@I/4R\S-S @:7,@ +M82!T<G5L>2!R96UA<FMA8FQE(&]P97)A=&EN9R!S>7-T96TN($ET)W,@<&]S +M<VEB;&4@=&\@9&5S+0IT<F]Y(&1A>7,@;V8@=V]R:R!W:71H(&$@<VEN9VQE +M(&UI<W!L86-E9"!S<&%C92P@<V\@86QE<G1N97-S(&EN('1H90IP<F]G<F%M +M;6EN9R!S=&%F9B!I<R!E;F-O=7)A9V5D+B!4:&4@8F5S="!W87D@=&\@87!P +M<F]A8V@@=&AE('-Y<W1E;0II<R!T:')O=6=H(&$@:V5Y<'5N8V@N("!3;VUE +M('!E;W!L92!C;&%I;2!T:&5R92!I<R!A(%1I;64@4VAA<FEN9PIS>7-T96T@ +M=&AA="!R=6YS(&]N($]3+S,W,"P@8G5T(&%F=&5R(&-A<F5F=6P@<W1U9'D@ +M22!H879E(&-O;64@=&\@=&AE"F-O;F-L=7-I;VX@=&AA="!T:&5Y(&%R92!M +M:7-T86ME;BX@/% ^"@H*/$@S/B @4%)/1U)!34U)3D<@5$]/3%,\+T@S/@H* +M5VAA="!K:6YD(&]F('1O;VQS(&1O97,@82!296%L(%!R;V=R86UM97(@=7-E +M/R!);B!T:&5O<GDL(&$@4F5A; I0<F]G<F%M;65R(&-O=6QD(')U;B!H:7,@ +M<')O9W)A;7,@8GD@:V5Y:6YG('1H96T@:6YT;R!T:&4@9G)O;G0@<&%N96P* +M;V8@=&AE(&-O;7!U=&5R+B!"86-K(&EN('1H92!D87ES('=H96X@8V]M<'5T +M97)S(&AA9"!F<F]N="!P86YE;',L"G1H:7,@=V%S(&%C='5A;&QY(&1O;F4@ +M;V-C87-I;VYA;&QY+B @66]U<B!T>7!I8V%L(%)E86P@4')O9W)A;6UE<@IK +M;F5W('1H92!E;G1I<F4@8F]O='-T<F%P(&QO861E<B!B>2!M96UO<GD@:6X@ +M:&5X+"!A;F0@=&]G9VQE9"!I="!I;@IW:&5N979E<B!I="!G;W0@9&5S=')O +M>65D(&)Y(&AI<R!P<F]G<F%M+B H0F%C:R!T:&5N+"!M96UO<GD@=V%S"FUE +M;6]R>2 M+2!I="!D:61N)W0@9V\@87=A>2!W:&5N('1H92!P;W=E<B!W96YT +M(&]F9BX@5&]D87DL(&UE;6]R>0IE:71H97(@9F]R9V5T<R!T:&EN9W,@=VAE +M;B!Y;W4@9&]N)W0@=V%N="!I="!T;RP@;W(@<F5M96UB97)S('1H:6YG<PIL +M;VYG(&%F=&5R('1H97DG<F4@8F5T=&5R(&9O<F=O='1E;BXI("!,96=E;F0@ +M:&%S(&ET('1H870@4V5Y;6]U<@I#<F%Y+"!I;G9E;G1O<B!O9B!T:&4@0W)A +M>2!)('-U<&5R8V]M<'5T97(@86YD(&UO<W0@;V8@0V]N=')O;"!$871A)W,* +M8V]M<'5T97)S+"!A8W1U86QL>2!T;V=G;&5D('1H92!F:7)S="!O<&5R871I +M;F<@<WES=&5M(&9O<B!T:&4@0T1#-S8P, II;B!O;B!T:&4@9G)O;G0@<&%N +M96P@9G)O;2!M96UO<GD@=VAE;B!I="!W87,@9FER<W0@<&]W97)E9 IO;BX@ +M4V5Y;6]U<BP@;F5E9&QE<W,@=&\@<V%Y+"!I<R!A(%)E86P@4')O9W)A;6UE +M<BX@/% ^"@I/;F4@;V8@;7D@9F%V;W)I=&4@4F5A;"!0<F]G<F%M;65R<R!W +M87,@82!S>7-T96US('!R;V=R86UM97(@9F]R(%1E>&%S"DEN<W1R=6UE;G1S +M+B @3VYE(&1A>2P@:&4@9V]T(&$@;&]N9R!D:7-T86YC92!C86QL(&9R;VT@ +M82!U<V5R('=H;W-E"G-Y<W1E;2!H860@8W)A<VAE9"!I;B!T:&4@;6ED9&QE +M(&]F('-O;64@:6UP;W)T86YT('=O<FLN($II;2!W87,@86)L90IT;R!R97!A +M:7(@=&AE(&1A;6%G92!O=F5R('1H92!P:&]N92P@9V5T=&EN9R!T:&4@=7-E +M<B!T;R!T;V=G;&4@:6X*9&ES:R!)+T\@:6YS=')U8W1I;VYS(&%T('1H92!F +M<F]N="!P86YE;"P@<F5P86ER:6YG('-Y<W1E;2!T86)L97,@:6X*:&5X+"!R +M96%D:6YG(')E9VES=&5R(&-O;G1E;G1S(&)A8VL@;W9E<B!T:&4@<&AO;F4N +M(%1H92!M;W)A;"!O9B!T:&ES"G-T;W)Y.B!W:&EL92!A(%)E86P@4')O9W)A +M;6UE<B!U<W5A;&QY(&EN8VQU9&5S(&$@:V5Y<'5N8V@@86YD"FQI;F5P<FEN +M=&5R(&EN(&AI<R!T;V]L:VET+"!H92!C86X@9V5T(&%L;VYG('=I=&@@:G5S +M="!A(&9R;VYT('!A;F5L"F%N9"!A('1E;&5P:&]N92!I;B!E;65R9V5N8VEE +M<RX@/% ^"@I);B!S;VUE(&-O;7!A;FEE<RP@=&5X="!E9&ET:6YG(&YO(&QO +M;F=E<B!C;VYS:7-T<R!O9B!T96X@96YG:6YE97)S"G-T86YD:6YG(&EN(&QI +M;F4@=&\@=7-E(&%N(# R.2!K97EP=6YC:"X@26X@9F%C="P@=&AE(&)U:6QD +M:6YG($D@=V]R:PII;B!D;V5S;B=T(&-O;G1A:6X@82!S:6YG;&4@:V5Y<'5N +M8V@N(%1H92!296%L(%!R;V=R86UM97(@:6X@=&AI<PIS:71U871I;VX@:&%S +M('1O(&1O(&AI<R!W;W)K('=I=&@@82!T97AT(&5D:71O<B!P<F]G<F%M+B!- +M;W-T('-Y<W1E;7,*<W5P<&QY('-E=F5R86P@=&5X="!E9&ET;W)S('1O('-E +M;&5C="!F<F]M+"!A;F0@=&AE(%)E86P@4')O9W)A;6UE<@IM=7-T(&)E(&-A +M<F5F=6P@=&\@<&EC:R!O;F4@=&AA="!R969L96-T<R!H:7,@<&5R<V]N86P@ +M<W1Y;&4N($UA;GD*<&5O<&QE(&)E;&EE=F4@=&AA="!T:&4@8F5S="!T97AT +M(&5D:71O<G,@:6X@=&AE('=O<FQD('=E<F4@=W)I='1E;B!A= I897)O>"!0 +M86QO($%L=&\@4F5S96%R8V@@0V5N=&5R(&9O<B!U<V4@;VX@=&AE:7(@06QT +M;R!A;F0@1&]R861O"F-O;7!U=&5R<R!;,UTN(%5N9F]R='5N871E;'DL(&YO +M(%)E86P@4')O9W)A;6UE<B!W;W5L9"!E=F5R('5S92!A"F-O;7!U=&5R('=H +M;W-E(&]P97)A=&EN9R!S>7-T96T@:7,@8V%L;&5D(%-M86QL5&%L:RP@86YD +M('=O=6QD"F-E<G1A:6YL>2!N;W0@=&%L:R!T;R!T:&4@8V]M<'5T97(@=VET +M:"!A(&UO=7-E+B \4#X*"E-O;64@;V8@=&AE(&-O;F-E<'1S(&EN('1H97-E +M(%AE<F]X(&5D:71O<G,@:&%V92!B965N(&EN8V]R<&]R871E9 II;G1O(&5D +M:71O<G,@<G5N;FEN9R!O;B!M;W)E(')E87-O;F%B;'D@;F%M960@;W!E<F%T +M:6YG('-Y<W1E;7,N($5-04-3"F%N9"!622!A<F4@<')O8F%B;'D@=&AE(&UO +M<W0@=V5L;"!K;F]W;B!O9B!T:&ES(&-L87-S(&]F(&5D:71O<G,N("!4:&4* +M<')O8FQE;2!W:71H('1H97-E(&5D:71O<G,@:7,@=&AA="!296%L(%!R;V=R +M86UM97)S(&-O;G-I9&5R(")W:&%T('EO=0IS964@:7,@=VAA="!Y;W4@9V5T +M(B!T;R!B92!J=7-T(&%S(&)A9"!A(&-O;F-E<'0@:6X@=&5X="!E9&ET;W)S +M(&%S(&ET"FES(&EN('=O;65N+B!.;RP@=&AE(%)E86P@4')O9W)A;6UE<B!W +M86YT<R!A(")Y;W4@87-K960@9F]R(&ET+"!Y;W4*9V]T(&ET(B!T97AT(&5D +M:71O<B M+2!C;VUP;&EC871E9"P@8W)Y<'1I8RP@<&]W97)F=6PL('5N9F]R +M9VEV:6YG+ ID86YG97)O=7,N(%1%0T\L('1O(&)E('!R96-I<V4N(#Q0/@H* +M270@:&%S(&)E96X@;V)S97)V960@=&AA="!A(%1%0T\@8V]M;6%N9"!S97%U +M96YC92!M;W)E(&-L;W-E;'D@<F5S96TM"F)L97,@=')A;G-M:7-S:6]N(&QI +M;F4@;F]I<V4@=&AA;B!R96%D86)L92!T97AT(%LT72X@3VYE(&]F('1H92!M +M;W)E"F5N=&5R=&%I;FEN9R!G86UE<R!T;R!P;&%Y('=I=&@@5$5#3R!I<R!T +M;R!T>7!E('EO=7(@;F%M92!I;B!A<R!A"F-O;6UA;F0@;&EN92!A;F0@=')Y +M('1O(&=U97-S('=H870@:70@9&]E<RX@2G5S="!A8F]U="!A;GD@<&]S<VEB +M;&4*='EP:6YG(&5R<F]R('=H:6QE('1A;&MI;F<@=VET:"!414-/('=I;&P@ +M<')O8F%B;'D@9&5S=')O>2!Y;W5R"G!R;V=R86TL(&]R(&5V96X@=V]R<V4@ +M+2T@:6YT<F]D=6-E('-U8G1L92!A;F0@;7ES=&5R:6]U<R!B=6=S(&EN(&$* +M;VYC92!W;W)K:6YG('-U8G)O=71I;F4N(#Q0/@H*1F]R('1H:7,@<F5A<V]N +M+"!296%L(%!R;V=R86UM97)S(&%R92!R96QU8W1A;G0@=&\@86-T=6%L;'D@ +M961I="!A"G!R;V=R86T@=&AA="!I<R!C;&]S92!T;R!W;W)K:6YG+B!4:&5Y +M(&9I;F0@:70@;75C:"!E87-I97(@=&\@:G5S= IP871C:"!T:&4@8FEN87)Y +M(&]B:F5C="!C;V1E(&1I<F5C=&QY+"!U<VEN9R!A('=O;F1E<F9U;"!P<F]G +M<F%M"F-A;&QE9"!355!%4EI!4" H;W(@:71S(&5Q=6EV86QE;G0@;VX@;F]N +M+4E"32!M86-H:6YE<RDN(%1H:7,@=V]R:W,@<V\*=V5L;"!T:&%T(&UA;GD@ +M=V]R:VEN9R!P<F]G<F%M<R!O;B!)0DT@<WES=&5M<R!B96%R(&YO(')E;&%T +M:6]N('1O"G1H92!O<FEG:6YA;"!&3U)44D%.(&-O9&4N("!);B!M86YY(&-A +M<V5S+"!T:&4@;W)I9VEN86P@<V]U<F-E(&-O9&4@:7,*;F\@;&]N9V5R(&%V +M86EL86)L92X@5VAE;B!I="!C;VUE<R!T:6UE('1O(&9I>"!A('!R;V=R86T@ +M;&EK92!T:&ES+"!N;PIM86YA9V5R('=O=6QD(&5V96X@=&AI;FL@;V8@<V5N +M9&EN9R!A;GET:&EN9R!L97-S('1H86X@82!296%L"E!R;V=R86UM97(@=&\@ +M9&\@=&AE(&IO8B M+2!N;R!1=6EC:&4@16%T:6YG('-T<G5C='5R960@<')O +M9W)A;6UE<@IW;W5L9"!E=F5N(&MN;W<@=VAE<F4@=&\@<W1A<G0N(%1H:7,@ +M:7,@8V%L;&5D(")J;V(@<V5C=7)I='DB+B \4#X*"E-O;64@<')O9W)A;6UI +M;F<@=&]O;',@3D]4('5S960@8GD@4F5A;"!0<F]G<F%M;65R<SH@/% ^"CQ5 +M3#X*"CQ,23X@1D]25%)!3B!P<F5P<F]C97-S;W)S(&QI:V4@34]25%)!3B!A +M;F0@4D%41D]2+B!4:&4@0W5I<VEN87)T<R!O9@IP<F]G<F%M;6EN9R M+2!G +M<F5A="!F;W(@;6%K:6YG(%%U:6-H92X@4V5E(&-O;6UE;G1S(&%B;W9E(&]N +M"G-T<G5C='5R960@<')O9W)A;6UI;F<N"@H\3$D^("!3;W5R8V4@;&%N9W5A +M9V4@9&5B=6=G97)S+B!296%L(%!R;V=R86UM97)S(&-A;B!R96%D(&-O<F4@ +M9'5M<',N"@H\3$D^($-O;7!I;&5R<R!W:71H(&%R<F%Y(&)O=6YD<R!C:&5C +M:VEN9RX@5&AE>2!S=&EF;&4@8W)E871I=FET>2P*9&5S=')O>2!M;W-T(&]F +M('1H92!I;G1E<F5S=&EN9R!U<V5S(&9O<B!%455)5D%,14Y#12P@86YD(&UA +M:V4@:70*:6UP;W-S:6)L92!T;R!M;V1I9GD@=&AE(&]P97)A=&EN9R!S>7-T +M96T@8V]D92!W:71H(&YE9V%T:79E"G-U8G-C<FEP=',N(%=O<G-T(&]F(&%L +M;"P@8F]U;F1S(&-H96-K:6YG(&ES(&EN969F:6-I96YT+@H*/$Q)/B!3;W5R +M8V4@8V]D92!M86EN=&%I;F%N8V4@<WES=&5M<RX@02!296%L(%!R;V=R86UM +M97(@:V5E<',@:&ES"F-O9&4@;&]C:V5D('5P(&EN(&$@8V%R9"!F:6QE+"!B +M96-A=7-E(&ET(&EM<&QI97,@=&AA="!I=',@;W=N97(*8V%N;F]T(&QE879E +M(&AI<R!I;7!O<G1A;G0@<')O9W)A;7,@=6YG=6%R9&5D(%LU72X*"CPO54P^ +M(#Q0/@H*"CQ(,SX@(%1(12!214%,(%!23T=204U-15(@050@5T]22SPO2#,^ +M"@I7:&5R92!D;V5S('1H92!T>7!I8V%L(%)E86P@4')O9W)A;6UE<B!W;W)K +M/R!7:&%T(&MI;F0@;V8@<')O9W)A;7,@87)E"G=O<G1H>2!O9B!T:&4@969F +M;W)T<R!O9B!S;R!T86QE;G1E9"!A;B!I;F1I=FED=6%L/R!9;W4@8V%N(&)E +M('-U<F4*=&AA="!N;R!R96%L(%!R;V=R86UM97(@=V]U;&0@8F4@8V%U9VAT +M(&1E860@=W)I=&EN9PIA8V-O=6YT<RUR96-E:79A8FQE('!R;V=R86US(&EN +M($-/0D],+"!O<B!S;W)T:6YG(&UA:6QI;F<@;&ES=',@9F]R"E!E;W!L92!M +M86=A>FEN92X@02!296%L(%!R;V=R86UM97(@=V%N=',@=&%S:W,@;V8@96%R +M=&@M<VAA:VEN9PII;7!O<G1A;F-E("AL:71E<F%L;'DA*3H@/% ^"@H\54P^ +M"@H\3$D^(%)E86P@4')O9W)A;6UE<G,@=V]R:R!F;W(@3&]S($%L86UO<R!. +M871I;VYA;"!,86)O<F%T;W)Y+"!W<FET:6YG"F%T;VUI8R!B;VUB('-I;75L +M871I;VYS('1O(')U;B!O;B!#<F%Y($D@<W5P97)C;VUP=71E<G,N"@H\3$D^ +M(%)E86P@4')O9W)A;6UE<G,@=V]R:R!F;W(@=&AE($YA=&EO;F%L(%-E8W5R +M:71Y($%G96YC>2P@9&5C;V1I;F<*4G5S<VEA;B!T<F%N<VUI<W-I;VYS+@H* +M/$Q)/B!)="!W87,@;&%R9V5L>2!D=64@=&\@=&AE(&5F9F]R=',@;V8@=&AO +M=7-A;F1S(&]F(%)E86P*4')O9W)A;6UE<G,@=V]R:VEN9R!F;W(@3D%302!T +M:&%T(&]U<B!B;WES(&=O="!T;R!T:&4@;6]O;B!A;F0@8F%C:PIB969O<F4@ +M=&AE(&-O<VUO;F%U=',N"@H\3$D^(%1H92!C;VUP=71E<G,@:6X@=&AE(%-P +M86-E(%-H=71T;&4@=V5R92!P<F]G<F%M;65D(&)Y(%)E86P*4')O9W)A;6UE +M<G,N"B @(" */$Q)/B!0<F]G<F%M;65R<R!A<F4@870@=V]R:R!F;W(@0F]E +M:6YG(&1E<VEG;FEN9R!T:&4@;W!E<F%T:6YG"G-Y<W1E;7,@9F]R(&-R=6ES +M92!M:7-S:6QE<RX*"CPO54P^(#Q0/@H*4V]M92!O9B!T:&4@;6]S="!A=V5S +M;VUE(%)E86P@4')O9W)A;6UE<G,@;V8@86QL('=O<FL@870@=&AE($IE="!0 +M<F\M"G!U;'-I;VX@3&%B;W)A=&]R>2!I;B!#86QI9F]R;FEA+B!-86YY(&]F +M('1H96T@:VYO=R!T:&4@96YT:7)E"F]P97)A=&EN9R!S>7-T96T@;V8@=&AE +M(%!I;VYE97(@86YD(%9O>6%G97(@<W!A8V5C<F%F="!B>2!H96%R="X@5VET +M: IA(&-O;6)I;F%T:6]N(&]F(&QA<F=E(&=R;W5N9"UB87-E9"!&3U)44D%. +M('!R;V=R86US(&%N9"!S;6%L; IS<&%C96-R869T+6)A<V5D(&%S<V5M8FQY +M(&QA;F=U86=E('!R;V=R86US+"!T:&5Y(&-A;B!T;R!D;R!I;F-R961I8FQE +M"F9E871S(&]F(&YA=FEG871I;VX@86YD(&EM<')O=FES871I;VXL('-U8V@@ +M87,@:&ET=&EN9R!T96XM:VEL;VUE=&5R"G=I9&4@=VEN9&]W<R!A="!3871U +M<FX@869T97(@<VEX('EE87)S(&EN('-P86-E+"!A;F0@<F5P86ER:6YG(&]R +M"F)Y<&%S<VEN9R!D86UA9V5D('-E;G-O<B!P;&%T9F]R;7,L(')A9&EO<RP@ +M86YD(&)A='1E<FEE<RX@($%L;&5G961L>2P*;VYE(%)E86P@4')O9W)A;6UE +M<B!M86YA9V5D('1O('1U8VL@82!P871T97)N+6UA=&-H:6YG('!R;V=R86T@ +M:6YT;R!A"F9E=R!H=6YD<F5D(&)Y=&5S(&]F('5N=7-E9"!M96UO<GD@:6X@ +M82!6;WEA9V5R('-P86-E8W)A9G0@=&AA= IS96%R8VAE9"!F;W(L(&QO8V%T +M960L(&%N9"!P:&]T;V=R87!H960@82!N97<@;6]O;B!O9B!*=7!I=&5R+B \ +M4#X*"D]N92!P;&%N(&9O<B!T:&4@=7!C;VUI;F<@1V%L:6QE;R!S<&%C96-R +M869T(&UI<W-I;VX@:7,@=&\@=7-E(&$@9W)A=BT*:71Y(&%S<VES="!T<F%J +M96-T;W)Y('!A<W0@36%R<R!O;B!T:&4@=V%Y('1O($IU<&ET97(N(%1H:7,@ +M=')A:F5C=&]R>0IP87-S97,@=VET:&EN(#@P("LO+2 S(&MI;&]M971E<G,@ +M;V8@=&AE('-U<F9A8V4@;V8@36%R<RX@3F]B;V1Y(&ES"F=O:6YG('1O('1R +M=7-T(&$@4$%30T%,('!R;V=R86T@*&]R(%!!4T-!3"!P<F]G<F%M;65R*2!F +M;W(@;F%V:6=A=&EO;@IT;R!T:&5S92!T;VQE<F%N8V5S+B \4#X@"@I!<R!Y +M;W4@8V%N('1E;&PL(&UA;GD@;V8@=&AE('=O<FQD)W,@4F5A;"!0<F]G<F%M +M;65R<R!W;W)K(&9O<B!T:&4*52Y3+B @1V]V97)N;65N="P@;6%I;FQY('1H +M92!$969E;G-E($1E<&%R=&UE;G0N(%1H:7,@:7,@87,@:70@<VAO=6QD"F)E +M+B @4F5C96YT;'DL(&AO=V5V97(L(&$@8FQA8VL@8VQO=60@:&%S(&9O<FUE +M9"!O;B!T:&4@4F5A; I0<F]G<F%M;65R(&AO<FEZ;VXN(#Q0/@H*270@<V5E +M;7,@=&AA="!S;VUE(&AI9VAL>2!P;&%C960@475I8VAE($5A=&5R<R!A="!T +M:&4@1&5F96YS90I$97!A<G1M96YT(&1E8VED960@=&AA="!A;&P@1&5F96YS +M92!P<F]G<F%M<R!S:&]U;&0@8F4@=W)I='1E;B!I;B!S;VUE"F=R86YD('5N +M:69I960@;&%N9W5A9V4@8V%L;&5D(")!1$$B("AR96=I<W1E<F5D('1R861E +M;6%R:RP@1&]$*2X@($9O<@IA('=H:6QE+"!I="!S965M960@=&AA="!!1$$@ +M=V%S(&1E<W1I;F5D('1O(&)E8V]M92!A(&QA;F=U86=E('1H870*=V5N="!A +M9V%I;G-T(&%L;"!T:&4@<')E8V5P=',@;V8@4F5A;"!0<F]G<F%M;6EN9R M +M+2!A(&QA;F=U86=E('=I=&@*<W1R=6-T=7)E+"!A(&QA;F=U86=E('=I=&@@ +M9&%T82!T>7!E<RP@<W1R;VYG('1Y<&EN9RP@86YD"G-E;6EC;VQO;G,N($EN +M('-H;W)T+"!A(&QA;F=U86=E(&1E<VEG;F5D('1O(&-R:7!P;&4@=&AE(&-R +M96%T:79I='D@;V8*=&AE('1Y<&EC86P@4F5A;"!0<F]G<F%M;65R+B @1F]R +M='5N871E;'DL('1H92!L86YG=6%G92!A9&]P=&5D(&)Y($1O1 IH87,@96YO +M=6=H(&EN=&5R97-T:6YG(&9E871U<F5S('1O(&UA:V4@:70@87!P<F]A8VAA +M8FQE.B!I="=S"FEN8W)E9&EB;'D@8V]M<&QE>"P@:6YC;'5D97,@;65T:&]D +M<R!F;W(@;65S<VEN9R!W:71H('1H92!O<&5R871I;F<*<WES=&5M(&%N9"!R +M96%R<F%N9VEN9R!M96UO<GDL(&%N9"!%9'-G87(@1&EJ:W-T<F$@9&]E<VXG +M="!L:6ME(&ET"ELV72X@*$1I:FMS=')A+"!A<R!))VT@<W5R92!Y;W4@:VYO +M=RP@=V%S('1H92!A=71H;W(@;V8@/$5-/B)';U1O<PI#;VYS:61E<F5D($AA +M<FUF=6PB/"]%33X@+2T@82!L86YD;6%R:R!W;W)K(&EN('!R;V=R86UM:6YG +M"FUE=&AO9&]L;V=Y+"!A<'!L875D960@8GD@4&%S8V%L(%!R;V=R86UM97)S +M(&%N9"!1=6EC:&4@16%T97)S(&%L:6ME+BD*0F5S:61E<RP@=&AE(&1E=&5R +M;6EN960@4F5A;"!0<F]G<F%M;65R(&-A;B!W<FET92!&3U)44D%.('!R;V=R +M86US(&EN"F%N>2!L86YG=6%G92X@/% ^"@I4:&4@<F5A;"!P<F]G<F%M;65R +M(&UI9VAT(&-O;7!R;VUI<V4@:&ES('!R:6YC:7!L97,@86YD('=O<FL@;VX@ +M<V]M92T*=&AI;F<@<VQI9VAT;'D@;6]R92!T<FEV:6%L('1H86X@=&AE(&1E +M<W1R=6-T:6]N(&]F(&QI9F4@87,@=V4@:VYO=PII="P@<')O=FED:6YG('1H +M97)E)W,@96YO=6=H(&UO;F5Y(&EN(&ET+B!4:&5R92!A<F4@<V5V97)A;"!2 +M96%L"E!R;V=R86UM97)S(&)U:6QD:6YG('9I9&5O(&=A;65S(&%T($%T87)I +M+"!F;W(@97AA;7!L92X@*$)U="!N;W0*<&QA>6EN9R!T:&5M+B!!(%)E86P@ +M4')O9W)A;6UE<B!K;F]W<R!H;W<@=&\@8F5A="!T:&4@;6%C:&EN92!E=F5R +M>0IT:6UE.B!N;R!C:&%L;&%N9V4@:6X@=&AA="XI("!%=F5R>6]N92!W;W)K +M:6YG(&%T($QU8V%S1FEL;2!I<R!A(%)E86P*4')O9W)A;6UE<BX@*$ET('=O +M=6QD(&)E(&-R87IY('1O('1U<FX@9&]W;B!T:&4@;6]N97D@;V8@-3 @;6EL +M;&EO;@I3=&%R(%=A<G,@9F%N<RXI(%1H92!P<F]P;W)T:6]N(&]F(%)E86P@ +M4')O9W)A;6UE<G,@:6X@0V]M<'5T97(*1W)A<&AI8W,@:7,@<V]M97=H870@ +M;&]W97(@=&AA;B!T:&4@;F]R;2P@;6]S=&QY(&)E8V%U<V4@;F]B;V1Y(&AA +M<PIF;W5N9"!A('5S92!F;W(@0V]M<'5T97(@1W)A<&AI8W,@>65T+B @3VX@ +M=&AE(&]T:&5R(&AA;F0L(&%L; I#;VUP=71E<B!'<F%P:&EC<R!I<R!D;VYE +M(&EN($9/4E1204XL('-O('1H97)E(&%R92!A(&9A:7(@;G5M8F5R"G!E;W!L +M92!D;VEN9R!'<F%P:&EC<R!I;B!O<F1E<B!T;R!A=F]I9"!H879I;F<@=&\@ +M=W)I=&4@0T]"3TP*<')O9W)A;7,N(#Q0/@H*"CQ(,SX@(%1(12!214%,(%!2 +M3T=204U-15(@050@4$Q!63PO2#,^"@I'96YE<F%L;'DL('1H92!296%L(%!R +M;V=R86UM97(@<&QA>7,@=&AE('-A;64@=V%Y(&AE('=O<FMS("TM('=I=&@* +M8V]M<'5T97)S+B @2&4@:7,@8V]N<W1A;G1L>2!A;6%Z960@=&AA="!H:7,@ +M96UP;&]Y97(@86-T=6%L;'D@<&%Y<PIH:6T@=&\@9&\@=VAA="!H92!W;W5L +M9"!B92!D;VEN9R!F;W(@9G5N(&%N>7=A>2P@86QT:&]U9V@@:&4@:7,*8V%R +M969U;"!N;W0@=&\@97AP<F5S<R!T:&ES(&]P:6YI;VX@;W5T(&QO=60N($]C +M8V%S:6]N86QL>2P@=&AE(%)E86P*4')O9W)A;6UE<B!D;V5S('-T97 @;W5T +M(&]F('1H92!O9F9I8V4@9F]R(&$@8G)E871H(&]F(&9R97-H(&%I<B!A;F0@ +M80IB965R(&]R('1W;RX@4V]M92!T:7!S(&]N(')E8V]G;FEZ:6YG(')E86P@ +M<')O9W)A;6UE<G,@87=A>2!F<F]M('1H90IC;VUP=71E<B!R;V]M.B \4#X* +M/%5,/@H*/$Q)/B!!="!A('!A<G1Y+"!T:&4@4F5A;"!0<F]G<F%M;65R<R!A +M<F4@=&AE(&]N97,@:6X@=&AE(&-O<FYE<@IT86QK:6YG(&%B;W5T(&]P97)A +M=&EN9R!S>7-T96T@<V5C=7)I='D@86YD(&AO=R!T;R!G970@87)O=6YD(&ET +M+@H*/$Q)/B!!="!A(&9O;W1B86QL(&=A;64L('1H92!296%L(%!R;V=R86UM +M97(@:7,@=&AE(&]N92!C;VUP87)I;F<@=&AE"G!L87ES(&%G86EN<W0@:&ES +M('-I;75L871I;VYS('!R:6YT960@;VX@,3$@8GD@,30@9F%N9F]L9"!P87!E +M<BX*"CQ,23X@070@=&AE(&)E86-H+"!T:&4@4F5A;"!0<F]G<F%M;65R(&ES +M('1H92!O;F4@9')A=VEN9R!F;&]W8VAA<G1S"FEN('1H92!S86YD+@H*/$Q) +M/B!!(%)E86P@4')O9W)A;6UE<B!G;V5S('1O(&$@9&ES8V\@=&\@=V%T8V@@ +M=&AE(&QI9VAT('-H;W<N"@H\3$D^($%T(&$@9G5N97)A;"P@=&AE(%)E86P@ +M4')O9W)A;6UE<B!I<R!T:&4@;VYE('-A>6EN9R \14T^(E!O;W(*1V5O<F=E +M+B @06YD(&AE(&%L;6]S="!H860@=&AE('-O<G0@<F]U=&EN92!W;W)K:6YG +M(&)E9F]R92!T:&4*8V]R;VYA<GDN(CPO14T^"@H\3$D^($EN(&$@9W)O8V5R +M>2!S=&]R92P@=&AE(%)E86P@4')O9W)A;6UE<B!I<R!T:&4@;VYE('=H;R!I +M;G-I<W1S(&]N"G)U;FYI;F<@=&AE(&-A;G,@<&%S="!T:&4@;&%S97(@8VAE +M8VMO=70@<V-A;FYE<B!H:6US96QF+"!B96-A=7-E(&AE"FYE=F5R(&-O=6QD +M('1R=7-T(&ME>7!U;F-H(&]P97)A=&]R<R!T;R!G970@:70@<FEG:'0@=&AE +M(&9I<G-T('1I;64N"@H\+U5,/B \4#X*"@H\2#,^("!42$4@4D5!3"!04D]' +M4D%-3452)U,@3D%455)!3"!(04))5$%4/"](,SX*"E=H870@<V]R="!O9B!E +M;G9I<F]N;65N="!D;V5S('1H92!296%L(%!R;V=R86UM97(@9G5N8W1I;VX@ +M8F5S="!I;C\*5&AI<R!I<R!A;B!I;7!O<G1A;G0@<75E<W1I;VX@9F]R('1H +M92!M86YA9V5R<R!O9B!296%L"E!R;V=R86UM97)S+B!#;VYS:61E<FEN9R!T +M:&4@86UO=6YT(&]F(&UO;F5Y(&ET(&-O<W1S('1O(&ME97 @;VYE(&]N"G1H +M92!S=&%F9BP@:70G<R!B97-T('1O('!U="!H:6T@*&]R(&AE<BD@:6X@86X@ +M96YV:7)O;FUE;G0@=VAE<F4@:&4*8V%N(&=E="!H:7,@=V]R:R!D;VYE+B \ +M4#X*"E1H92!T>7!I8V%L(%)E86P@4')O9W)A;6UE<B!L:79E<R!I;B!F<F]N +M="!O9B!A(&-O;7!U=&5R('1E<FUI;F%L+@I3=7)R;W5N9&EN9R!T:&ES('1E +M<FUI;F%L(&%R93H@/% ^"CQ53#X*"CQ,23X@3&ES=&EN9W,@;V8@86QL('!R +M;V=R86US('1H92!296%L(%!R;V=R86UM97(@:&%S(&5V97(@=V]R:V5D(&]N +M+ IP:6QE9"!I;B!R;W5G:&QY(&-H<F]N;VQO9VEC86P@;W)D97(@;VX@979E +M<GD@9FQA="!S=7)F86-E(&EN('1H92!O9F9I8V4N"@H\3$D^(%-O;64@:&%L +M9BUD;WIE;B!O<B!S;R!P87)T;'D@9FEL;&5D(&-U<',@;V8@8V]L9 IC;V9F +M964N($]C8V%S:6]N86QL>2P@=&AE<F4@=VEL;"!B92!C:6=A<F5T=&4@8G5T +M=',@9FQO871I;F<@:6X@=&AE"F-O9F9E92X@26X@<V]M92!C87-E<RP@=&AE +M(&-U<',@=VEL;"!C;VYT86EN($]R86YG92!#<G5S:"X*"CQ,23X@56YL97-S +M(&AE(&ES('9E<GD@9V]O9"P@=&AE<F4@=VEL;"!B92!C;W!I97,@;V8@=&AE +M($]3($I#3"!M86YU86P*86YD('1H92!0<FEN8VEP;&5S(&]F($]P97)A=&EO +M;B!O<&5N('1O('-O;64@<&%R=&EC=6QA<FQY(&EN=&5R97-T:6YG"G!A9V5S +M+@H*/$Q)/B!487!E9"!T;R!T:&4@=V%L;"!I<R!A(&QI;F4M<')I;G1E<B!3 +M;F]O<'D@8V%L96YD97(@9F]R('1H92!Y96%R"C$Y-CDN"@H\3$D^(%-T<F5W +M;B!A8F]U="!T:&4@9FQO;W(@87)E('-E=F5R86P@=W)A<'!E<G,@9F]R('!E +M86YU="!B=71T97(*9FEL;&5D(&-H965S92!B87)S("AT:&4@='EP92!T:&%T +M(&%R92!M861E('-T86QE(&%T('1H92!B86ME<GD@<V\@=&AE>0IC86XG="!G +M970@86YY('=O<G-E('=H:6QE('=A:71I;F<@:6X@=&AE('9E;F1I;F<@;6%C +M:&EN92DN"@H\3$D^($AI9&EN9R!I;B!T:&4@=&]P(&QE9G0M:&%N9"!D<F%W +M97(@;V8@=&AE(&1E<VL@:7,@82!S=&%S:"!O9@ID;W5B;&4@<W1U9F8@3W)E +M;W,@9F]R('-P96-I86P@;V-C87-I;VYS+@H*/$Q)/B!5;F1E<FYE871H('1H +M92!/<F5O<R!I<R!A(&9L;W<M8VAA<G1I;F<@=&5M<&QA=&4L(&QE9G0@=&AE +M<F4@8GD*=&AE('!R979I;W5S(&]C8W5P86YT(&]F('1H92!O9F9I8V4N("A2 +M96%L(%!R;V=R86UM97)S('=R:71E('!R;V=R86US+ IN;W0@9&]C=6UE;G1A +M=&EO;BX@3&5A=F4@=&AA="!T;R!T:&4@;6%I;G1A:6YE;F-E('!E;W!L92XI +M"@H\+U5,/B \4#X*"E1H92!296%L(%!R;V=R86UM97(@:7,@8V%P86)L92!O +M9B!W;W)K:6YG(#,P+" T,"P@979E;B U,"!H;W5R<R!A="!A"G-T<F5T8V@L +M('5N9&5R(&EN=&5N<V4@<')E<W-U<F4N("!);B!F86-T+"!H92!P<F5F97)S +M(&ET('1H870@=V%Y+B!"860*<F5S<&]N<V4@=&EM92!D;V5S;B=T(&)O=&AE +M<B!T:&4@4F5A;"!0<F]G<F%M;65R("TM(&ET(&=I=F5S(&AI;2!A"F-H86YC +M92!T;R!C871C:"!A(&QI='1L92!S;&5E<"!B971W965N(&-O;7!I;&5S+B!) +M9B!T:&5R92!I<R!N;W0*96YO=6=H('-C:&5D=6QE('!R97-S=7)E(&]N('1H +M92!296%L(%!R;V=R86UM97(L(&AE('1E;F1S('1O(&UA:V4*=&AI;F=S(&UO +M<F4@8VAA;&QE;F=I;F<@8GD@=V]R:VEN9R!O;B!S;VUE('-M86QL(&)U="!I +M;G1E<F5S=&EN9R!P87)T"F]F('1H92!P<F]B;&5M(&9O<B!T:&4@9FER<W0@ +M;FEN92!W965K<RP@=&AE;B!F:6YI<VAI;F<@=&AE(')E<W0@:6X*=&AE(&QA +M<W0@=V5E:RP@:6X@='=O(&]R('1H<F5E(#4P+6AO=7(@;6%R871H;VYS+B!4 +M:&ES(&YO="!O;FQY"FEN<')E<W-E<R!H:7,@;6%N86=E<BP@=VAO('=A<R!D +M97-P86ER:6YG(&]F(&5V97(@9V5T=&EN9R!T:&4@<')O:F5C= ID;VYE(&]N +M('1I;64L(&)U="!C<F5A=&5S(&$@8V]N=F5N:65N="!E>&-U<V4@9F]R(&YO +M="!D;VEN9R!T:&4*9&]C=6UE;G1A=&EO;BX@26X@9V5N97)A;#H@/% ^"@H\ +M54P^"@H\3$D^($YO(%)E86P@4')O9W)A;6UE<B!W;W)K<R Y('1O(#4N("A5 +M;FQE<W,@:70G<R Y(&EN('1H92!E=F5N:6YG('1O"C4@:6X@=&AE(&UO<FYI +M;F<N*0H*/$Q)/B!296%L(%!R;V=R86UM97)S(&1O;B=T('=E87(@;F5C:W1I +M97,N"@H\3$D^("!296%L(%!R;V=R86UM97)S(&1O;B=T('=E87(@:&EG:"!H +M965L960@<VAO97,N"@H\3$D^("!296%L(%!R;V=R86UM97)S(&%R<FEV92!A +M="!W;W)K(&EN('1I;64@9F]R(&QU;F-H+B!;.5T*"CQ,23X@02!296%L(%!R +M;V=R86UM97(@;6EG:'0@;W(@;6EG:'0@;F]T(&MN;W<@:&ES('=I9F4G<R!N +M86UE+B @2&4*9&]E<RP@:&]W979E<BP@:VYO=R!T:&4@96YT:7)E($%30TE) +M("AO<B!%0D-$24,I(&-O9&4@=&%B;&4N"@H\3$D^(%)E86P@4')O9W)A;6UE +M<G,@9&]N)W0@:VYO=R!H;W<@=&\@8V]O:RX@1W)O8V5R>2!S=&]R97,@87)E +M;B=T"F]F=&5N(&]P96X@870@,R!A+FTN+"!S;R!T:&5Y('-U<G9I=F4@;VX@ +M5'=I;FMI97,@86YD(&-O9F9E92X*"CPO54P^(#Q0/@H*/$@S/B!42$4@1E54 +M55)%/"](,SX*"E=H870@;V8@=&AE(&9U='5R93\@270@:7,@82!M871T97(@ +M;V8@<V]M92!C;VYC97)N('1O(%)E86P@4')O9W)A;6UE<G,*=&AA="!T:&4@ +M;&%T97-T(&=E;F5R871I;VX@;V8@8V]M<'5T97(@<')O9W)A;6UE<G,@87)E +M(&YO="!B96EN9PIB<F]U9VAT('5P('=I=&@@=&AE('-A;64@;W5T;&]O:R!O +M;B!L:69E(&%S('1H96ER(&5L9&5R<RX@36%N>2!O9B!T:&5M"FAA=F4@;F5V +M97(@<V5E;B!A(&-O;7!U=&5R('=I=&@@82!F<F]N="!P86YE;"X@2&%R9&QY +M(&%N>6]N90IG<F%D=6%T:6YG(&9R;VT@<V-H;V]L('1H97-E(&1A>7,@8V%N +M(&1O(&AE>"!A<FET:&UE=&EC('=I=&AO=70@80IC86QC=6QA=&]R+B @0V]L +M;&5G92!G<F%D=6%T97,@=&AE<V4@9&%Y<R!A<F4@<V]F=" M+2!P<F]T96-T +M960@9G)O;0IT:&4@<F5A;&ET:65S(&]F('!R;V=R86UM:6YG(&)Y('-O=7)C +M92!L979E;"!D96)U9V=E<G,L('1E>'0@961I=&]R<PIT:&%T(&-O=6YT('!A +M<F5N=&AE<V5S+"!A;F0@=7-E<B!F<FEE;F1L>2!O<&5R871I;F<@<WES=&5M +M<RX@(%=O<G-T(&]F"F%L;"P@<V]M92!O9B!T:&5S92!A;&QE9V5D(&-O;7!U +M=&5R('-C:65N=&ES=',@;6%N86=E('1O(&=E="!D96=R965S"G=I=&AO=70@ +M979E<B!L96%R;FEN9R!&3U)44D%.(2 @07)E('=E(&1E<W1I;F5D('1O(&)E +M8V]M92!A;B!I;F1U<W1R>0IO9B!5;FEX(&AA8VME<G,@86YD(%!A<V-A;"!P +M<F]G<F%M;65R<S\@/% ^"@I/;B!T:&4@8V]N=')A<GDN("!&<F]M(&UY(&5X +M<&5R:65N8V4L($D@8V%N(&]N;'D@<F5P;W)T('1H870@=&AE"F9U='5R92!I +M<R!B<FEG:'0@9F]R(%)E86P@4')O9W)A;6UE<G,@979E<GEW:&5R92X@3F5I +M=&AE<B!/4R\S-S @;F]R"D9/4E1204X@<VAO=R!A;GD@<VEG;G,@;V8@9'EI +M;F<@;W5T+"!D97-P:71E(&%L;"!T:&4@969F;W)T<R!O9@I087-C86P@<')O +M9W)A;6UE<G,@=&AE('=O<FQD(&]V97(N($5V96X@;6]R92!S=6)T;&4@=')I +M8VMS+"!L:6ME"F%D9&EN9R!S=')U8W1U<F5D(&-O9&EN9R!C;VYS=')U8W1S +M('1O($9/4E1204X@:&%V92!F86EL960N("!/:"!S=7)E+ IS;VUE(&-O;7!U +M=&5R('9E;F1O<G,@:&%V92!C;VUE(&]U="!W:71H($9/4E1204X@-S<@8V]M +M<&EL97)S+"!B=70*979E<GD@;VYE(&]F('1H96T@:&%S(&$@=V%Y(&]F(&-O +M;G9E<G1I;F<@:71S96QF(&)A8VL@:6YT;R!A($9/4E1204X*-C8@8V]M<&EL +M97(@870@=&AE(&1R;W @;V8@86X@;W!T:6]N(&-A<F0@+2T@=&\@8V]M<&EL +M92!$3R!L;V]P<R!L:6ME"D=O9"!M96%N="!T:&5M('1O(&)E+B \4#X*"D5V +M96X@56YI>"!M:6=H="!N;W0@8F4@87,@8F%D(&]N(%)E86P@4')O9W)A;6UE +M<G,@87,@:70@;VYC92!W87,N(%1H90IL871E<W0@<F5L96%S92!O9B!5;FEX +M(&AA<R!T:&4@<&]T96YT:6%L(&]F(&%N(&]P97)A=&EN9R!S>7-T96T@=V]R +M=&AY"F]F(&%N>2!296%L(%!R;V=R86UM97(N($ET(&AA<R!T=V\@9&EF9F5R +M96YT(&%N9"!S=6)T;'D@:6YC;VUP871I8FQE"G5S97(@:6YT97)F86-E<RP@ +M86X@87)C86YE(&%N9"!C;VUP;&EC871E9"!T97)M:6YA;"!D<FEV97(L('9I +M<G1U86P*;65M;W)Y+B!)9B!Y;W4@:6=N;W)E('1H92!F86-T('1H870@:70G +M<R!S=')U8W1U<F5D+"!E=F5N($,*<')O9W)A;6UI;F<@8V%N(&)E(&%P<')E +M8VEA=&5D(&)Y('1H92!296%L(%!R;V=R86UM97(Z(&%F=&5R(&%L;"P*=&AE +M<F4G<R!N;R!T>7!E(&-H96-K:6YG+"!V87)I86)L92!N86UE<R!A<F4@<V5V +M96X@*'1E;C\@(&5I9VAT/RD*8VAA<F%C=&5R<R!L;VYG+"!A;F0@=&AE(&%D +M9&5D(&)O;G5S(&]F('1H92!0;VEN=&5R(&1A=&$@='EP92!I<PIT:')O=VX@ +M:6XN($ET)W,@;&EK92!H879I;F<@=&AE(&)E<W0@<&%R=',@;V8@1D]25%)! +M3B!A;F0@87-S96UB;'D*;&%N9W5A9V4@:6X@;VYE('!L86-E+B @*$YO="!T +M;R!M96YT:6]N('-O;64@;V8@=&AE(&UO<F4@8W)E871I=F4@=7-E<PIF;W(@ +M/$M"1#XC9&5F:6YE/"]+0D0^+BD@/% ^"@I.;RP@=&AE(&9U='5R92!I<VXG +M="!A;&P@=&AA="!B860N("!7:'DL(&EN('1H92!P87-T(&9E=R!Y96%R<RP@ +M=&AE"G!O<'5L87(@<')E<W,@:&%S(&5V96X@8V]M;65N=&5D(&]N('1H92!B +M<FEG:'0@;F5W(&-R;W @;V8@8V]M<'5T97(*;F5R9',@86YD(&AA8VME<G,@ +M*%LW72!A;F0@6SA=*2!L96%V:6YG('!L86-E<R!L:6ME(%-T86YF;W)D(&%N +M9 I-+DDN5"X@(&9O<B!T:&4@4F5A;"!7;W)L9"X@($9R;VT@86QL(&5V:61E +M;F-E+"!T:&4@<W!I<FET(&]F(%)E86P*4')O9W)A;6UI;F<@;&EV97,@;VX@ +M:6X@=&AE<V4@>6]U;F<@;65N(&%N9"!W;VUE;BX@($%S(&QO;F<@87,@=&AE +M<F4*87)E(&EL;"UD969I;F5D(&=O86QS+"!B:7IA<G)E(&)U9W,L(&%N9"!U +M;G)E86QI<W1I8R!S8VAE9'5L97,L('1H97)E"G=I;&P@8F4@4F5A;"!0<F]G +M<F%M;65R<R!W:6QL:6YG('1O(&IU;7 @:6X@86YD(%-O;'9E(%1H92!0<F]B +M;&5M+ IS879I;F<@=&AE(&1O8W5M96YT871I;VX@9F]R(&QA=&5R+B @3&]N +M9R!L:79E($9/4E1204XA(#Q0/@H*/$@S/D%#2TY/5TQ%1T5-14Y4/"](,SX* +M"DD@=V]U;&0@;&EK92!T;R!T:&%N:R!*86X@12XL($1A=F4@4RXL(%)I8V@@ +M1RXL(%)I8V@@12X@9F]R('1H96ER(&AE;' *:6X@8VAA<F%C=&5R:7II;F<@ +M=&AE(%)E86P@4')O9W)A;6UE<BP@2&5A=&AE<B!"+B!F;W(@=&AE"FEL;'5S +M=')A=&EO;BP@2V%T:'D@12X@9F]R('!U='1I;F<@=7 @=VET:"!I="P@86YD +M(#QK8F0^871D(6%V<V13.FUA<FL\+VMB9#X@9F]R"G1H92!I;FET:6%L(&EN +M<W!R:7)A=&EO;BX@/% ^"@H\2#,^4D5&15)%3D-%4SPO2#,^"@I;,5T@(" @ +M1F5I<G-T96EN+"!"+BP@/&5M/E)E86P@365N($1O;B=T($5A="!1=6EC:&4\ +M+V5M/BP@3F5W(%EO<FLL"B @(" @("!0;V-K970@0F]O:W,L(#$Y.#(N(#Q0 +M/@H*6S)=(" @(%=I<G1H+"!.+BP@/&5M/D%L9V]R:71H;7,@*R!$871A<W1R +M=6-T=7)E<R ](%!R;V=R86US/"]E;3XL"B @(" @("!0<F5N=&EC92!(86QL +M+" Q.3<V+B \4#X*"ELS72 @("!897)O>"!005)#(&5D:71O<G,@+B N("X@ +M/% ^"@I;-%T@(" @1FEN<V5T:"P@0RXL(#QE;3Y4:&5O<GD@86YD(%!R86-T +M:6-E(&]F(%1E>'0@161I=&]R<R M"B @(" @("!O<B M(&$@0V]O:V)O;VL@ +M9F]R(&%N($5-04-3/"]E;3XL($(N4RX@5&AE<VES+ H@(" @(" @34E4+TQ# +M4R]432TQ-C4L($UA<W-A8VAU<V5T=',@26YS=&ET=71E(&]F(%1E8VAN;VQO +M9WDL"B @(" @("!-87D@,3DX,"X@/% ^"@I;-5T@(" @5V5I;F)E<F<L($<N +M+" \96T^5&AE(%!S>6-H;VQO9WD@;V8@0V]M<'5T97(@4')O9W)A;6UI;F<\ +M+V5M/BP*(" @(" @($YE=R!9;W)K+"!686X@3F]S=')A8F0@4F5I;FAO;&0L +M(#$Y-S$L('!A9V4@,3$P+B \4#X*"ELV72 @("!$:6IK<W1R82P@12XL(#QE +M;3Y/;B!T:&4@1U)%14X@3&%N9W5A9V4@4W5B;6ET=&5D('1O('1H92!$;T0\ +M+V5M/BP*(" @(" @(%-I9W!L86X@;F]T:6-E<RP@5F]L=6UE(#,L($YU;6)E +M<B Q,"P@3V-T;V)E<B Q.3<X+B \4#X*"ELW72 @("!2;W-E+"!&<F%N:RP@ +M/&5M/DIO>2!O9B!(86-K:6YG/"]E;3XL(%-C:65N8V4@.#(L(%9O;'5M92 S +M+"!.=6UB97(@.2P*(" @(" @($YO=F5M8F5R(#$Y.#(L('!A9V5S(#4X("T@ +M-C8N(#Q0/@H*6SA=(" @(%1H92!(86-K97(@4&%P97)S+" \96T^4'-Y8VAO +M;&]G>2!4;V1A>3PO96T^+"!!=6=U<W0@,3DX,"X@/% ^"@I;.5T@(" @/&5M +M/D1A=&%M871I;VX\+V5M/BP@2G5L>2P@,3DX,RP@<' N(#(V,RTR-C4N(#Q0 +M/@H*/&AR/@H*/$%$1%)%4U,^(#QA(&AR968](FEN9&5X+FAT;6PB/DAA8VME +M<B=S(%=I<V1O;3PO83XO(%)E86P@4')O9W)A;6UE<G,*1&]N)W0@57-E(%!! +M4T-!3" \+T%$1%)%4U,^"@H\(2TM(&AH;71S('-T87)T("TM/@I,87-T(&UO +E9&EF:65D.B!7960@36%R(#(W(#$W.C0X.C4P($535" Q.3DV"@I, + diff --git a/lib/kernel/test/rpc_SUITE.erl b/lib/kernel/test/rpc_SUITE.erl new file mode 100644 index 0000000000..2b39e31a80 --- /dev/null +++ b/lib/kernel/test/rpc_SUITE.erl @@ -0,0 +1,518 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2000-2009. 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(rpc_SUITE). + +-export([all/1]). +-export([call/1, block_call/1, multicall/1, multicall_timeout/1, + multicall_dies/1, multicall_node_dies/1, + called_dies/1, called_node_dies/1, + called_throws/1, call_benchmark/1, async_call/1]). + +-export([suicide/2, suicide/3, f/0, f2/0]). + +-include("test_server.hrl"). + +all(suite) -> + [call, block_call, multicall, multicall_timeout, + multicall_dies, multicall_node_dies, + called_dies, called_node_dies, + called_throws, call_benchmark, async_call]. + + +call(doc) -> "Test different rpc calls"; +call(Config) when is_list(Config) -> + Timetrap = ?t:timetrap(?t:seconds(30)), + ?line PA = filename:dirname(code:which(?MODULE)), + %% Note. First part of nodename sets response delay in seconds + ?line {ok, N1} = ?t:start_node('3_rpc_SUITE_call', slave, + [{args, "-pa " ++ PA}]), + ?line {ok, N2} = ?t:start_node('1_rcp_SUITE_call', slave, + [{args, "-pa " ++ PA}]), + ?line {ok, N3} = ?t:start_node('4_rcp_SUITE_call', slave, + [{args, "-pa " ++ PA}]), + ?line {ok, N4} = ?t:start_node('8_rcp_SUITE_call', slave, + [{args, "-pa " ++ PA}]), + ?line ok = io:format("~p~n", [[N1, N2, N3]]), + ?line {hej,_,N1} = rpc:call(N1, ?MODULE, f, []), + ?line {hej,_,N2} = rpc:call(N2, ?MODULE, f, [], 2000), + ?line {badrpc,timeout} = rpc:call(N3, ?MODULE, f, [], 2000), + ?line receive after 6000 -> ok end, + ?line [] = flush([]), + ?line {hej,_,N4} = rpc:call(N4, ?MODULE, f, []), + ?line ?t:stop_node(N1), + ?line ?t:stop_node(N2), + ?line ?t:stop_node(N3), + ?line ?t:stop_node(N4), + ?t:timetrap_cancel(Timetrap), + ok. + +block_call(doc) -> "Test different rpc calls"; +block_call(Config) when is_list(Config) -> + Timetrap = ?t:timetrap(?t:seconds(30)), + ?line PA = filename:dirname(code:which(?MODULE)), + %% Note. First part of nodename sets response delay in seconds + ?line {ok, N1} = ?t:start_node('3_rpc_SUITE_block_call', slave, + [{args, "-pa " ++ PA}]), + ?line {ok, N2} = ?t:start_node('1_rcp_SUITE_block_call', slave, + [{args, "-pa " ++ PA}]), + ?line {ok, N3} = ?t:start_node('4_rcp_SUITE_block_call', slave, + [{args, "-pa " ++ PA}]), + ?line {ok, N4} = ?t:start_node('8_rcp_SUITE_block_call', slave, + [{args, "-pa " ++ PA}]), + ?line ok = io:format("~p~n", [[N1, N2, N3]]), + ?line {hej,_,N1} = rpc:block_call(N1, ?MODULE, f, []), + ?line {hej,_,N2} = rpc:block_call(N2, ?MODULE, f, [], 2000), + ?line {badrpc,timeout} = rpc:block_call(N3, ?MODULE, f, [], 2000), + ?line receive after 6000 -> ok end, + ?line [] = flush([]), + ?line {hej,_,N4} = rpc:block_call(N4, ?MODULE, f, []), + ?line ?t:stop_node(N1), + ?line ?t:stop_node(N2), + ?line ?t:stop_node(N3), + ?line ?t:stop_node(N4), + ?t:timetrap_cancel(Timetrap), + ok. + + +multicall(doc) -> + "OTP-3449"; +multicall(Config) when is_list(Config) -> + Timetrap = ?t:timetrap(?t:seconds(20)), + ?line PA = filename:dirname(code:which(?MODULE)), + %% Note. First part of nodename sets response delay in seconds + ?line {ok, N1} = ?t:start_node('3_rpc_SUITE_multicall', slave, + [{args, "-pa " ++ PA}]), + ?line {ok, N2} = ?t:start_node('1_rcp_SUITE_multicall', slave, + [{args, "-pa " ++ PA}]), + ?line ok = io:format("~p~n", [[N1, N2]]), + ?line {[{hej,_,N1},{hej,_,N2}],[]} = + rpc:multicall([N1, N2], ?MODULE, f, []), + ?line Msgs = flush([]), + ?line [] = Msgs, + ?line ?t:stop_node(N1), + ?line ?t:stop_node(N2), + ?t:timetrap_cancel(Timetrap), + ok. + +multicall_timeout(Config) when is_list(Config) -> + Timetrap = ?t:timetrap(?t:seconds(30)), + ?line PA = filename:dirname(code:which(?MODULE)), + %% Note. First part of nodename sets response delay in seconds + ?line {ok, N1} = ?t:start_node('11_rpc_SUITE_multicall', slave, + [{args, "-pa " ++ PA}]), + ?line {ok, N2} = ?t:start_node('8_rpc_SUITE_multicall', slave, + [{args, "-pa " ++ PA}]), + ?line {ok, N3} = ?t:start_node('5_rpc_SUITE_multicall', slave, + [{args, "-pa " ++ PA}]), + ?line {ok, N4} = ?t:start_node('2_rcp_SUITE_multicall', slave, + [{args, "-pa " ++ PA}]), + ?line ok = io:format("~p~n", [[N1, N2]]), + ?line {[{hej,_,N3},{hej,_,N4}],[N1, N2]} = + rpc:multicall([N3, N1, N2, N4], ?MODULE, f, [], ?t:seconds(6)), + ?t:sleep(?t:seconds(8)), %% Wait for late answers + ?line Msgs = flush([]), + ?line [] = Msgs, + ?line ?t:stop_node(N1), + ?line ?t:stop_node(N2), + ?line ?t:stop_node(N3), + ?line ?t:stop_node(N4), + ?t:timetrap_cancel(Timetrap), + ok. + +multicall_dies(Config) when is_list(Config) -> + Timetrap = ?t:timetrap(?t:seconds(30)), + ?line PA = filename:dirname(code:which(?MODULE)), + ?line {ok, N1} = ?t:start_node('rpc_SUITE_multicall_dies_1', slave, + [{args, "-pa " ++ PA}]), + ?line {ok, N2} = ?t:start_node('rcp_SUITE_multicall_dies_2', slave, + [{args, "-pa " ++ PA}]), + ?line Nodes = [N1, N2], + %% + ?line {[{badrpc, {'EXIT', normal}}, {badrpc, {'EXIT', normal}}], []} = + do_multicall(Nodes, erlang, exit, [normal]), + ?line {[{badrpc, {'EXIT', abnormal}}, {badrpc, {'EXIT', abnormal}}], []} = + do_multicall(Nodes, erlang, exit, [abnormal]), + ?line {[{badrpc, {'EXIT', {badarith, _}}}, + {badrpc, {'EXIT', {badarith, _}}}], + []} = + do_multicall(Nodes, erlang, 'div', [1, 0]), + ?line {[{badrpc, {'EXIT', {badarg, _}}}, + {badrpc, {'EXIT', {badarg, _}}}], + []} = + do_multicall(Nodes, erlang, atom_to_list, [1]), + ?line {[{badrpc, {'EXIT', {undef, _}}}, + {badrpc, {'EXIT', {undef, _}}}], + []} = + do_multicall(Nodes, ?MODULE, suicide, []), + ?line {[timeout, timeout], []} = + do_multicall(Nodes, ?MODULE, suicide, [link, normal]), + ?line {[{badrpc, {'EXIT', abnormal}}, {badrpc, {'EXIT', abnormal}}], []} = + do_multicall(Nodes, ?MODULE, suicide, [link, abnormal]), + ?line {[timeout, timeout], []} = + do_multicall(Nodes, ?MODULE, suicide, [exit, normal]), + ?line {[{badrpc, {'EXIT', abnormal}}, {badrpc, {'EXIT', abnormal}}], []} = + do_multicall(Nodes, ?MODULE, suicide, [exit, abnormal]), + ?line {[{badrpc, {'EXIT', killed}}, {badrpc, {'EXIT', killed}}], []} = + do_multicall(Nodes, ?MODULE, suicide, [exit, kill]), + %% + ?line ?t:stop_node(N1), + ?line ?t:stop_node(N2), + ?t:timetrap_cancel(Timetrap), + ok. + +do_multicall(Nodes, Mod, Func, Args) -> + ?line ok = io:format("~p:~p~p~n", [Mod, Func, Args]), + ?line Result = rpc:multicall(Nodes, Mod, Func, Args), + ?line Msgs = flush([]), + ?line [] = Msgs, + Result. + + + +multicall_node_dies(doc) -> + ""; +multicall_node_dies(Config) when is_list(Config) -> + Timetrap = ?t:timetrap(?t:seconds(60)), + %% + do_multicall_2_nodes_dies(?MODULE, suicide, [erlang, halt, []]), + do_multicall_2_nodes_dies(?MODULE, suicide, [init, stop, []]), + do_multicall_2_nodes_dies(?MODULE, suicide, [rpc, stop, []]), + %% + ?t:timetrap_cancel(Timetrap), + ok. + +do_multicall_2_nodes_dies(Mod, Func, Args) -> + ?line ok = io:format("~p:~p~p~n", [Mod, Func, Args]), + ?line PA = filename:dirname(code:which(?MODULE)), + ?line {ok, N1} = ?t:start_node('rpc_SUITE_multicall_node_dies_1', slave, + [{args, "-pa " ++ PA}]), + ?line {ok, N2} = ?t:start_node('rcp_SUITE_multicall_node_dies_2', slave, + [{args, "-pa " ++ PA}]), + ?line Nodes = [N1, N2], + ?line {[], Nodes} = rpc:multicall(Nodes, Mod, Func, Args), + ?line Msgs = flush([]), + ?line [] = Msgs, + ok. + + + +called_dies(doc) -> + "OTP-3766"; +called_dies(Config) when is_list(Config) -> + Timetrap = ?t:timetrap(?t:seconds(210)), + ?line PA = filename:dirname(code:which(?MODULE)), + ?line {ok, N} = ?t:start_node(rpc_SUITE_called_dies, slave, + [{args, "-pa " ++ PA}]), + %% + ?line rep(fun (Tag, Call, Args) -> + {Tag,{badrpc,{'EXIT',normal}}} = + {Tag,apply(rpc, Call, Args)} + end, N, erlang, exit, [normal]), + ?line rep(fun (Tag, Call, Args) -> + {Tag,{badrpc,{'EXIT',abnormal}}} = + {Tag,apply(rpc, Call, Args)} + end, N, erlang, exit, [abnormal]), + ?line rep(fun (Tag, Call, Args) -> + {Tag,{badrpc,{'EXIT',{badarith,_}}}} = + {Tag,apply(rpc, Call, Args)} + end, N, erlang, 'div', [1,0]), + ?line rep(fun (Tag, Call, Args) -> + {Tag,{badrpc,{'EXIT',{badarg,_}}}} = + {Tag,apply(rpc, Call, Args)} + end, N, erlang, atom_to_list, [1]), + ?line rep(fun (Tag, Call, Args) -> + {Tag,{badrpc,{'EXIT',{undef,_}}}} = + {Tag,apply(rpc, Call, Args)} + end, N, ?MODULE, suicide, []), + %% + TrapExit = process_flag(trap_exit, true), + %% + ?line rep(fun (Tag, Call, Args=[Node|_]) when Node == node() -> + {Tag,timeout} = + {Tag,apply(rpc, Call, Args)}, + {Tag,flush,[{'EXIT',_,normal}]} = + {Tag,flush,flush([])}; + (Tag, Call, Args) -> + {Tag,timeout} = + {Tag,apply(rpc, Call, Args)} + end, N, ?MODULE, suicide, [link,normal]), + ?line rep(fun (Tag, Call, Args=[Node|_]) when Node == node() -> + {Tag,timeout} = + {Tag,apply(rpc, Call, Args)}, + {Tag,flush,[{'EXIT',_,abnormal}]} = + {Tag,flush,flush([])}; + (Tag, block_call, Args) -> + {Tag,timeout} = + {Tag,apply(rpc, block_call, Args)}; + (Tag, Call, Args) -> + {Tag,{badrpc,{'EXIT',abnormal}}} = + {Tag,apply(rpc, Call, Args)} + end, N, ?MODULE, suicide, [link,abnormal]), + ?line rep(fun (Tag, Call, Args=[Node|_]) when Node == node() -> + {Tag,timeout} = + {Tag,apply(rpc, Call, Args)}, + {Tag,flush,[{'EXIT',_,normal}]} = + {Tag,flush,flush([])}; + (Tag, Call, Args) -> + {Tag,timeout} = + {Tag,apply(rpc, Call, Args)} + end, N, ?MODULE, suicide, [exit,normal]), + ?line rep(fun (Tag, Call, Args=[Node|_]) when Node == node() -> + {Tag,timeout} = + {Tag,apply(rpc, Call, Args)}, + {Tag,flush,[{'EXIT',_,abnormal}]} = + {Tag,flush,flush([])}; + (Tag, block_call, Args) -> + {Tag,timeout} = + {Tag,apply(rpc, block_call, Args)}; + (Tag, Call, Args) -> + {Tag,{badrpc,{'EXIT',abnormal}}} = + {Tag,apply(rpc, Call, Args)} + end, N, ?MODULE, suicide, [exit,abnormal]), + %% + process_flag(trap_exit, TrapExit), + %% + ?line rep(fun %% A local [exit,kill] would kill the test case process + (_Tag, _Call, [Node|_]) when Node == node() -> + ok; + %% A block_call [exit,kill] would kill the rpc server + (_Tag, block_call, _Args) -> ok; + (Tag, Call, Args) -> + {Tag,{badrpc,{'EXIT',killed}}} = + {Tag,apply(rpc, Call, Args)} + end, N, ?MODULE, suicide, [exit,kill]), + %% + ?line [] = flush([]), + ?line ?t:stop_node(N), + ?t:timetrap_cancel(Timetrap), + ok. + +rep(Fun, N, M, F, A) -> + Fun(1, call, [node(), M, F, A]), + Fun(2, call, [node(), M, F, A, infinity]), + Fun(3, call, [N, M, F, A]), + Fun(4, call, [N, M, F, A, infinity]), + Fun(5, call, [N, M, F, A, 3000]), + Fun(6, block_call, [node(), M, F, A]), + Fun(7, block_call, [node(), M, F, A, infinity]), + Fun(8, block_call, [N, M, F, A]), + Fun(9, block_call, [N, M, F, A, infinity]), + Fun(10, block_call, [N, M, F, A, 3000]), + ok. + + +suicide(link, Reason) -> + spawn_link( + fun() -> + exit(Reason) + end), + receive after 2000 -> timeout end; +suicide(exit, Reason) -> + Self = self(), + spawn( + fun() -> + exit(Self, Reason) + end), + receive after 2000 -> timeout end. + +suicide(erlang, exit, [Name, Reason]) when is_atom(Name) -> + case whereis(Name) of + Pid when pid(Pid) -> suicide(erlang, exit, [Pid, Reason]) + end; +suicide(Mod, Func, Args) -> + spawn_link( + fun() -> + apply(Mod, Func, Args) + end), + receive after 10000 -> timeout end. + + + +called_node_dies(doc) -> + ""; +called_node_dies(suite) -> []; +called_node_dies(Config) when is_list(Config) -> + Timetrap = ?t:timetrap(?t:minutes(2)), + ?line PA = filename:dirname(code:which(?MODULE)), + %% + ?line node_rep( + fun (Tag, Call, Args) -> + {Tag,{badrpc,nodedown}} = + {Tag,apply(rpc, Call, Args)} + end, "rpc_SUITE_called_node_dies_1", + PA, ?MODULE, suicide, [erlang,halt,[]]), + ?line node_rep( + fun (Tag, Call, Args) -> + {Tag,{badrpc,nodedown}} = + {Tag,apply(rpc, Call, Args)} + end, "rpc_SUITE_called_node_dies_2", + PA, ?MODULE, suicide, [init,stop,[]]), + ?line node_rep( + fun (Tag, Call, Args=[_|_]) -> + {Tag,{'EXIT',{killed,_}}} = + {Tag,catch {noexit,apply(rpc, Call, Args)}} + end, "rpc_SUITE_called_node_dies_3", + PA, ?MODULE, suicide, [erlang,exit,[rex,kill]]), + ?line node_rep( + fun %% Cannot block call rpc - will hang + (_Tag, block_call, _Args) -> ok; + (Tag, Call, Args=[_|_]) -> + {Tag,{'EXIT',{normal,_}}} = + {Tag,catch {noexit,apply(rpc, Call, Args)}} + end, "rpc_SUITE_called_node_dies_4", + PA, ?MODULE, suicide, [rpc,stop,[]]), + %% + ?t:timetrap_cancel(Timetrap), + ok. + +node_rep(Fun, Name, PA, M, F, A) -> + {ok, Na} = ?t:start_node(list_to_atom(Name++"_a"), slave, + [{args, "-pa " ++ PA}]), + Fun(a, call, [Na, M, F, A]), + catch ?t:stop_node(Na), + {ok, Nb} = ?t:start_node(list_to_atom(Name++"_b"), slave, + [{args, "-pa " ++ PA}]), + Fun(b, call, [Nb, M, F, A, infinity]), + catch ?t:stop_node(Nb), + {ok, Nc} = ?t:start_node(list_to_atom(Name++"_c"), slave, + [{args, "-pa " ++ PA}]), + Fun(c, call, [Nc, M, F, A, infinity]), + catch ?t:stop_node(Nc), + %% + {ok, Nd} = ?t:start_node(list_to_atom(Name++"_d"), slave, + [{args, "-pa " ++ PA}]), + Fun(d, block_call, [Nd, M, F, A]), + catch ?t:stop_node(Nd), + {ok, Ne} = ?t:start_node(list_to_atom(Name++"_e"), slave, + [{args, "-pa " ++ PA}]), + Fun(e, block_call, [Ne, M, F, A, infinity]), + catch ?t:stop_node(Ne), + {ok, Nf} = ?t:start_node(list_to_atom(Name++"_f"), slave, + [{args, "-pa " ++ PA}]), + Fun(f, block_call, [Nf, M, F, A, infinity]), + catch ?t:stop_node(Nf), + ok. + + + +called_throws(doc) -> + "OTP-3766"; +called_throws(Config) when is_list(Config) -> + Timetrap = ?t:timetrap(?t:seconds(10)), + ?line PA = filename:dirname(code:which(?MODULE)), + %% + ?line {ok, N} = ?t:start_node(rpc_SUITE_called_throws, slave, + [{args, "-pa " ++ PA}]), + %% + ?line rep(fun (Tag, Call, Args) -> + {Tag,up} = + {Tag,apply(rpc, Call, Args)} + end, N, erlang, throw, [up]), + ?line rep(fun (Tag, Call, Args) -> + {Tag,{badrpc,{'EXIT',reason}}} = + {Tag,apply(rpc, Call, Args)} + end, N, erlang, throw, [{'EXIT',reason}]), + %% + ?line ?t:stop_node(N), + ?t:timetrap_cancel(Timetrap), + ok. + + + +call_benchmark(Config) when is_list(Config) -> + Timetrap = ?t:timetrap(?t:seconds(120)), + ?line PA = filename:dirname(code:which(?MODULE)), + ?line {ok, Node} = ?t:start_node(rpc_SUITE_call_benchmark, slave, + [{args, "-pa " ++ PA}]), + Iter = case erlang:system_info(modified_timing_level) of + undefined -> 10000; + _ -> 500 %Moified timing - spawn is slower + end, + ?line do_call_benchmark(Node, Iter), + ?t:timetrap_cancel(Timetrap), + ok. + +do_call_benchmark(Node, M) when integer(M), M > 0 -> + do_call_benchmark(Node, erlang:now(), 0, M). + +do_call_benchmark(Node, {A,B,C}, M, M) -> + ?line {D,E,F} = erlang:now(), + ?line T = float(D-A)*1000000.0 + float(E-B) + float(F-C)*0.000001, + ?line Q = 3.0 * float(M) / T, + ?line ?t:stop_node(Node), + {comment, + lists:flatten([float_to_list(Q)," RPC calls per second"])}; +do_call_benchmark(Node, Then, I, M) -> + ?line Node = rpc:call(Node, erlang, node, []), + ?line _ = rpc:call(Node, erlang, whereis, [rex]), + ?line 3 = rpc:call(Node, erlang, '+', [1,2]), + ?line do_call_benchmark(Node, Then, I+1, M). + +async_call(Config) when is_list(Config) -> + Dog = ?t:timetrap(?t:seconds(120)), + + %% Note: First part of nodename sets response delay in seconds. + ?line PA = filename:dirname(code:which(?MODULE)), + ?line NodeArgs = [{args,"-pa "++ PA}], + ?line {ok,Node1} = ?t:start_node('1_rpc_SUITE_call', slave, NodeArgs), + ?line {ok,Node2} = ?t:start_node('10_rpc_SUITE_call', slave, NodeArgs), + ?line {ok,Node3} = ?t:start_node('20_rpc_SUITE_call', slave, NodeArgs), + ?line Promise1 = rpc:async_call(Node1, ?MODULE, f, []), + ?line Promise2 = rpc:async_call(Node2, ?MODULE, f, []), + ?line Promise3 = rpc:async_call(Node3, ?MODULE, f, []), + + %% Test fast timeouts. + ?line timeout = rpc:nb_yield(Promise2), + ?line timeout = rpc:nb_yield(Promise2, 10), + + %% Let Node1 finish its work before yielding. + ?t:sleep(?t:seconds(2)), + ?line {hej,_,Node1} = rpc:yield(Promise1), + + %% Wait for the Node2 and Node3. + ?line {value,{hej,_,Node2}} = rpc:nb_yield(Promise2, infinity), + ?line {hej,_,Node3} = rpc:yield(Promise3), + + ?t:timetrap_cancel(Dog), + ok. + +%%% +%%% Utility functions. +%%% + +flush(L) -> + receive + M -> + flush([M|L]) + after 0 -> + L + end. + +t() -> + [N | _] = string:tokens(atom_to_list(node()), "_"), + 1000*list_to_integer(N). + +f() -> + timer:sleep(T=t()), + spawn(?MODULE, f2, []), + {hej,T,node()}. + +f2() -> + timer:sleep(500), + halt(). diff --git a/lib/kernel/test/seq_trace_SUITE.erl b/lib/kernel/test/seq_trace_SUITE.erl new file mode 100644 index 0000000000..f582b94c97 --- /dev/null +++ b/lib/kernel/test/seq_trace_SUITE.erl @@ -0,0 +1,760 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(seq_trace_SUITE). + +-export([all/1,init_per_testcase/2,fin_per_testcase/2]). +-export([token_set_get/1, tracer_set_get/1, print/1, + send/1, distributed_send/1, recv/1, distributed_recv/1, + trace_exit/1, distributed_exit/1, call/1, port/1, + match_set_seq_token/1, gc_seq_token/1]). + +% internal exports +-export([simple_tracer/2, one_time_receiver/0, one_time_receiver/1, + start_tracer/0, stop_tracer/1, + do_match_set_seq_token/1, do_gc_seq_token/1, countdown_start/2]). + +%-define(line_trace, 1). +-include("test_server.hrl"). + +-define(default_timeout, ?t:minutes(1)). + +all(suite) -> [token_set_get, tracer_set_get, print, + send, distributed_send, recv, distributed_recv, + trace_exit, distributed_exit, call, port, + match_set_seq_token, gc_seq_token]. + +init_per_testcase(_Case, Config) -> + ?line Dog = test_server:timetrap(?default_timeout), + [{watchdog, Dog}|Config]. + +fin_per_testcase(_Case, Config) -> + Dog=?config(watchdog, Config), + test_server:timetrap_cancel(Dog), + ok. + +%% Verifies that the set_token and get_token functions work as expected + +token_set_get(doc) -> []; +token_set_get(suite) -> []; +token_set_get(Config) when is_list(Config) -> + ?line Self = self(), + ?line seq_trace:reset_trace(), + %% Test that initial seq_trace is disabled + ?line [] = seq_trace:get_token(), + %% Test setting and reading the different fields + ?line 0 = seq_trace:set_token(label,17), + ?line {label,17} = seq_trace:get_token(label), + ?line false = seq_trace:set_token(print,true), + ?line {print,true} = seq_trace:get_token(print), + ?line false = seq_trace:set_token(send,true), + ?line {send,true} = seq_trace:get_token(send), + ?line false = seq_trace:set_token('receive',true), + ?line {'receive',true} = seq_trace:get_token('receive'), + ?line false = seq_trace:set_token(timestamp,true), + ?line {timestamp,true} = seq_trace:get_token(timestamp), + %% Check the whole token + ?line {15,17,0,Self,0} = seq_trace:get_token(), % all flags are set + %% Test setting and reading the 'serial' field + ?line {0,0} = seq_trace:set_token(serial,{3,5}), + ?line {serial,{3,5}} = seq_trace:get_token(serial), + %% Check the whole token, test that a whole token can be set and get + ?line {15,17,5,Self,3} = seq_trace:get_token(), + ?line seq_trace:set_token({15,19,7,Self,5}), + ?line {15,19,7,Self,5} = seq_trace:get_token(), + %% Check that receive timeout does not reset token + ?line receive after 0 -> ok end, + ?line {15,19,7,Self,5} = seq_trace:get_token(), + %% Check that token can be unset + ?line {15,19,7,Self,5} = seq_trace:set_token([]), + ?line [] = seq_trace:get_token(), + %% Check that Previous serial counter survived unset token + ?line 0 = seq_trace:set_token(label, 17), + ?line {0,17,0,Self,5} = seq_trace:get_token(), + %% Check that reset_trace resets the token and clears + %% the Previous serial counter + ?line seq_trace:reset_trace(), + ?line [] = seq_trace:get_token(), + ?line 0 = seq_trace:set_token(label, 19), + ?line {0,19,0,Self,0} = seq_trace:get_token(), + %% Cleanup + ?line seq_trace:reset_trace(), + ok. + +tracer_set_get(doc) -> []; +tracer_set_get(suite) -> []; +tracer_set_get(Config) when is_list(Config) -> + ?line Self = self(), + ?line seq_trace:set_system_tracer(self()), + ?line Self = seq_trace:get_system_tracer(), + ?line Self = seq_trace:set_system_tracer(false), + ?line false = seq_trace:get_system_tracer(), + + %% Set the system tracer to a port. + + ?line Port = load_tracer(Config), + ?line seq_trace:set_system_tracer(Port), + ?line Port = seq_trace:get_system_tracer(), + ?line Port = seq_trace:set_system_tracer(false), + ?line false = seq_trace:get_system_tracer(), + ok. + +print(doc) -> []; +print(suite) -> []; +print(Config) when is_list(Config) -> + ?line start_tracer(), + ?line seq_trace:set_token(print,true), + ?line seq_trace:print(0,print1), + ?line seq_trace:print(1,print2), + ?line seq_trace:print(print3), + ?line seq_trace:reset_trace(), + ?line [{0,{print,_,_,[],print1}}, + {0,{print,_,_,[],print3}}] = stop_tracer(2). + +send(doc) -> []; +send(suite) -> []; +send(Config) when is_list(Config) -> + ?line seq_trace:reset_trace(), + ?line start_tracer(), + ?line Receiver = spawn(?MODULE,one_time_receiver,[]), + ?line seq_trace:set_token(send,true), + ?line Receiver ! send, + ?line Self = self(), + ?line seq_trace:reset_trace(), + ?line [{0,{send,_,Self,Receiver,send}}] = stop_tracer(1). + +distributed_send(doc) -> []; +distributed_send(suite) -> []; +distributed_send(Config) when is_list(Config) -> + ?line {ok,Node} = start_node(seq_trace_other,[]), + ?line {_,Dir} = code:is_loaded(?MODULE), + ?line Mdir = filename:dirname(Dir), + ?line true = rpc:call(Node,code,add_patha,[Mdir]), + ?line seq_trace:reset_trace(), + ?line start_tracer(), + ?line Receiver = spawn(Node,?MODULE,one_time_receiver,[]), + ?line seq_trace:set_token(send,true), + ?line Receiver ! send, + ?line Self = self(), + ?line seq_trace:reset_trace(), + ?line stop_node(Node), + ?line [{0,{send,_,Self,Receiver,send}}] = stop_tracer(1). + +recv(doc) -> []; +recv(suite) -> []; +recv(Config) when is_list(Config) -> + ?line seq_trace:reset_trace(), + ?line start_tracer(), + ?line Receiver = spawn(?MODULE,one_time_receiver,[]), + ?line seq_trace:set_token('receive',true), + ?line Receiver ! 'receive', + %% let the other process receive the message: + ?line receive after 1 -> ok end, + ?line Self = self(), + ?line seq_trace:reset_trace(), + ?line [{0,{'receive',_,Self,Receiver,'receive'}}] = stop_tracer(1). + +distributed_recv(doc) -> []; +distributed_recv(suite) -> []; +distributed_recv(Config) when is_list(Config) -> + ?line {ok,Node} = start_node(seq_trace_other,[]), + ?line {_,Dir} = code:is_loaded(?MODULE), + ?line Mdir = filename:dirname(Dir), + ?line true = rpc:call(Node,code,add_patha,[Mdir]), + ?line seq_trace:reset_trace(), + ?line rpc:call(Node,?MODULE,start_tracer,[]), + ?line Receiver = spawn(Node,?MODULE,one_time_receiver,[]), + ?line seq_trace:set_token('receive',true), + ?line Receiver ! 'receive', + %% let the other process receive the message: + ?line receive after 1 -> ok end, + ?line Self = self(), + ?line seq_trace:reset_trace(), + ?line Result = rpc:call(Node,?MODULE,stop_tracer,[1]), + ?line stop_node(Node), + ?line ok = io:format("~p~n",[Result]), + ?line [{0,{'receive',_,Self,Receiver,'receive'}}] = Result. + +trace_exit(doc) -> []; +trace_exit(suite) -> []; +trace_exit(Config) when is_list(Config) -> + ?line seq_trace:reset_trace(), + ?line start_tracer(), + ?line Receiver = spawn_link(?MODULE, one_time_receiver, [exit]), + ?line process_flag(trap_exit, true), + ?line seq_trace:set_token(send,true), + ?line Receiver ! {before, exit}, + %% let the other process receive the message: + ?line receive + {'EXIT', Receiver, {exit, {before, exit}}} -> + seq_trace:set_token([]); + Other -> + seq_trace:set_token([]), + ?t:fail({received, Other}) + end, + ?line Self = self(), + ?line Result = stop_tracer(2), + ?line seq_trace:reset_trace(), + ?line ok = io:format("~p~n", [Result]), + ?line [{0, {send, {0,1}, Self, Receiver, {before, exit}}}, + {0, {send, {1,2}, Receiver, Self, + {'EXIT', Receiver, {exit, {before, exit}}}}}] = Result. + +distributed_exit(doc) -> []; +distributed_exit(suite) -> []; +distributed_exit(Config) when is_list(Config) -> + ?line {ok, Node} = start_node(seq_trace_other, []), + ?line {_, Dir} = code:is_loaded(?MODULE), + ?line Mdir = filename:dirname(Dir), + ?line true = rpc:call(Node, code, add_patha, [Mdir]), + ?line seq_trace:reset_trace(), + ?line rpc:call(Node, ?MODULE, start_tracer,[]), + ?line Receiver = spawn_link(Node, ?MODULE, one_time_receiver, [exit]), + ?line process_flag(trap_exit, true), + ?line seq_trace:set_token(send, true), + ?line Receiver ! {before, exit}, + %% let the other process receive the message: + ?line receive + {'EXIT', Receiver, {exit, {before, exit}}} -> + seq_trace:set_token([]); + Other -> + seq_trace:set_token([]), + ?t:fail({received, Other}) + end, + ?line Self = self(), + ?line Result = rpc:call(Node, ?MODULE, stop_tracer, [1]), + ?line seq_trace:reset_trace(), + ?line stop_node(Node), + ?line ok = io:format("~p~n", [Result]), + ?line [{0, {send, {1, 2}, Receiver, Self, + {'EXIT', Receiver, {exit, {before, exit}}}}}] = Result. + +call(doc) -> + "Tests special forms {is_seq_trace} and {get_seq_token} " + "in trace match specs."; +call(suite) -> + []; +call(Config) when is_list(Config) -> + ?line Self = self(), + ?line seq_trace:reset_trace(), + ?line TrA = transparent_tracer(), + ?line 1 = + erlang:trace(Self, true, + [call, set_on_spawn, {tracer, TrA(pid)}]), + ?line 1 = + erlang:trace_pattern({?MODULE, call_tracee_1, 1}, + [{'_', + [], + [{message, {{{self}, {get_seq_token}}}}]}], + [local]), + ?line 1 = + erlang:trace_pattern({?MODULE, call_tracee_2, 1}, + [{'_', + [{is_seq_trace}], + [{message, {{{self}, {get_seq_token}}}}]}], + [local]), + ?line RefA = make_ref(), + ?line Pid2A = spawn_link( + fun() -> + receive {_, msg, RefA} -> ok end, + RefA = call_tracee_2(RefA), + Self ! {self(), msg, RefA} + end), + ?line Pid1A = spawn_link( + fun() -> + receive {_, msg, RefA} -> ok end, + RefA = call_tracee_1(RefA), + Pid2A ! {self(), msg, RefA} + end), + ?line Pid1A ! {Self, msg, RefA}, + %% The message is passed Self -> Pid1B -> Pid2B -> Self. + %% Traced functions are called in Pid1B and Pid2B. + ?line receive {Pid2A, msg, RefA} -> ok end, + %% Only call_tracee1 will be traced since the guard for + %% call_tracee2 requires a sequential trace. The trace + %% token is undefined. + ?line Token2A = [], + ?line {ok, [{trace, Pid1A, call, + {?MODULE, call_tracee_1, [RefA]}, + {Pid1A, Token2A}}]} = + TrA({stop, 1}), + + ?line seq_trace:reset_trace(), + + ?line TrB = transparent_tracer(), + ?line 1 = + erlang:trace(Self, true, + [call, set_on_spawn, {tracer, TrB(pid)}]), + ?line Label = 17, + ?line seq_trace:set_token(label, Label), % Token enters here!! + ?line RefB = make_ref(), + ?line Pid2B = spawn_link( + fun() -> + receive {_, msg, RefB} -> ok end, + RefB = call_tracee_2(RefB), + Self ! {self(), msg, RefB} + end), + ?line Pid1B = spawn_link( + fun() -> + receive {_, msg, RefB} -> ok end, + RefB = call_tracee_1(RefB), + Pid2B ! {self(), msg, RefB} + end), + ?line Pid1B ! {Self, msg, RefB}, + %% The message is passed Self -> Pid1B -> Pid2B -> Self, and the + %% seq_trace token follows invisibly. Traced functions are + %% called in Pid1B and Pid2B. Seq_trace flags == 0 so no + %% seq_trace messages are generated. + ?line receive {Pid2B, msg, RefB} -> ok end, + %% The values of these counters {.., 1, _, 0}, {.., 2, _, 1} + %% depend on that seq_trace has been reset just before this test. + ?line Token1B = {0, Label, 1, Self, 0}, + ?line Token2B = {0, Label, 2, Pid1B, 1}, + ?line {ok, [{trace, Pid1B, call, + {?MODULE, call_tracee_1, [RefB]}, + {Pid1B, Token1B}}, + {trace, Pid2B, call, + {?MODULE, call_tracee_2, [RefB]}, + {Pid2B, Token2B}}]} = + TrB({stop,2}), + ?line seq_trace:reset_trace(), + ok. + +port(doc) -> + "Send trace messages to a port."; +port(suite) -> []; +port(Config) when is_list(Config) -> + ?line Port = load_tracer(Config), + ?line seq_trace:set_system_tracer(Port), + + ?line seq_trace:set_token(print, true), + ?line Small = [small,term], + ?line seq_trace:print(0, Small), + ?line case get_port_message(Port) of + {seq_trace,0,{print,_,_,[],Small}} -> + ok; + Other -> + ?line seq_trace:reset_trace(), + ?line ?t:fail({unexpected,Other}) + end, + %% OTP-4218 Messages from ports should not affect seq trace token. + %% + %% Check if trace token still is active on this process after + %% the get_port_message/1 above that receives from a port. + ?line OtherSmall = [other | Small], + ?line seq_trace:print(0, OtherSmall), + ?line seq_trace:reset_trace(), + ?line case get_port_message(Port) of + {seq_trace,0,{print,_,_,[],OtherSmall}} -> + ok; + Other1 -> + ?line ?t:fail({unexpected,Other1}) + end, + + + ?line seq_trace:set_token(print, true), + ?line Huge = huge_data(), + ?line seq_trace:print(0, Huge), + ?line seq_trace:reset_trace(), + ?line case get_port_message(Port) of + {seq_trace,0,{print,_,_,[],Huge}} -> + ok; + Other2 -> + ?line ?t:fail({unexpected,Other2}) + end, + ok. + +get_port_message(Port) -> + receive + {Port,{data,Bin}} when binary(Bin) -> + binary_to_term(Bin); + Other -> + ?t:fail({unexpected,Other}) + after 5000 -> + ?t:fail(timeout) + end. + + + +match_set_seq_token(suite) -> + []; +match_set_seq_token(doc) -> + ["Tests that match spec function set_seq_token does not " + "corrupt the heap"]; +match_set_seq_token(Config) when is_list(Config) -> + ?line Parent = self(), + ?line Timetrap = test_server:timetrap(test_server:seconds(20)), + %% OTP-4222 Match spec 'set_seq_token' corrupts heap + %% + %% This test crashes the emulator if the bug in question is present, + %% it is therefore done in a slave node. + %% + %% All the timeout stuff is here to get decent accuracy of the error + %% return value, instead of just 'timeout'. + % + ?line {ok, Sandbox} = start_node(seq_trace_other, []), + ?line true = rpc:call(Sandbox, code, add_patha, + [filename:dirname(code:which(?MODULE))]), + ?line Lbl = 4711, + %% Do the possibly crashing test + ?line P1 = + spawn( + fun () -> + Parent ! {self(), + rpc:call(Sandbox, + ?MODULE, do_match_set_seq_token, [Lbl])} + end), + %% Probe the node with a simple rpc request, to see if it is alive. + ?line P2 = + spawn( + fun () -> + receive after 4000 -> ok end, + Parent ! {self(), rpc:call(Sandbox, erlang, abs, [-1])} + end), + %% If the test node hangs completely, this timer expires. + ?line R3 = erlang:start_timer(8000, self(), void), + %% + ?line {ok, Log} = + receive + {P1, Result} -> + exit(P2, done), + erlang:cancel_timer(R3), + Result; + {P2, 1} -> + exit(P1, timeout), + erlang:cancel_timer(R3), + {error, "Test process hung"}; + {timeout, R3, _} -> + exit(P1, timeout), + exit(P2, timeout), + {error, "Test node hung"} + end, + ?line ok = check_match_set_seq_token_log(Lbl, Log), + %% + ?line stop_node(Sandbox), + ?line test_server:timetrap_cancel(Timetrap), + ok. + +%% OTP-4222 Match spec 'set_seq_token' corrupts heap +%% +%% The crashing test goes as follows: +%% +%% One trigger function calls match spec function {set_seq_token, _, _}, +%% which when faulty corrupts the heap. It is assured that the process +%% in question has a big heap and recently garbage collected so there +%% will be room on the heap, which is necessary for the crash to happen. +%% +%% Then two processes bounces a few messages between each other, and if +%% the heap is crashed the emulator crashes, or the triggering process's +%% loop data gets corrupted so the loop never ends. +do_match_set_seq_token(Label) -> + seq_trace:reset_trace(), + Tr = transparent_tracer(), + TrPid = Tr(pid), + erlang:trace_pattern({?MODULE, '_', '_'}, + [{'_', + [{is_seq_trace}], + [{message, {get_seq_token}}]}], + [local]), + erlang:trace_pattern({?MODULE, countdown, 2}, + [{'_', + [], + [{set_seq_token, label, Label}, + {message, {get_seq_token}}]}], + [local]), + erlang:trace(new, true, [call, {tracer, TrPid}]), + Ref = make_ref(), + Bounce = spawn(fun () -> bounce(Ref) end), + Mref = erlang:monitor(process, Bounce), + _Countdown = erlang:spawn_opt(?MODULE, countdown_start, [Bounce, Ref], + [{min_heap_size, 4192}]), + receive + {'DOWN', Mref, _, _, normal} -> + Result = Tr({stop, 0}), + seq_trace:reset_trace(), + erlang:trace(new, false, [call]), + Result; + {'DOWN', Mref, _, _, Reason} -> + Tr({stop, 0}), + seq_trace:reset_trace(), + erlang:trace(new, false, [call]), + {error, Reason} + end. + +check_match_set_seq_token_log( + Label, + [{trace,C,call,{?MODULE,countdown,[B,Ref]}, {0,Label,0,C,0}}, + {trace,C,call,{?MODULE,countdown,[B,Ref,3]},{0,Label,0,C,0}}, + {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,2,B,1}}, + {trace,C,call,{?MODULE,countdown,[B,Ref,2]},{0,Label,2,B,1}}, + {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,4,B,3}}, + {trace,C,call,{?MODULE,countdown,[B,Ref,1]},{0,Label,4,B,3}}, + {trace,B,call,{?MODULE,bounce, [Ref]}, {0,Label,6,B,5}}, + {trace,C,call,{?MODULE,countdown,[B,Ref,0]},{0,Label,6,B,5}} + ]) -> + ok; +check_match_set_seq_token_log(_Label, Log) -> + {error, Log}. + +countdown_start(Bounce, Ref) -> + %% This gc and the increased heap size of this process ensures that + %% the match spec executed for countdown/2 has got heap space for + %% the trace token, so the heap gets trashed according to OTP-4222. + erlang:garbage_collect(), + countdown(Bounce, Ref). + +countdown(Bounce, Ref) -> + countdown(Bounce, Ref, 3). + +countdown(Bounce, Ref, 0) -> + Bounce ! Ref; +countdown(Bounce, Ref, Cnt) -> + Tag = make_ref(), + Bounce ! {Ref, self(), {Tag, Cnt}}, + receive {Tag, Cnt} -> countdown(Bounce, Ref, Cnt-1) end. + +bounce(Ref) -> + receive + Ref -> + ok; + {Ref, Dest, Msg} -> + Dest ! Msg, + bounce(Ref) + end. + + + +gc_seq_token(suite) -> + []; +gc_seq_token(doc) -> + ["Tests that a seq_trace token on a message in the inqueue ", + "can be garbage collected."]; +gc_seq_token(Config) when is_list(Config) -> + ?line Parent = self(), + ?line Timetrap = test_server:timetrap(test_server:seconds(20)), + %% OTP-4555 Seq trace token causes free mem read in gc + %% + %% This test crashes the emulator if the bug in question is present, + %% it is therefore done in a slave node. + %% + %% All the timeout stuff is here to get decent accuracy of the error + %% return value, instead of just 'timeout'. + % + ?line {ok, Sandbox} = start_node(seq_trace_other, []), + ?line true = rpc:call(Sandbox, code, add_patha, + [filename:dirname(code:which(?MODULE))]), + ?line Label = 4711, + %% Do the possibly crashing test + ?line P1 = + spawn( + fun () -> + Parent ! {self(), + rpc:call(Sandbox, + ?MODULE, do_gc_seq_token, [Label])} + end), + %% Probe the node with a simple rpc request, to see if it is alive. + ?line P2 = + spawn( + fun () -> + receive after 4000 -> ok end, + Parent ! {self(), rpc:call(Sandbox, erlang, abs, [-1])} + end), + %% If the test node hangs completely, this timer expires. + ?line R3 = erlang:start_timer(8000, self(), void), + %% + ?line ok = + receive + {P1, Result} -> + exit(P2, done), + erlang:cancel_timer(R3), + Result; + {P2, 1} -> + exit(P1, timeout), + erlang:cancel_timer(R3), + {error, "Test process hung"}; + {timeout, R3, _} -> + exit(P1, timeout), + exit(P2, timeout), + {error, "Test node hung"} + end, + %% + ?line stop_node(Sandbox), + ?line test_server:timetrap_cancel(Timetrap), + ok. + +do_gc_seq_token(Label) -> + Parent = self(), + Comment = + {"OTP-4555 Seq trace token causes free mem read in gc\n" + "\n" + "The crashing test goes as follows:\n" + "\n" + "Put a message with seq_trace token in the inqueue,\n" + "Grow the process heap big enough to become mmap'ed\n" + "and force a garbage collection using large terms\n" + "to get a test_heap instruction with a big size value.\n" + "Then try to trick the heap into shrinking.\n" + "\n" + "All this to make the GC move the heap between memory blocks.\n"}, + seq_trace:reset_trace(), + Child = spawn_link( + fun() -> + receive {Parent, no_seq_trace_token} -> ok end, + do_grow(Comment, 256*1024, []), + do_shrink(10), + receive {Parent, seq_trace_token} -> ok end, + Parent ! {self(), {token, seq_trace:get_token(label)}} + end), + seq_trace:set_token(label, Label), + Child ! {Parent, seq_trace_token}, + seq_trace:set_token([]), + Child ! {Parent, no_seq_trace_token}, + receive + {Child, {token, {label, Label}}} -> + ok; + {Child, {token, Other}} -> + {error, Other} + end. + +do_grow(_, 0, Acc) -> + Acc; +do_grow(E, N, Acc) -> + do_grow(E, N-1, [E | Acc]). + +do_shrink(0) -> + ok; +do_shrink(N) -> + erlang:garbage_collect(), + do_shrink(N-1). + + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Internal help functions +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% Call trace targets + +call_tracee_1(X) -> + X. + +call_tracee_2(X) -> + X. + + +transparent_tracer() -> + Ref = make_ref(), + Loop = + fun(Fun, Log, LN) -> + receive + {stop, MinLN, Ref, From} when LN >= MinLN -> + From ! {log, Ref, lists:reverse(Log)}; + Entry when is_tuple(Entry) == false; element(1, Entry) /= stop -> + Fun(Fun, [Entry | Log], LN+1) + end + end, + Self = self(), + Pid = + spawn(fun() -> + seq_trace:set_system_tracer(self()), + Self ! {started, Ref}, + Loop(Loop, [], 0) + end), + receive {started, Ref} -> ok end, + fun(pid) -> + Pid; + ({stop, N}) when integer(N), N >= 0 -> + Mref = erlang:monitor(process, Pid), + receive + {'DOWN', Mref, _, _, _} -> + {error, not_started} + after 0 -> + DeliverRef = erlang:trace_delivered(all), + receive + {trace_delivered,_,DeliverRef} -> ok + end, + Pid ! {stop, N, Ref, self()}, + receive {'DOWN', Mref, _, _, _} -> ok end, + receive {log, Ref, Log} -> + {ok, Log} + end + end + end. + + + +one_time_receiver() -> + receive _Term -> ok + end. + +one_time_receiver(exit) -> + receive Term -> + exit({exit, Term}) + end. + +simple_tracer(Data, DN) -> + receive + {seq_trace,Label,Info,Ts} -> + simple_tracer([{Label,Info,Ts}|Data], DN+1); + {seq_trace,Label,Info} -> + simple_tracer([{Label,Info}|Data], DN+1); + {stop,N,From} when DN >= N -> + From ! {tracerlog,lists:reverse(Data)} + end. + +stop_tracer(N) when integer(N) -> + case catch (seq_trace_SUITE_tracer ! {stop,N,self()}) of + {'EXIT', _} -> + {error, not_started}; + _ -> + receive + {tracerlog,Data} -> + Data + after 1000 -> + {error,timeout} + end + end. + +start_tracer() -> + stop_tracer(0), + Pid = spawn(?MODULE,simple_tracer,[[], 0]), + register(seq_trace_SUITE_tracer,Pid), + seq_trace:set_system_tracer(Pid), + Pid. + + + +start_node(Name, Param) -> + test_server:start_node(Name, slave, [{args, Param}]). + +stop_node(Node) -> + test_server:stop_node(Node). + +load_tracer(Config) -> + Path = ?config(data_dir, Config), + ok = erl_ddll:load_driver(Path, echo_drv), + open_port({spawn,echo_drv}, [eof,binary]). + +huge_data() -> huge_data(16384). +huge_data(0) -> []; +huge_data(N) when N rem 2 == 0 -> + P = huge_data(N div 2), + [P|P]; +huge_data(N) -> + P = huge_data(N div 2), + [16#1234566,P|P]. diff --git a/lib/kernel/test/seq_trace_SUITE_data/Makefile.src b/lib/kernel/test/seq_trace_SUITE_data/Makefile.src new file mode 100644 index 0000000000..c1bf142ccf --- /dev/null +++ b/lib/kernel/test/seq_trace_SUITE_data/Makefile.src @@ -0,0 +1,3 @@ +all: echo_drv@dll@ + +@SHLIB_RULES@ diff --git a/lib/kernel/test/seq_trace_SUITE_data/echo_drv.c b/lib/kernel/test/seq_trace_SUITE_data/echo_drv.c new file mode 100644 index 0000000000..dcbb3348d8 --- /dev/null +++ b/lib/kernel/test/seq_trace_SUITE_data/echo_drv.c @@ -0,0 +1,43 @@ +#include <stdio.h> +#include "erl_driver.h" + +static ErlDrvPort erlang_port; +static ErlDrvData echo_start(ErlDrvPort, char *); +static void echo_stop(ErlDrvData), echo_read(ErlDrvData, char*, int); + +static ErlDrvEntry echo_driver_entry = { + NULL, + echo_start, + echo_stop, + echo_read, + NULL, + NULL, + "echo_drv", + NULL +}; + +DRIVER_INIT(echo_drv) +{ + erlang_port = (ErlDrvPort)-1; + return &echo_driver_entry; +} + +static ErlDrvData echo_start(ErlDrvPort port,char *buf) +{ + if (erlang_port != (ErlDrvPort)-1) { + return ERL_DRV_ERROR_GENERAL; + } + erlang_port = port; + return (ErlDrvData)port; +} + +static void echo_read(ErlDrvData data, char *buf, int count) +{ + driver_output(erlang_port, buf, count); +} + +static void echo_stop(ErlDrvData data) +{ + erlang_port = (ErlDrvPort)-1; +} + diff --git a/lib/kernel/test/topApp.app b/lib/kernel/test/topApp.app new file mode 100644 index 0000000000..ed01fa7b58 --- /dev/null +++ b/lib/kernel/test/topApp.app @@ -0,0 +1,11 @@ + {application, topApp, + [{description, "Test of start phase"}, + {id, "CXC 138 38"}, + {vsn, "2.0"}, + {applications, [kernel]}, + {modules, []}, + {registered, []}, + {env, [{own_env1, value1}, {own2, val2}]}, + {included_applications, [appinc1, appinc2]}, + {start_phases, [{init, [initArgs]}, {go, [goArgs]}]}, + {mod, {topApp, {topApp, 4, 6}} }]}. diff --git a/lib/kernel/test/topApp.erl b/lib/kernel/test/topApp.erl new file mode 100644 index 0000000000..acf98e6da0 --- /dev/null +++ b/lib/kernel/test/topApp.erl @@ -0,0 +1,48 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(topApp). +-behaviour(supervisor). + +%% External exports +-export([start/2, stop/1, start_phase/3]). + +%% Internal exports +-export([init/1]). + +start(_Type, {_AppN, Low, High}) -> + Name = list_to_atom(lists:concat([ch_sup, Low])), + {ok, P} = supervisor:start_link({local, Name}, ch_sup, + lists:seq(Low, High)), + {ok, P, []}. + +stop(_) -> ok. + +init(Nos) -> + SupFlags = {one_for_one, 12, 60}, + Chs = lists:map(fun(No) -> + {list_to_atom(lists:concat([ch,No])), + {ch, start_link, [{ch, No}]}, + permanent, 2000, worker, [ch]} + end, + Nos), + {ok, {SupFlags, Chs}}. + +start_phase(Phase, _Type, _Args) -> + (catch global:send(start_phase, {sp, Phase})), + ok. diff --git a/lib/kernel/test/topApp2.app b/lib/kernel/test/topApp2.app new file mode 100644 index 0000000000..534c743759 --- /dev/null +++ b/lib/kernel/test/topApp2.app @@ -0,0 +1,11 @@ + {application, topApp2, + [{description, "Test of start phase"}, + {id, "CXC 138 38"}, + {vsn, "2.0"}, + {applications, [kernel]}, + {modules, []}, + {registered, []}, + {env, [{own_env1, value1}, {own2, val2}]}, + {included_applications, [appinc1, appinc2]}, + {start_phases, [{init, [initArgs]}, {go, [goArgs]}]}, + {mod, {application_starter, [topApp2, {topApp2, 4, 6}]} }]}. diff --git a/lib/kernel/test/topApp2.erl b/lib/kernel/test/topApp2.erl new file mode 100644 index 0000000000..4587910ff3 --- /dev/null +++ b/lib/kernel/test/topApp2.erl @@ -0,0 +1,48 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(topApp2). +-behaviour(supervisor). + +%% External exports +-export([start/2, stop/1, start_phase/3]). + +%% Internal exports +-export([init/1]). + +start(_Type, {_AppN, Low, High}) -> + Name = list_to_atom(lists:concat([ch_sup, Low])), + {ok, P} = supervisor:start_link({local, Name}, ch_sup, + lists:seq(Low, High)), + {ok, P, []}. + +stop(_) -> ok. + +init(Nos) -> + SupFlags = {one_for_one, 12, 60}, + Chs = lists:map(fun(No) -> + {list_to_atom(lists:concat([ch,No])), + {ch, start_link, [{ch, No}]}, + permanent, 2000, worker, [ch]} + end, + Nos), + {ok, {SupFlags, Chs}}. + +start_phase(Phase, _Type, _Args) -> + (catch global:send(start_phase,{sp, Phase})), + ok. diff --git a/lib/kernel/test/topApp3.app b/lib/kernel/test/topApp3.app new file mode 100644 index 0000000000..89ecf292c0 --- /dev/null +++ b/lib/kernel/test/topApp3.app @@ -0,0 +1,12 @@ + {application, topApp3, + [{description, "Test of start phase"}, + {id, "CXC 138 38"}, + {vsn, "2.0"}, + {applications, [kernel]}, + {modules, []}, + {registered, []}, + {env, [{own_env1, value1}, {own2, val2}]}, + {included_applications, [appinc1x, appinc2top]}, + {start_phases, [{top, [topArgs]}, {init, [initArgs]}, {some, [someArgs]}, + {spec, [specArgs]}, {go, [goArgs]}]}, + {mod, {application_starter, [topApp3, {topApp3, 4, 6}]} }]}. diff --git a/lib/kernel/test/topApp3.erl b/lib/kernel/test/topApp3.erl new file mode 100644 index 0000000000..1bb6f2f31a --- /dev/null +++ b/lib/kernel/test/topApp3.erl @@ -0,0 +1,48 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(topApp3). +-behaviour(supervisor). + +%% External exports +-export([start/2, stop/1, start_phase/3]). + +%% Internal exports +-export([init/1]). + +start(_Type, {_AppN, Low, High}) -> + Name = list_to_atom(lists:concat([ch_sup, Low])), + {ok, P} = supervisor:start_link({local, Name}, ch_sup, + lists:seq(Low, High)), + {ok, P, []}. + +stop(_) -> ok. + +init(Nos) -> + SupFlags = {one_for_one, 12, 60}, + Chs = lists:map(fun(No) -> + {list_to_atom(lists:concat([ch,No])), + {ch, start_link, [{ch, No}]}, + permanent, 2000, worker, [ch]} + end, + Nos), + {ok, {SupFlags, Chs}}. + +start_phase(Phase, _Type, _Args) -> + (catch global:send(start_phase,{sp, Phase})), + ok. diff --git a/lib/kernel/test/wrap_log_reader_SUITE.erl b/lib/kernel/test/wrap_log_reader_SUITE.erl new file mode 100644 index 0000000000..1d1570fbd9 --- /dev/null +++ b/lib/kernel/test/wrap_log_reader_SUITE.erl @@ -0,0 +1,550 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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(wrap_log_reader_SUITE). + +%-define(debug, true). + +-ifdef(debug). +-define(format(S, A), io:format(S, A)). +-define(line, put(line, ?LINE), ). +-define(privdir(_), "./disk_log_SUITE_priv"). +-define(config(X,Y), foo). +-define(t,test_server). +-else. +-include("test_server.hrl"). +-define(format(S, A), ok). +-define(privdir(Conf), ?config(priv_dir, Conf)). +-endif. + +-export([all/1, + no_file/1, + one/1, one_empty/1, one_filled/1, + two/1, two_filled/1, + four/1, four_filled/1, + wrap/1, wrap_filled/1, + wrapping/1, + external/1, + error/1]). + +-export([init_per_testcase/2, fin_per_testcase/2]). + +all(suite) -> + [no_file, one, two, four, wrap, wrapping, external, error]. + +init_per_testcase(Func, Config) when atom(Func), list(Config) -> + Dog=?t:timetrap(?t:seconds(60)), + [{watchdog, Dog} | Config]. + +fin_per_testcase(_Func, _Config) -> + Dog=?config(watchdog, _Config), + ?t:timetrap_cancel(Dog). + +no_file(suite) -> []; +no_file(doc) -> ["No log file exists"]; +no_file(Conf) when list(Conf) -> + ?line code:add_path(?config(data_dir,Conf)), + Dir = ?privdir(Conf), + File = join(Dir, "sune.LOG"), + delete_files(File), + start(), + + wlt ! {open, self(), File}, + ?line rec({error, {index_file_not_found, File}}, ?LINE), + wlt ! {open, self(), File, 1}, + ?line rec({error, {index_file_not_found, File}}, ?LINE), + wlt ! {open, self(), File, 4}, + ?line rec({error, {index_file_not_found, File}}, ?LINE), + + stop(), + delete_files(File), + ok. + +one(suite) -> [one_empty, one_filled]; +one(doc) -> ["One index file"]. + +one_empty(suite) -> []; +one_empty(doc) -> ["One empty index file"]; +one_empty(Conf) when list(Conf) -> + Dir = ?privdir(Conf), + File = join(Dir, "sune.LOG"), + delete_files(File), + start(), + + ?line open(sune, File, ?LINE), + %% open + ?line do_chunk([{open,File}, eof], wlt, ?LINE), + ?line do_chunk([{open,File,1}, eof], wlt, ?LINE), + wlt ! {open, self(), File, 2}, + ?line rec({error, {file_not_found, add_ext(File, 2)}}, ?LINE), + ?line close(sune), + + %% closed + ?line do_chunk([{open,File}, eof], wlt, ?LINE), + ?line do_chunk([{open,File,1}, eof], wlt, ?LINE), + wlt ! {open, self(), File, 2}, + ?line rec({error, {file_not_found, add_ext(File, 2)}}, ?LINE), + + stop(), + delete_files(File), + ok. + +one_filled(suite) -> []; +one_filled(doc) -> ["One filled index file"]; +one_filled(Conf) when list(Conf) -> + Dir = ?privdir(Conf), + File = join(Dir, "sune.LOG"), + delete_files(File), + start(), + + ?line open(sune, File, ?LINE), + ?line log_terms(sune, ["first round, one", "first round, two"]), + ?line sync(sune), + %% open + test_one(File), + ?line close(sune), + %% closed + test_one(File), + + stop(), + delete_files(File), + ok. + +test_one(File) -> + ?line do_chunk([{open,File}, + {chunk, ["first round, one", "first round, two"]}, + eof], wlt, ?LINE), + ?line do_chunk([{open,File,1}, + {chunk, ["first round, one", "first round, two"]}, + eof], wlt, ?LINE), + wlt ! {open, self(), File, 2}, + ?line rec({error, {file_not_found, add_ext(File, 2)}}, ?LINE), + ?line do_chunk([{open,File,1}, {chunk, 1, ["first round, one"]}, + {chunk, 1, ["first round, two"]}, eof], wlt, ?LINE), + ok. + +two(suite) -> [two_filled]; +two(doc) -> ["Two index files"]. + +two_filled(suite) -> []; +two_filled(doc) -> ["Two filled index files"]; +two_filled(Conf) when list(Conf) -> + Dir = ?privdir(Conf), + File = list_to_atom(join(Dir, "sune.LOG")), + delete_files(File), + start(), + + ?line open(sune, File, ?LINE), + ?line log_terms(sune, ["first round, 11", "first round, 12"]), + ?line log_terms(sune, ["first round, 21", "first round, 22"]), + ?line sync(sune), + %% open + test_two(File), + ?line close(sune), + %% closed + test_two(File), + + stop(), + delete_files(File), + ok. + +test_two(File) -> + ?line do_chunk([{open,File}, + {chunk, infinity, ["first round, 11", "first round, 12"]}, + {chunk, ["first round, 21", "first round, 22"]}, + eof], wlt, ?LINE), + ?line do_chunk([{open,File,1}, + {chunk, ["first round, 11", "first round, 12"]}, + eof], wlt, ?LINE), + ?line do_chunk([{open,File,2}, + {chunk, ["first round, 21", "first round, 22"]}, + eof], wlt, ?LINE), + wlt ! {open, self(), File, 3}, + ?line rec({error, {file_not_found, add_ext(File, 3)}}, ?LINE), + ?line do_chunk([{open,File,1}, {chunk, 1, ["first round, 11"]}, + {chunk, 2, ["first round, 12"]}, eof], wlt, ?LINE), + ok. + +four(suite) -> [four_filled]; +four(doc) -> ["Four index files"]. + +four_filled(suite) -> []; +four_filled(doc) -> ["Four filled index files"]; +four_filled(Conf) when list(Conf) -> + Dir = ?privdir(Conf), + File = join(Dir, "sune.LOG"), + delete_files(File), + start(), + + ?line open(sune, File, ?LINE), + ?line init_files(0), + ?line sync(sune), + %% open + test_four(File), + ?line close(sune), + %% closed + test_four(File), + + stop(), + delete_files(File), + ok. + +test_four(File) -> + ?line do_chunk([{open,File}, + {chunk, ["first round, 11", "first round, 12"]}, + {chunk, ["first round, 21", "first round, 22"]}, + {chunk, ["first round, 31", "first round, 32"]}, + {chunk, ["first round, 41", "first round, 42"]}, + eof], wlt, ?LINE), + ?line do_chunk([{open,File,1}, + {chunk, ["first round, 11", "first round, 12"]}, + eof], wlt, ?LINE), + ?line do_chunk([{open,File,4}, + {chunk, ["first round, 41", "first round, 42"]}, + eof], wlt, ?LINE), + wlt ! {open, self(), File, 5}, + ?line rec({error, {file_not_found, add_ext(File, 5)}}, ?LINE), + ?line do_chunk([{open,File,1}, {chunk, 1, ["first round, 11"]}, + {chunk, 2, ["first round, 12"]}, eof], wlt, ?LINE), + ?line do_chunk([{open,File,4}, {chunk, 1, ["first round, 41"]}, + {chunk, 2, ["first round, 42"]}, eof], wlt, ?LINE), + ok. + +wrap(suite) -> [wrap_filled]; +wrap(doc) -> ["Wrap index file, first wrapping"]. + +wrap_filled(suite) -> []; +wrap_filled(doc) -> ["First wrap, open, filled index file"]; +wrap_filled(Conf) when list(Conf) -> + Dir = ?privdir(Conf), + File = join(Dir, "sune.LOG"), + delete_files(File), + start(), + + ?line open(sune, File, ?LINE), + ?line init_files(0), + ?line log_terms(sune, ["second round, 11", "second round, 12"]), + ?line sync(sune), + %% open + test_wrap(File), + ?line close(sune), + %% closed + test_wrap(File), + + stop(), + delete_files(File), + ok. + +test_wrap(File) -> + ?line do_chunk([{open,File}, + {chunk, ["first round, 21", "first round, 22"]}, + {chunk, ["first round, 31", "first round, 32"]}, + {chunk, ["first round, 41", "first round, 42"]}, + {chunk, ["second round, 11", "second round, 12"]}, + eof], wlt, ?LINE), + ?line do_chunk([{open,File,1}, + {chunk, ["second round, 11", "second round, 12"]}, + eof], wlt, ?LINE), + ?line do_chunk([{open,File,2}, + {chunk, ["first round, 21", "first round, 22"]}, + eof], wlt, ?LINE), + wlt ! {open, self(), File, 5}, + ?line rec({error, {file_not_found, add_ext(File, 5)}}, ?LINE), + ?line do_chunk([{open,File,1}, {chunk, 1, ["second round, 11"]}, + {chunk, 2, ["second round, 12"]}, eof], wlt, ?LINE), + ?line do_chunk([{open,File,4}, {chunk, 1, ["first round, 41"]}, + {chunk, 2, ["first round, 42"]}, eof], wlt, ?LINE), + ok. + +wrapping(suite) -> []; +wrapping(doc) -> ["Wrapping at the same time as reading"]; +wrapping(Conf) when list(Conf) -> + Dir = ?privdir(Conf), + File = join(Dir, "sune.LOG"), + delete_files(File), + start(), + + ?line open(sune, File, ?LINE), + ?line init_files(1100), + ?line sync(sune), + ?line C1 = + do_chunk([{open,File}, {chunk, 1, ["first round, 11"]}], wlt, ?LINE), + ?line log_terms(sune, ["second round, 11", "second round, 12"]), + ?line sync(sune), + ?line do_chunk([{chunk, 1, ["first round, 12"]}, + %% Here two bad bytes are found. + {chunk, ["first round, 21", "first round, 22"]}, + {chunk, ["first round, 31", "first round, 32"]}, + {chunk, ["first round, 41", "first round, 42"]}, eof], + wlt, ?LINE, C1), + start(), + delete_files(File), + ?line open(sune, File, ?LINE), + ?line init_files(1100), + ?line sync(sune), + ?line C2 = + do_chunk([{open,File}, {chunk, 1, ["first round, 11"]}], wlt, ?LINE), + ?line log_terms(sune, ["second round, 11", "second round, 12"]), + ?line close(sune), + ?line do_chunk([{chunk, 1, ["first round, 12"]}, + %% Here two bad bytes are found. + {chunk, ["first round, 21", "first round, 22"]}, + {chunk, ["first round, 31", "first round, 32"]}, + {chunk, ["first round, 41", "first round, 42"]}, eof], + wlt, ?LINE, C2), + start(), + delete_files(File), + ?line open(sune, File, ?LINE), + ?line init_files(1100), + ?line sync(sune), + ?line C3 = do_chunk([{open,File}], wlt, ?LINE), + ?line log_terms(sune, ["second round, 11"]), + ?line sync(sune), + ?line do_chunk([{chunk, 1, ["second round, 11"]}, + {chunk, 1, ["first round, 21"]}, + {chunk, 1, ["first round, 22"]}, + {chunk, ["first round, 31", "first round, 32"]}, + {chunk, ["first round, 41", "first round, 42"]}, eof], + wlt, ?LINE, C3), + + stop(), + delete_files(File), + ok. + +external(suite) -> []; +external(doc) -> ["External format"]; +external(Conf) when list(Conf) -> + Dir = ?privdir(Conf), + File = join(Dir, "sune.LOG"), + delete_files(File), + start(), + + ?line open_ext(sune, File, ?FILE), + ?line init_files_ext(0), + ?line close(sune), + P0 = pps(), + wlt ! {open, self(), File}, + ?line rec({error, {not_a_log_file, add_ext(File, 1)}}, ?LINE), + ?line true = (P0 == pps()), + + stop(), + delete_files(File), + ok. + +error(suite) -> []; +error(doc) -> ["Error situations"]; +error(Conf) when list(Conf) -> + Dir = ?privdir(Conf), + File = join(Dir, "sune.LOG"), + delete_files(File), + start(), + + P0 = pps(), + wlt ! {open, self(), File, 1}, + ?line rec({error, {index_file_not_found, File}}, ?LINE), + wlt ! {open, self(), File}, + ?line rec({error, {index_file_not_found, File}}, ?LINE), + ?line true = (P0 == pps()), + + ?line open(sune, File, ?LINE), + ?line close(sune), + P1 = pps(), + ?line First = add_ext(File, 1), + ?line ok = file:delete(First), + wlt ! {open, self(), File}, + ?line rec({error, {not_a_log_file, First}}, ?LINE), + ?line true = (P1 == pps()), + + delete_files(File), + ?line open(sune, File, ?LINE), + ?line init_files(0), + ?line close(sune), + P2 = pps(), + ?line C = do_chunk([{open,File}, + {chunk, ["first round, 11", "first round, 12"]}], + wlt, ?LINE), + ?line Second = add_ext(File, 2), + ?line ok = file:delete(Second), + wlt ! {chunk, self(), C}, + ?line rec({error, {file_error, Second, {error, enoent}}}, ?LINE), + ?line ok = file:write_file(Second, <<17:(3*8)>>), % three bytes + wlt ! {chunk, self(), C}, + ?line rec({error, {not_a_log_file, Second}}, ?LINE), + ?line do_chunk([close], wlt, ?LINE, C), + ?line true = (P2 == pps()), + + delete_files(File), + ?line open(sune, File, ?LINE), + ?line init_files(0), + ?line close(sune), + P3 = pps(), + timer:sleep(1100), + Now = calendar:local_time(), + ?line ok = file:change_time(First, Now), + ?line C2 = do_chunk([{open,File}, + {chunk, ["first round, 11", "first round, 12"]}], + wlt, ?LINE), + wlt ! {chunk, self(), C2}, + ?line rec({error,{is_wrapped,First}}, ?LINE), + ?line do_chunk([close], wlt, ?LINE, C2), + IndexFile = add_ext(File, idx), + ?line ok = file:write_file(IndexFile, <<17:(3*8)>>), + wlt ! {open, self(), File, 1}, + ?line rec({error, {index_file_not_found, File}}, ?LINE), + ?line true = (P3 == pps()), + + stop(), + delete_files(File), + ok. + +start() -> + ?line ok = wrap_log_test:stop(), + dl_wait(), + ?line ok = wrap_log_test:init(). + +stop() -> + ?line ok = wrap_log_test:stop(), + dl_wait(). + +%% Give disk logs opened by 'logger' and 'wlt' time to close after +%% receiving EXIT signals. +dl_wait() -> + case disk_log:accessible_logs() of + {[], []} -> + ok; + _ -> + timer:sleep(100), + dl_wait() + end. + +delete_files(File) -> + file:delete(add_ext(File, idx)), + file:delete(add_ext(File, siz)), + file:delete(add_ext(File, 1)), + file:delete(add_ext(File, 2)), + file:delete(add_ext(File, 3)), + file:delete(add_ext(File, 4)), + ok. + +init_files(Delay) -> + ?line log_terms(sune, ["first round, 11", "first round, 12"]), + timer:sleep(Delay), + ?line log_terms(sune, ["first round, 21", "first round, 22"]), + timer:sleep(Delay), + ?line log_terms(sune, ["first round, 31", "first round, 32"]), + timer:sleep(Delay), + ?line log_terms(sune, ["first round, 41", "first round, 42"]), + timer:sleep(Delay), + ok. + +init_files_ext(Delay) -> + ?line blog_terms(sune, ["first round, 11", "first round, 12"]), + timer:sleep(Delay), + ?line blog_terms(sune, ["first round, 21", "first round, 22"]), + timer:sleep(Delay), + ?line blog_terms(sune, ["first round, 31", "first round, 32"]), + timer:sleep(Delay), + ?line blog_terms(sune, ["first round, 41", "first round, 42"]), + timer:sleep(Delay), + ok. + +join(A, B) -> + filename:nativename(filename:join(A, B)). + +do_chunk(Commands, Server, Where) -> + do_chunk(Commands, Server, Where, foo). + +do_chunk([{open, File, One} | Cs], S, W, _C) -> + S ! {open, self(), File, One}, + ?line NC = rec1(ok, {W,?LINE}), + do_chunk(Cs, S, W, NC); +do_chunk([{open, File} | Cs], S, W, _C) -> + S ! {open, self(), File}, + ?line NC = rec1(ok, {W,?LINE}), + do_chunk(Cs, S, W, NC); +do_chunk([{chunk, Terms} | Cs], S, W, C) -> + S ! {chunk, self(), C}, + ?line NC = rec2(Terms, {W,?LINE}), + do_chunk(Cs, S, W, NC); +do_chunk([{chunk, N, Terms} | Cs], S, W, C) -> + S ! {chunk, self(), C, N}, + ?line NC = rec2(Terms, {W,?LINE}), + do_chunk(Cs, S, W, NC); +do_chunk([eof], S, W, C) -> + S ! {chunk, self(), C}, + ?line C1 = rec2(eof, {W,?LINE}), + do_chunk([close], S, W, C1); +do_chunk([close], S, W, C) -> + S ! {close, self(), C}, + ?line rec(ok, {W,?LINE}); +do_chunk([], _S, _W, C) -> + C. + +add_ext(Name, Ext) -> + lists:concat([Name, ".", Ext]). + +%% disk_log. +open(Log, File, Where) -> + logger ! {open, self(), Log, File}, + rec1(ok, Where). + +open_ext(Log, File, Where) -> + logger ! {open_ext, self(), Log, File}, + rec1(ok, Where). + +close(Log) -> + logger ! {close, self(), Log}, + rec(ok, ?LINE). + +sync(Log) -> + logger ! {sync, self(), Log}, + rec(ok, ?LINE). + +log_terms(File, Terms) -> + logger ! {log_terms, self(), File, Terms}, + rec(ok, ?LINE). + +blog_terms(File, Terms) -> + logger ! {blog_terms, self(), File, Terms}, + rec(ok, ?LINE). + +rec1(M, Where) -> + receive + {M, C} -> C; + Else -> test_server:fail({error, {Where, Else}}) + after 1000 -> test_server:fail({error, {Where, time_out}}) + end. + +rec2(M, Where) -> + receive + {C, M} -> C; + Else -> test_server:fail({error, {Where, Else}}) + after 1000 -> test_server:fail({error, {Where, time_out}}) + end. + +rec(M, Where) -> + receive + M -> + ok; + Else -> ?t:fail({error, {Where, Else}}) + after 1000 -> ?t:fail({error, {Where, time_out}}) + end. + +pps() -> + {erlang:ports(), lists:filter({erlang, is_process_alive}, processes())}. diff --git a/lib/kernel/test/wrap_log_reader_SUITE_data/Makefile.src b/lib/kernel/test/wrap_log_reader_SUITE_data/Makefile.src new file mode 100644 index 0000000000..4098cacfd2 --- /dev/null +++ b/lib/kernel/test/wrap_log_reader_SUITE_data/Makefile.src @@ -0,0 +1,7 @@ +EFLAGS=+debug_info + +all: wrap_log_test.@EMULATOR@ + +wrap_log_test.@EMULATOR@: wrap_log_test.erl + erlc $(EFLAGS) wrap_log_test.erl + diff --git a/lib/kernel/test/wrap_log_reader_SUITE_data/wrap_log_test.erl b/lib/kernel/test/wrap_log_reader_SUITE_data/wrap_log_test.erl new file mode 100644 index 0000000000..e5ff70fd49 --- /dev/null +++ b/lib/kernel/test/wrap_log_reader_SUITE_data/wrap_log_test.erl @@ -0,0 +1,184 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1998-2009. 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% +%% +%%%---------------------------------------------------------------------- +%%% Purpose : Test wrap_log_reader.erl +%%%---------------------------------------------------------------------- + +-module(wrap_log_test). + +-export([init/0, stop/0]). +-define(fsize, 80). +-define(fno, 4). + +%-define(debug, true). + +-ifdef(debug). +-define(format(S, A), io:format(S, A)). +-else. +-define(format(S, A), ok). +-endif. + +init() -> + spawn(fun() -> start(logger) end), + spawn(fun() -> start2(wlt) end), + wait_registered(logger), + wait_registered(wlt), + ok. + +wait_registered(Name) -> + case whereis(Name) of + undefined -> + timer:sleep(100), + wait_registered(Name); + _Pid -> + ok + end. + +stop() -> + catch logger ! exit, + catch wlt ! exit, + wait_unregistered(logger), + wait_unregistered(wlt), + ok. + +wait_unregistered(Name) -> + case whereis(Name) of + undefined -> + ok; + _Pid -> + timer:sleep(100), + wait_unregistered(Name) + end. + +start(Name) -> + ?format("Starting ~p~n", [Name]), + register(Name, self()), + loop(). + +start2(Name) -> + ?format("Starting ~p~n", [Name]), + register(Name, self()), + loop2(eof, Name). + +loop() -> + receive + {open, Pid, Name, File} -> + R = disk_log:open([{name, Name}, {type, wrap}, {file, File}, + {size, {?fsize, ?fno}}]), + ?format("logger: open ~p -> ~p~n", [Name, R]), + Pid ! R, + loop(); + + {open_ext, Pid, Name, File} -> + R = disk_log:open([{name, Name}, {type, wrap}, {file, File}, + {format, external}, {size, {?fsize, ?fno}}]), + ?format("logger: open ~p -> ~p~n", [Name, R]), + Pid ! R, + loop(); + + {close, Pid, Name} -> + R = disk_log:close(Name), + ?format("logger: close ~p -> ~p~n", [Name, R]), + Pid ! R, + loop(); + + {sync, Pid, Name} -> + R = disk_log:sync(Name), + ?format("logger: sync ~p -> ~p~n", [Name, R]), + Pid ! R, + loop(); + + {log_terms, Pid, Name, Terms} -> + R = disk_log:log_terms(Name, Terms), + ?format("logger: log_terms ~p -> ~p~n", [Name, R]), + Pid ! R, + loop(); + + {blog_terms, Pid, Name, Terms} -> + R = disk_log:blog_terms(Name, Terms), + ?format("logger: blog_terms ~p -> ~p~n", [Name, R]), + Pid ! R, + loop(); + + exit -> + ?format("Stopping logger~n", []), + exit(normal); + + _Else -> + ?format("logger: ignored: ~p~n", [_Else]), + loop() + end. + +loop2(C, Wlt) -> + receive + {open, Pid, Name} -> + case wrap_log_reader:open(Name) of + {ok, R} -> + ?format("~p: open ~p -> ~p~n", [Wlt, Name, {ok, R}]), + Pid ! {ok, R}, + loop2(R, Wlt); + E -> + ?format("~p: open ~p -> ~p~n", [Wlt, Name, E]), + Pid ! E, + loop2(C, Wlt) + end; + + {open, Pid, Name, No} -> + case wrap_log_reader:open(Name, No) of + {ok, R} -> + ?format("~p: open ~p, file ~p -> ~p~n", + [Wlt, Name, No, {ok, R}]), + Pid ! {ok, R}, + loop2(R, Wlt); + E -> + ?format("~p: open ~p, file ~p -> ~p~n", + [Wlt, Name, No, E]), + Pid ! E, + loop2(C, Wlt) + end; + + {close, Pid, WR} -> + R = wrap_log_reader:close(WR), + ?format("~p: close -> ~p~n", [Wlt, R]), + Pid ! R, + loop2(eof, Wlt); + + {chunk, Pid, WR} -> + did_chunk(wrap_log_reader:chunk(WR), Pid, Wlt); + + {chunk, Pid, WR, N} -> + did_chunk(wrap_log_reader:chunk(WR, N), Pid, Wlt); + + exit -> + ?format("Stopping ~p~n", [Wlt]), + exit(normal); + + _Else -> + ?format("~p: ignored: ~p~n", [Wlt, _Else]), + loop2(C, Wlt) + end. + +did_chunk({C1, L}, Pid, Wlt) -> + ?format("~p: chunk -> ~p~n", [Wlt, {C1, L}]), + Pid ! {C1, L}, + loop2(C1, Wlt); +did_chunk({C1, L, _Bad}, Pid, Wlt) -> + ?format("~p: chunk -> ~p (bad)~n", [Wlt, {C1, L, _Bad}]), + Pid ! {C1, L}, + loop2(C1, Wlt). diff --git a/lib/kernel/test/zlib_SUITE.erl b/lib/kernel/test/zlib_SUITE.erl new file mode 100644 index 0000000000..f20c9a176b --- /dev/null +++ b/lib/kernel/test/zlib_SUITE.erl @@ -0,0 +1,1004 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2005-2009. 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(zlib_SUITE). + +-include("test_server.hrl"). + +-compile(export_all). + +-define(error(Format,Args), + put(test_server_loc,{?MODULE,?LINE}), + error(Format,Args,?MODULE,?LINE)). + +%% Learn erts team how to really write tests ;-) +-define(m(ExpectedRes,Expr), + fun() -> + ACtual1 = (catch (Expr)), + try case ACtual1 of + ExpectedRes -> ACtual1 + end + catch + error:{case_clause,ACtuAl} -> + ?error("Not Matching Actual result was:~n ~p ~n", + [ACtuAl]), + ACtuAl + end + end()). + +-define(BARG, {'EXIT',{badarg,[{zlib,_,_}|_]}}). +-define(DATA_ERROR, {'EXIT',{data_error,[{zlib,_,_}|_]}}). + +init_per_testcase(_Func, Config) -> + Dog = test_server:timetrap(test_server:seconds(60)), + [{watchdog, Dog}|Config]. +fin_per_testcase(_Func, Config) -> + Dog = ?config(watchdog, Config), + test_server:timetrap_cancel(Dog). + +error(Format, Args, File, Line) -> + io:format("~p:~p: ERROR: " ++ Format, [File,Line|Args]), + group_leader() ! {failed, File, Line}. + +%% Hopefully I don't need this to get it to work with the testserver.. +%% Fail = #'REASON'{file = filename:basename(File), +%% line = Line, +%% desc = Args}, +%% case global:whereis_name(mnesia_test_case_sup) of +%% undefined -> +%% ignore; +%% Pid -> +%% Pid ! Fail +%% %% global:send(mnesia_test_case_sup, Fail), +%% end, +%% log("<>ERROR<>~n" ++ Format, Args, File, Line). + +all(suite) -> + [api, examples, func, smp, otp_7359]. + +api(doc) -> "Basic the api tests"; +api(suite) -> + [api_open_close, + api_deflateInit, + api_deflateSetDictionary, + api_deflateReset, + api_deflateParams, + api_deflate, + api_deflateEnd, + api_inflateInit, + api_inflateSetDictionary, + api_inflateSync, + api_inflateReset, + api_inflate, + api_inflateEnd, + api_setBufsz, + api_getBufsz, + api_crc32, + api_adler32, + api_getQSize, + api_un_compress, + api_un_zip, +% api_g_un_zip_file, + api_g_un_zip]. + +api_open_close(doc) -> "Test open/0 and close/1"; +api_open_close(suite) -> []; +api_open_close(Config) when is_list(Config) -> + ?line Fd1 = zlib:open(), + ?line Fd2 = zlib:open(), + ?m(false,Fd1 == Fd2), + ?m(ok,zlib:close(Fd1)), + ?m(?BARG, zlib:close(Fd1)), + ?m(ok,zlib:close(Fd2)), + + %% Make sure that we don't get any EXIT messages if trap_exit is enabled. + ?line process_flag(trap_exit, true), + ?line Fd3 = zlib:open(), + ?m(ok,zlib:close(Fd3)), + receive + Any -> ?line ?t:fail({unexpected_message,Any}) + after 10 -> ok + end. + +api_deflateInit(doc) -> "Test deflateInit/2 and /6"; +api_deflateInit(suite) -> []; +api_deflateInit(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m(?BARG, zlib:deflateInit(gurka, none)), + ?m(?BARG, zlib:deflateInit(gurka, gurka)), + ?m(?BARG, zlib:deflateInit(Z1, gurka)), + Levels = [none, default, best_speed, best_compression] ++ lists:seq(0,9), + lists:foreach(fun(Level) -> + ?line Z = zlib:open(), + ?m(ok, zlib:deflateInit(Z, Level)), + ?m(ok,zlib:close(Z)) + end, Levels), + %% /6 + ?m(?BARG, zlib:deflateInit(Z1,gurka,deflated,-15,8,default)), + + ?m(?BARG, zlib:deflateInit(Z1,default,undefined,-15,8,default)), + + ?m(?BARG, zlib:deflateInit(Z1,default,deflated,48,8,default)), + ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-20,8,default)), + ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-7,8,default)), + ?m(?BARG, zlib:deflateInit(Z1,default,deflated,7,8,default)), + ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-8,8,default)), + ?m(?BARG, zlib:deflateInit(Z1,default,deflated,8,8,default)), + + ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,0,default)), + ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,10,default)), + + ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,8,0)), + ?m(?BARG, zlib:deflateInit(Z1,default,deflated,-15,8,undefined)), + + lists:foreach(fun(Level) -> + ?line Z = zlib:open(), + ?m(ok, zlib:deflateInit(Z, Level, deflated, -15, 8, default)), + ?m(ok,zlib:close(Z)) + end, Levels), + + lists:foreach(fun(Wbits) -> + ?line Z11 = zlib:open(), + ?m(ok, zlib:deflateInit(Z11,best_compression,deflated, + Wbits,8,default)), + ?line Z12 = zlib:open(), + ?m(ok, zlib:deflateInit(Z12,default,deflated,-Wbits,8,default)), + ?m(ok,zlib:close(Z11)), + ?m(ok,zlib:close(Z12)) + end, lists:seq(9, 15)), + + lists:foreach(fun(MemLevel) -> + ?line Z = zlib:open(), + ?m(ok, zlib:deflateInit(Z,default,deflated,-15, + MemLevel,default)), + ?m(ok,zlib:close(Z)) + end, lists:seq(1,8)), + + Strategies = [filtered,huffman_only,default], + lists:foreach(fun(Strategy) -> + ?line Z = zlib:open(), + ?m(ok, zlib:deflateInit(Z,best_speed,deflated,-15,8,Strategy)), + ?m(ok,zlib:close(Z)) + end, Strategies), + ?m(ok, zlib:deflateInit(Z1,default,deflated,-15,8,default)), + ?m({'EXIT',_}, zlib:deflateInit(Z1,none,deflated,-15,8,default)), %% ?? + ?m(ok, zlib:close(Z1)). + +api_deflateSetDictionary(doc) -> "Test deflateSetDictionary"; +api_deflateSetDictionary(suite) -> []; +api_deflateSetDictionary(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m(ok, zlib:deflateInit(Z1, default)), + ?m(Id when is_integer(Id), zlib:deflateSetDictionary(Z1, <<1,1,2,3,4,5,1>>)), + ?m(Id when is_integer(Id), zlib:deflateSetDictionary(Z1, [1,1,2,3,4,5,1])), + ?m(?BARG, zlib:deflateSetDictionary(Z1, gurka)), + ?m(?BARG, zlib:deflateSetDictionary(Z1, 128)), + ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)), + ?m({'EXIT',{stream_error,_}},zlib:deflateSetDictionary(Z1,<<1,1,2,3,4,5,1>>)), + ?m(ok, zlib:close(Z1)). + +api_deflateReset(doc) -> "Test deflateReset"; +api_deflateReset(suite) -> []; +api_deflateReset(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m(ok, zlib:deflateInit(Z1, default)), + ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)), + ?m(ok, zlib:deflateReset(Z1)), + ?m(ok, zlib:deflateReset(Z1)), + %% FIXME how do I make this go wrong?? + ?m(ok, zlib:close(Z1)). + +api_deflateParams(doc) -> "Test deflateParams"; +api_deflateParams(suite) -> []; +api_deflateParams(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m(ok, zlib:deflateInit(Z1, default)), + ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)), + ?m(ok, zlib:deflateParams(Z1, best_compression, huffman_only)), + ?m(_, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, sync)), + ?m({'EXIT',_}, zlib:deflateParams(Z1,best_speed, filtered)), + ?m(ok, zlib:close(Z1)). + +api_deflate(doc) -> "Test deflate"; +api_deflate(suite) -> []; +api_deflate(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m(ok, zlib:deflateInit(Z1, default)), + ?m([B] when is_binary(B), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, finish)), + ?m(ok, zlib:deflateReset(Z1)), + ?m([B] when is_binary(B), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, finish)), + ?m(ok, zlib:deflateReset(Z1)), + ?m(B when is_list(B), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>)), + ?m(B when is_list(B), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, none)), + ?m(B when is_list(B), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, sync)), + ?m(B when is_list(B), zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, full)), + ?m(B when is_list(B), zlib:deflate(Z1, <<>>, finish)), + + ?m(?BARG, zlib:deflate(gurka, <<1,1,1,1,1,1,1,1,1>>, full)), + ?m(?BARG, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, asdj)), + ?m(?BARG, zlib:deflate(Z1, <<1,1,1,1,1,1,1,1,1>>, 198)), + %% Causes problems ERROR REPORT + ?m(?BARG, zlib:deflate(Z1, [asdj,asd], none)), + + ?m(ok, zlib:close(Z1)). + +api_deflateEnd(doc) -> "Test deflateEnd"; +api_deflateEnd(suite) -> []; +api_deflateEnd(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m(ok, zlib:deflateInit(Z1, default)), + ?m(ok, zlib:deflateEnd(Z1)), + ?m({'EXIT', {einval,_}}, zlib:deflateEnd(Z1)), %% ?? + ?m(?BARG, zlib:deflateEnd(gurka)), + ?m(ok, zlib:deflateInit(Z1, default)), + ?m(B when is_list(B), zlib:deflate(Z1, <<"Kilroy was here">>)), + ?m({'EXIT', {data_error,_}}, zlib:deflateEnd(Z1)), + ?m(ok, zlib:deflateInit(Z1, default)), + ?m(B when is_list(B), zlib:deflate(Z1, <<"Kilroy was here">>)), + ?m(B when is_list(B), zlib:deflate(Z1, <<"Kilroy was here">>, finish)), + ?m(ok, zlib:deflateEnd(Z1)), + + ?m(ok, zlib:close(Z1)). + +api_inflateInit(doc) -> "Test inflateInit /1 and /2"; +api_inflateInit(suite) -> []; +api_inflateInit(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m(?BARG, zlib:inflateInit(gurka)), + ?m(ok, zlib:inflateInit(Z1)), + ?m({'EXIT',{einval,_}}, zlib:inflateInit(Z1, 15)), %% ?? + lists:foreach(fun(Wbits) -> + ?line Z11 = zlib:open(), + ?m(ok, zlib:inflateInit(Z11,Wbits)), + ?line Z12 = zlib:open(), + ?m(ok, zlib:inflateInit(Z12,-Wbits)), + ?m(ok,zlib:close(Z11)), + ?m(ok,zlib:close(Z12)) + end, lists:seq(9,15)), + ?m(?BARG, zlib:inflateInit(gurka, -15)), + ?m(?BARG, zlib:inflateInit(Z1, 7)), + ?m(?BARG, zlib:inflateInit(Z1, -7)), + ?m(?BARG, zlib:inflateInit(Z1, 48)), + ?m(?BARG, zlib:inflateInit(Z1, -16)), + ?m(ok, zlib:close(Z1)). + +api_inflateSetDictionary(doc) -> "Test inflateSetDictionary"; +api_inflateSetDictionary(suite) -> []; +api_inflateSetDictionary(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m(ok, zlib:inflateInit(Z1)), + ?m(?BARG, zlib:inflateSetDictionary(gurka,<<1,1,1,1,1>>)), + ?m(?BARG, zlib:inflateSetDictionary(Z1,102)), + ?m(?BARG, zlib:inflateSetDictionary(Z1,gurka)), + Dict = <<1,1,1,1,1>>, + ?m({'EXIT',{stream_error,_}}, zlib:inflateSetDictionary(Z1,Dict)), + ?m(ok, zlib:close(Z1)). + +api_inflateSync(doc) -> "Test inflateSync"; +api_inflateSync(suite) -> []; +api_inflateSync(Config) when is_list(Config) -> + {skip,"inflateSync/1 sucks"}. +%% ?line Z1 = zlib:open(), +%% ?m(ok, zlib:deflateInit(Z1)), +%% ?line B1list0 = zlib:deflate(Z1, "gurkan gurra ger galna tunnor", full), +%% ?line B2 = zlib:deflate(Z1, "grodan boll", finish), +%% io:format("~p\n", [B1list0]), +%% io:format("~p\n", [B2]), +%% ?m(ok, zlib:deflateEnd(Z1)), +%% ?line B1 = clobber(14, list_to_binary(B1list0)), +%% ?line Compressed = list_to_binary([B1,B2]), +%% ?line io:format("~p\n", [Compressed]), + +%% ?m(ok, zlib:inflateInit(Z1)), +%% ?m(?BARG, zlib:inflateSync(gurka)), +%% ?m({'EXIT',{data_error,_}}, zlib:inflate(Z1, Compressed)), +%% ?m(ok, zlib:inflateSync(Z1)), +%% ?line Ubs = zlib:inflate(Z1, []), +%% ?line <<"grodan boll">> = list_to_binary(Ubs), +%% ?m(ok, zlib:close(Z1)). + +clobber(N, Bin) when is_binary(Bin) -> + T = list_to_tuple(binary_to_list(Bin)), + Byte = case element(N, T) of + 255 -> 254; + B -> B+1 + end, + list_to_binary(tuple_to_list(setelement(N, T, Byte))). + +api_inflateReset(doc) -> "Test inflateReset"; +api_inflateReset(suite) -> []; +api_inflateReset(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m(ok, zlib:inflateInit(Z1)), + ?m(?BARG, zlib:inflateReset(gurka)), + ?m(ok, zlib:inflateReset(Z1)), + ?m(ok, zlib:close(Z1)). + +api_inflate(doc) -> "Test inflate"; +api_inflate(suite) -> []; +api_inflate(Config) when is_list(Config) -> + Data = [<<1,2,2,3,3,3,4,4,4,4>>], + ?line Compressed = zlib:compress(Data), + ?line Z1 = zlib:open(), + ?m(ok, zlib:inflateInit(Z1)), + ?m([], zlib:inflate(Z1, <<>>)), + ?m(Data, zlib:inflate(Z1, Compressed)), + ?m(ok, zlib:inflateEnd(Z1)), + ?m(ok, zlib:inflateInit(Z1)), + ?m(Data, zlib:inflate(Z1, Compressed)), + ?m(?BARG, zlib:inflate(gurka, Compressed)), + ?m(?BARG, zlib:inflate(Z1, 4384)), + ?m(?BARG, zlib:inflate(Z1, [atom_list])), + ?m(ok, zlib:inflateEnd(Z1)), + ?m(ok, zlib:inflateInit(Z1)), + ?m({'EXIT',{data_error,_}}, zlib:inflate(Z1, <<2,1,2,1,2>>)), + ?m(ok, zlib:close(Z1)). + +api_inflateEnd(doc) -> "Test inflateEnd"; +api_inflateEnd(suite) -> []; +api_inflateEnd(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m({'EXIT',{einval,_}}, zlib:inflateEnd(Z1)), + ?m(ok, zlib:inflateInit(Z1)), + ?m(?BARG, zlib:inflateEnd(gurka)), + ?m({'EXIT',{data_error,_}}, zlib:inflateEnd(Z1)), + ?m({'EXIT',{einval,_}}, zlib:inflateEnd(Z1)), + ?m(ok, zlib:inflateInit(Z1)), + ?m(B when is_list(B), zlib:inflate(Z1, zlib:compress("abc"))), + ?m(ok, zlib:inflateEnd(Z1)), + ?m(ok, zlib:close(Z1)). + +api_getBufsz(doc) -> "Test getBufsz"; +api_getBufsz(suite) -> []; +api_getBufsz(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m(Val when is_integer(Val), zlib:getBufSize(Z1)), + ?m(?BARG, zlib:getBufSize(gurka)), + ?m(ok, zlib:close(Z1)). + +api_setBufsz(doc) -> "Test setBufsz"; +api_setBufsz(suite) -> []; +api_setBufsz(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m(?BARG, zlib:setBufSize(Z1, gurka)), + ?m(?BARG, zlib:setBufSize(gurka, 1232330)), + Sz = ?m( Val when is_integer(Val), zlib:getBufSize(Z1)), + ?m(ok, zlib:setBufSize(Z1, Sz*2)), + DSz = Sz*2, + ?m(DSz, zlib:getBufSize(Z1)), + ?m(ok, zlib:close(Z1)). + +%%% Debug function ?? +api_getQSize(doc) -> "Test getQSize"; +api_getQSize(suite) -> []; +api_getQSize(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + Q = ?m(Val when is_integer(Val), zlib:getQSize(Z1)), + io:format("QSize ~p ~n", [Q]), + ?m(?BARG, zlib:getQSize(gurka)), + ?m(ok, zlib:close(Z1)). + +api_crc32(doc) -> "Test crc32"; +api_crc32(suite) -> []; +api_crc32(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m(ok, zlib:deflateInit(Z1,best_speed,deflated,-15,8,default)), + Bin = <<1,1,1,1,1,1,1,1,1>>, + Compressed1 = ?m(_, zlib:deflate(Z1, Bin, none)), + Compressed2 = ?m(_, zlib:deflate(Z1, <<>>, finish)), + Compressed = list_to_binary(Compressed1 ++ Compressed2), + CRC1 = ?m( CRC1 when is_integer(CRC1), zlib:crc32(Z1)), + ?m(CRC1 when is_integer(CRC1), zlib:crc32(Z1,Bin)), + ?m(CRC2 when is_integer(CRC2), zlib:crc32(Z1,Compressed)), + CRC2 = ?m(CRC2 when is_integer(CRC2), zlib:crc32(Z1,0,Compressed)), + ?m(CRC3 when CRC2 /= CRC3, zlib:crc32(Z1,234,Compressed)), + ?m(?BARG, zlib:crc32(gurka)), + ?m(?BARG, zlib:crc32(Z1, not_a_binary)), + ?m(?BARG, zlib:crc32(gurka, <<1,1,2,4,4>>)), + ?m(?BARG, zlib:crc32(Z1, 2298929, not_a_binary)), + ?m(?BARG, zlib:crc32(Z1, not_an_int, <<123,123,123,35,231>>)), + ?m(?BARG, zlib:crc32_combine(Z1, not_an_int, 123123, 123)), + ?m(?BARG, zlib:crc32_combine(Z1, noint, 123123, 123)), + ?m(?BARG, zlib:crc32_combine(Z1, 123123, noint, 123)), + ?m(?BARG, zlib:crc32_combine(Z1, 123123, 123, noint)), + ?m(ok, zlib:deflateEnd(Z1)), + ?m(ok, zlib:close(Z1)). + +api_adler32(doc) -> "Test adler32"; +api_adler32(suite) -> []; +api_adler32(Config) when is_list(Config) -> + ?line Z1 = zlib:open(), + ?m(ok, zlib:deflateInit(Z1,best_speed,deflated,-15,8,default)), + Bin = <<1,1,1,1,1,1,1,1,1>>, + Compressed1 = ?m(_, zlib:deflate(Z1, Bin, none)), + Compressed2 = ?m(_, zlib:deflate(Z1, <<>>, finish)), + Compressed = list_to_binary(Compressed1 ++ Compressed2), + ?m(ADLER1 when is_integer(ADLER1), zlib:adler32(Z1,Bin)), + ADLER2 = ?m(ADLER2 when is_integer(ADLER2), zlib:adler32(Z1,Compressed)), + ?m(ADLER2 when is_integer(ADLER2), zlib:adler32(Z1,1,Compressed)), + ?m(ADLER3 when ADLER2 /= ADLER3, zlib:adler32(Z1,234,Compressed)), + ?m(?BARG, zlib:adler32(Z1, not_a_binary)), + ?m(?BARG, zlib:adler32(gurka, <<1,1,2,4,4>>)), + ?m(?BARG, zlib:adler32(Z1, 2298929, not_a_binary)), + ?m(?BARG, zlib:adler32(Z1, not_an_int, <<123,123,123,35,231>>)), + ?m(?BARG, zlib:adler32_combine(Z1, noint, 123123, 123)), + ?m(?BARG, zlib:adler32_combine(Z1, 123123, noint, 123)), + ?m(?BARG, zlib:adler32_combine(Z1, 123123, 123, noint)), + ?m(ok, zlib:deflateEnd(Z1)), + ?m(ok, zlib:close(Z1)). + +api_un_compress(doc) -> "Test compress"; +api_un_compress(suite) -> []; +api_un_compress(Config) when is_list(Config) -> + ?m(?BARG,zlib:compress(not_a_binary)), + Bin = <<1,11,1,23,45>>, + ?line Comp = zlib:compress(Bin), + ?m(?BARG,zlib:uncompress(not_a_binary)), + ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<171,171,171,171,171>>)), + ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<>>)), + ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120>>)), + ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120,156>>)), + ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120,156,3>>)), + ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<120,156,3,0>>)), + ?m({'EXIT',{data_error,_}}, zlib:uncompress(<<0,156,3,0,0,0,0,1>>)), + ?m(Bin, zlib:uncompress(Comp)). + +api_un_zip(doc) -> "Test zip"; +api_un_zip(suite) -> []; +api_un_zip(Config) when is_list(Config) -> + ?m(?BARG,zlib:zip(not_a_binary)), + Bin = <<1,11,1,23,45>>, + ?line Comp = zlib:zip(Bin), + ?m(?BARG,zlib:unzip(not_a_binary)), + ?m({'EXIT',{data_error,_}}, zlib:unzip(<<171,171,171,171,171>>)), + ?m({'EXIT',{data_error,_}}, zlib:unzip(<<>>)), + ?m(Bin, zlib:unzip(Comp)), + + %% OTP-6396 + B = <<131,104,19,100,0,13,99,95,99,105,100,95,99,115,103,115,110,95,50,97,1,107,0,4,208,161,246,29,107,0,3,237,166,224,107,0,6,66,240,153,0,2,10,1,0,8,97,116,116,97,99,104,101,100,104,2,100,0,22,117,112,100,97,116,101,95,112,100,112,95,99,111,110,116,101,120,116,95,114,101,113,107,0,114,69,3,12,1,11,97,31,113,150,64,104,132,61,64,104,12,3,197,31,113,150,64,104,132,61,64,104,12,1,11,97,31,115,150,64,104,116,73,64,104,0,0,0,0,0,0,65,149,16,61,65,149,16,61,1,241,33,4,5,0,33,4,4,10,6,10,181,4,10,6,10,181,38,15,99,111,109,109,97,110,100,1,114,45,97,112,110,45,49,3,99,111,109,5,109,110,99,57,57,6,109,99,99,50,52,48,4,103,112,114,115,8,0,104,2,104,2,100,0,8,97,99,116,105,118,97,116,101,104,23,100,0,11,112,100,112,95,99,111,110,116,1,120,116,100,0,7,112,114,105,109,97,114,121,97,1,100,0,9,117,110,100,101,102,105,110,101,100,97,1,97,4,97,4,97,7,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,110,10100,100,0,9,117,110,100,101,102,105,110,101,100,100,0,5,102,97,108,115,101,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,1,101,100,97,0,100,0,9,117,110,100,101,102,105,110,101,100,107,0,4,16,0,1,144,107,0,4,61,139,186,181,107,0,4,10,8,201,49,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,0,101,100,100,0,9,117,110,100,101,102,105,110,101,100,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,16,97,21,106,108,0,0,0,3,104,2,97,1,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,167,20,104,2,97,4,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,16,97,21,104,2,97,10,104,2,104,3,98,0,0,7,214,97,11,97,20,104,3,97,17,97,16,97,26,106,100,0,5,118,101,114,57,57,100,0,9,117,110,0,101,102,105,110,101,100,107,0,2,0,244,107,0,4,10,6,102,195,107,0,4,10,6,102,195,100,0,9,117,110,100,101,102,105,110,101,100,100,0,9,117,110,100,101,102,105,110,101,100,107,0,125,248,143,0,203,25115,157,116,65,185,65,172,55,87,164,88,225,50,203,251,115,157,116,65,185,65,172,55,87,164,88,225,50,0,0,82,153,50,0,200,98,87,148,237,193,185,65,149,167,69,144,14,16,153,50,3,81,70,94,13,109,193,1,120,5,181,113,198,118,50,3,81,70,94,13,109,193,185,120,5,181,113,198,118,153,3,81,70,94,13,109,193,185,120,5,181,113,198,118,153,50,16,1,2,3,4,5,6,7,8,9,0,1,2,3,4,5,6,113,92,2,119,128,0,0,108,0,0,1,107,0,114,69,3,12,1,11,97,31,113,150,64,104,132,61,64,104,12,3,11,97,31,113,150,64,104,132,61,64,104,12,1,11,97,31,115,150,64,104,116,73,64,104,0,0,0,0,0,0,65,149,16,61,65,149,16,61,1,241,33,4,0,33,4,4,10,6,10,181,4,10,6,10,181,38,15,99,111,109,109,97,110,100,101,114,45,97,112,110,45,49,3,99,111,109,5,109,110,99,57,57,6,109,99,99,50,52,48,4,103,112,114,115,8,0,106>>, + Z = zlib:zip(B), + ?m(B, zlib:unzip(Z)). + +%% api_g_un_zip_file(doc) -> "Test gunzip_file"; +%% api_g_un_zip_file(suite) -> []; +%% api_g_un_zip_file(Config) when is_list(Config) -> +%% ?line Out = conf(data_dir,Config), +%% io:format("Using OutDir ~p ~n", [Out]), +%% F = filename:join(Out,"testing1"), +%% Data = <<1,1,255,255,255,1,1>>, +%% ?m(ok, file:write_file(F,Data)), +%% ?line Compressed = zlib:gzip_file(F), +%% ?m(ok, file:write_file(F++".gz",Compressed)), +%% ?m(Data, zlib:gunzip_file(F++".gz")), +%% ?m({error,enoent}, zlib:gunzip_file(gurka)), +%% ?m({error,enoent}, zlib:gzip_file(gurka)), +%% ?m({error,what}, zlib:gunzip_file(F)), +%% ?line ok. + +api_g_un_zip(doc) -> "Test gunzip"; +api_g_un_zip(suite) -> []; +api_g_un_zip(Config) when is_list(Config) -> + ?m(?BARG,zlib:gzip(not_a_binary)), + Bin = <<1,11,1,23,45>>, + ?line Comp = zlib:gzip(Bin), + ?m(?BARG, zlib:gunzip(not_a_binary)), + ?m(?DATA_ERROR, zlib:gunzip(<<171,171,171,171,171>>)), + ?m(?DATA_ERROR, zlib:gunzip(<<>>)), + ?m(Bin, zlib:gunzip(Comp)), + + %% Bad CRC; bad length. + BadCrc = bad_crc_data(), + ?line ?m({'EXIT',{data_error,_}},(catch zlib:gunzip(BadCrc))), + BadLen = bad_len_data(), + ?line ?m({'EXIT',{data_error,_}},(catch zlib:gunzip(BadLen))), + ok. + +bad_crc_data() -> + %% zlib:zip(<<42>>), one byte changed. + <<31,139,8,0,0,0,0,0,0,3,211,2,0,91,39,185,9,1,0,0,0>>. + +bad_len_data() -> + %% zlib:zip(<<42>>), one byte changed. + <<31,139,8,0,0,0,0,0,0,3,211,2,0,91,38,185,9,2,0,0,0>>. + +examples(doc) -> "Test the doc examples"; +examples(suite) -> + [ + intro + ]. + +intro(suite) -> []; +intro(doc) -> ""; +intro(Config) when is_list(Config) -> + D = <<"This is a binary">>, + [put({ex, N}, <<"This is a binary">>) || N <- [0,1,2,3,4]], + put({ex, 5}, end_of_data), + put(ex,0), + ?line Read = fun() -> + N = get(ex), + put(ex,N+1), + get({ex,N}) + end, + + ?line Z = zlib:open(), + ?line ok = zlib:deflateInit(Z,default), + + ?line Compress = fun(end_of_data, _Cont) -> []; + (Data, Cont) -> + [zlib:deflate(Z, Data)|Cont(Read(),Cont)] + end, + ?line Compressed = Compress(Read(),Compress), + ?line Last = zlib:deflate(Z, [], finish), + ?line ok = zlib:deflateEnd(Z), + ?line zlib:close(Z), + ?line Res = list_to_binary([Compressed|Last]), + Orig = list_to_binary(lists:duplicate(5, D)), + ?m(Orig, zlib:uncompress(Res)). + +func(doc) -> "Test the functionality"; +func(suite) -> + [zip_usage, gz_usage, gz_usage2, compress_usage, + dictionary_usage, + large_deflate, + %% inflateSync, + crc, + adler + ]. + +large_deflate(doc) -> "Test deflate large file, which had a bug reported on erlang-bugs"; +large_deflate(suite) -> []; +large_deflate(Config) when is_list(Config) -> + large_deflate(). +large_deflate() -> + ?line Z = zlib:open(), + ?line Plain = rand_bytes(zlib:getBufSize(Z)*5), + ?line ok = zlib:deflateInit(Z), + ?line _ZlibHeader = zlib:deflate(Z, [], full), + ?line Deflated = zlib:deflate(Z, Plain, full), + ?m(ok, zlib:close(Z)), + ?m(Plain, zlib:unzip(list_to_binary([Deflated, 3, 0]))). + +rand_bytes(Sz) -> + L = <<8,2,3,6,1,2,3,2,3,4,8,7,3,7,2,3,4,7,5,8,9,3>>, + rand_bytes(erlang:md5(L),Sz). + +rand_bytes(Bin, Sz) when byte_size(Bin) >= Sz -> + <<Res:Sz/binary, _/binary>> = Bin, + Res; +rand_bytes(Bin, Sz) -> + rand_bytes(<<(erlang:md5(Bin))/binary, Bin/binary>>, Sz). + + +zip_usage(doc) -> "Test a standard compressed zip file"; +zip_usage(suite) -> []; +zip_usage(Config) when is_list(Config) -> + zip_usage(zip_usage({get_arg,Config})); +zip_usage({get_arg,Config}) -> + ?line Out = conf(data_dir,Config), + ?line {ok,ZIP} = file:read_file(filename:join(Out,"zipdoc.zip")), + ?line {ok,ORIG} = file:read_file(filename:join(Out,"zipdoc")), + {run,ZIP,ORIG}; +zip_usage({run,ZIP,ORIG}) -> + ?line <<_:14/binary, CRC:32/little, + CompSz:32/little, UnCompSz:32/little,_:31/binary, + Compressed:CompSz/binary, _/binary>> = ZIP, + + %%io:format("CRC ~p CSz ~p UnCSz ~p ~n", [CRC,CompSz,UnCompSz]), + ?line Split = split_bin(Compressed,[]), + ?line Z = zlib:open(), + + ?m(ok, zlib:inflateInit(Z, -15)), + Bs = [zlib:inflate(Z, Part) || Part <- Split], + UC0 = list_to_binary(Bs), + ?m(UnCompSz, byte_size(UC0)), + ?m(CRC, zlib:crc32(Z)), + ?m(true, zlib:crc32(Z,UC0) == zlib:crc32(Z,ORIG)), + ?m(ok, zlib:inflateEnd(Z)), + + ?line UC1 = zlib:unzip(Compressed), + ?m(UnCompSz, byte_size(UC1)), + ?m(true, zlib:crc32(Z,UC1) == zlib:crc32(Z,ORIG)), + + ?m(ok, zlib:inflateInit(Z, -15)), + ?line UC2 = zlib:inflate(Z, Compressed), + ?m(UnCompSz, byte_size(list_to_binary(UC2))), + ?m(CRC, zlib:crc32(Z)), + ?m(true, zlib:crc32(Z,UC2) == zlib:crc32(Z,ORIG)), + ?m(ok, zlib:inflateEnd(Z)), + + ?m(ok, zlib:inflateInit(Z, -15)), + ?line UC3 = zlib:inflate(Z, Split), % Test multivec. + ?m(UnCompSz, byte_size(list_to_binary(UC3))), + ?m(true, zlib:crc32(Z,UC3) == zlib:crc32(Z,ORIG)), + ?m(CRC, zlib:crc32(Z)), + ?m(ok, zlib:inflateEnd(Z)), + + ?m(ok, zlib:inflateInit(Z, -15)), + ?m(ok, zlib:setBufSize(Z, UnCompSz *2)), + ?line UC4 = zlib:inflate(Z, Compressed), + ?m(UnCompSz, byte_size(list_to_binary(UC4))), + ?m(CRC, zlib:crc32(Z)), + ?m(CRC, zlib:crc32(Z,UC4)), + ?m(true, zlib:crc32(Z,UC4) == zlib:crc32(Z,ORIG)), + ?m(ok, zlib:inflateEnd(Z)), + + ?line C1 = zlib:zip(ORIG), + ?line UC5 = zlib:unzip(C1), + ?m(CRC, zlib:crc32(Z,UC5)), + ?m(true,zlib:crc32(Z,UC5) == zlib:crc32(Z,ORIG)), + + ?m(ok, zlib:deflateInit(Z, default, deflated, -15, 8, default)), + ?line C2 = zlib:deflate(Z, ORIG, finish), + ?m(true, C1 == list_to_binary(C2)), + ?m(ok, zlib:deflateEnd(Z)), + + ?m(ok, zlib:deflateInit(Z, none, deflated, -15, 8, filtered)), + ?m(ok, zlib:deflateParams(Z, default, default)), + ?line C3 = zlib:deflate(Z, ORIG, finish), + ?m(true, C1 == list_to_binary(C3)), + ?m(ok, zlib:deflateEnd(Z)), + + ?line ok = zlib:close(Z), + ?line ok. + +gz_usage(doc) -> "Test a standard compressed gzipped file"; +gz_usage(suite) -> []; +gz_usage(Config) when is_list(Config) -> + gz_usage(gz_usage({get_arg,Config})); +gz_usage({get_arg,Config}) -> + ?line Out = conf(data_dir,Config), + ?line {ok,GZIP} = file:read_file(filename:join(Out,"zipdoc.1.gz")), + ?line {ok,ORIG} = file:read_file(filename:join(Out,"zipdoc")), + ?line {ok,GZIP2} = file:read_file(filename:join(Out,"zipdoc.txt.gz")), + {run,GZIP,ORIG,GZIP2}; +gz_usage({run,GZIP,ORIG,GZIP2}) -> + ?line Z = zlib:open(), + ?line UC1 = zlib:gunzip(GZIP), + ?m(true,zlib:crc32(Z,UC1) == zlib:crc32(Z,ORIG)), + ?line UC3 = zlib:gunzip(GZIP2), + ?m(true,zlib:crc32(Z,UC3) == zlib:crc32(Z,ORIG)), + ?line Compressed = zlib:gzip(ORIG), + ?line UC5 = zlib:gunzip(Compressed), + ?m(true,zlib:crc32(Z,UC5) == zlib:crc32(Z,ORIG)), + ?line ok = zlib:close(Z). + +gz_usage2(doc) -> "Test more of a standard compressed gzipped file"; +gz_usage2(suite) -> []; +gz_usage2(Config) -> + case os:find_executable("gzip") of + Name when is_list(Name) -> + ?line Z = zlib:open(), + ?line Out = conf(data_dir,Config), + ?line {ok,ORIG} = file:read_file(filename:join(Out,"zipdoc")), + ?line Compressed = zlib:gzip(ORIG), + GzOutFile = filename:join(Out,"out.gz"), + OutFile = filename:join(Out,"out.txt"), + ?m(ok, file:write_file(GzOutFile,Compressed)), + ?line os:cmd("gzip -c -d " ++ GzOutFile ++ " > " ++ OutFile), + case file:read_file(OutFile) of + {ok,ExtDecompressed} -> + ?m(true, + zlib:crc32(Z,ExtDecompressed) == zlib:crc32(Z,ORIG)); + Error -> + io:format("Couldn't test external decompressor ~p\n", + [Error]) + end, + ?line ok = zlib:close(Z), + ok; + false -> + {skipped,"No gzip in path"} + end. + + + +compress_usage(doc) -> + "Test that (de)compress funcs work with" + " standard tools, for example a chunk from a png file"; +compress_usage(suite) -> []; +compress_usage(Config) when is_list(Config) -> + compress_usage(compress_usage({get_arg,Config})); +compress_usage({get_arg,Config}) -> + ?line Out = conf(data_dir,Config), + ?line {ok,C1} = file:read_file(filename:join(Out,"png-compressed.zlib")), + {run,C1}; +compress_usage({run,C1}) -> + ?line Z = zlib:open(), + %% See that we can uncompress a file generated with external prog. + ?line UC1 = zlib:uncompress(C1), + %% Check that the crc are correct. + ?m(4125865008,zlib:crc32(Z,UC1)), + ?line C2 = zlib:compress(UC1), + ?line UC2 = zlib:uncompress(C2), + %% Check that the crc are correct. + ?m(4125865008,zlib:crc32(Z,UC2)), + + ?line ok = zlib:close(Z), + + D = [<<"We tests some partial">>, + <<"data, sent over">>, + <<"the stream">>, + <<"we check that we can unpack">>, + <<"every message we get">>], + + ?line ZC = zlib:open(), + ?line ZU = zlib:open(), + Test = fun(finish, {_,Tot}) -> + ?line Compressed = zlib:deflate(ZC, <<>>, finish), + Data = zlib:inflate(ZU, Compressed), + [Tot|Data]; + (Data, {Op,Tot}) -> + ?line Compressed = zlib:deflate(ZC, Data, Op), + Res1 = ?m([Data],zlib:inflate(ZU, Compressed)), + {Op, [Tot|Res1]} + end, + ?line zlib:deflateInit(ZC), + ?line zlib:inflateInit(ZU), + ?line T1 = lists:foldl(Test,{sync,[]},D++[finish]), + ?m(true, list_to_binary(D) == list_to_binary(T1)), + ?line zlib:deflateEnd(ZC), + ?line zlib:inflateEnd(ZU), + + ?line zlib:deflateInit(ZC), + ?line zlib:inflateInit(ZU), + ?line T2 = lists:foldl(Test,{full,[]},D++[finish]), + ?m(true, list_to_binary(D) == list_to_binary(T2)), + ?line zlib:deflateEnd(ZC), + ?line zlib:inflateEnd(ZU), + + ?line ok = zlib:close(ZC), + ?line ok = zlib:close(ZU). + + +crc(doc) -> "Check that crc works as expected"; +crc(suite) -> []; +crc(Config) when is_list(Config) -> + crc(crc({get_arg,Config})); +crc({get_arg,Config}) -> + ?line Out = conf(data_dir,Config), + ?line {ok,C1} = file:read_file(filename:join(Out,"zipdoc")), + {run,C1}; +crc({run,C1}) -> + ?line Z = zlib:open(), + ?line Crc = zlib:crc32(Z, C1), + Bins = split_bin(C1,[]), + %%io:format("Length ~p ~p ~n", [length(Bins), [size(Bin) || Bin <- Bins]]), + Last = lists:last(Bins), + SCrc = lists:foldl(fun(Bin,Crc0) -> + Crc1 = zlib:crc32(Z, Crc0, Bin), + ?m(false, Crc == Crc1 andalso Bin /= Last), + Crc1 + end, 0, Bins), + ?m(Crc,SCrc), + ?line [First|Rest] = Bins, + Combine = fun(Bin, CS1) -> + CS2 = zlib:crc32(Z, Bin), + S2 = byte_size(Bin), + zlib:crc32_combine(Z,CS1,CS2,S2) + end, + ?line Comb = lists:foldl(Combine, zlib:crc32(Z, First), Rest), + ?m(Crc,Comb), + ?line ok = zlib:close(Z). + +adler(doc) -> "Check that adler works as expected"; +adler(suite) -> []; +adler(Config) when is_list(Config) -> + adler(adler({get_arg,Config})); +adler({get_arg,Config}) -> + ?line Out = conf(data_dir,Config), + File1 = filename:join(Out,"zipdoc"), + ?line {ok,C1} = file:read_file(File1), + {run,C1}; +adler({run,C1}) -> + ?line Z = zlib:open(), + ?m(1, zlib:adler32(Z,<<>>)), + ?line Crc = zlib:adler32(Z, C1), + Bins = split_bin(C1,[]), + Last = lists:last(Bins), + SCrc = lists:foldl(fun(Bin,Crc0) -> + Crc1 = zlib:adler32(Z, Crc0, Bin), + ?m(false, Crc == Crc1 andalso Bin /= Last), + Crc1 + end, zlib:adler32(Z,<<>>), Bins), + ?m(Crc,SCrc), + ?line [First|Rest] = Bins, + Combine = fun(Bin, CS1) -> + CS2 = zlib:adler32(Z, Bin), + S2 = byte_size(Bin), + zlib:adler32_combine(Z,CS1,CS2,S2) + end, + ?line Comb = lists:foldl(Combine, zlib:adler32(Z, First), Rest), + ?m(Crc,Comb), + ?line ok = zlib:close(Z). + +dictionary_usage(doc) -> "Test dictionary usage"; +dictionary_usage(suite) -> []; +dictionary_usage(Config) when is_list(Config) -> + dictionary_usage(dictionary_usage({get_arg,Config})); +dictionary_usage({get_arg,_Config}) -> + {run}; % no args +dictionary_usage({run}) -> + ?line Z1 = zlib:open(), + Dict = <<"Anka">>, + Data = <<"Kalle Anka">>, + ?m(ok, zlib:deflateInit(Z1)), + ?line DictID = zlib:deflateSetDictionary(Z1, Dict), + %% ?line io:format("DictID = ~p\n", [DictID]), + ?line B1 = zlib:deflate(Z1, Data), + ?line B2 = zlib:deflate(Z1, <<>>, finish), + ?m(ok, zlib:deflateEnd(Z1)), + ?m(ok, zlib:close(Z1)), + Compressed = list_to_binary([B1,B2]), + %% io:format("~p\n", [Compressed]), + + %% Now uncompress. + ?line Z2 = zlib:open(), + ?m(ok, zlib:inflateInit(Z2)), + ?line {'EXIT',{{need_dictionary,DictID},_}} = (catch zlib:inflate(Z2, Compressed)), + ?m(ok, zlib:inflateSetDictionary(Z2, Dict)), + ?line Uncompressed = ?m(B when is_list(B), zlib:inflate(Z2, [])), + ?m(ok, zlib:inflateEnd(Z2)), + ?m(ok, zlib:close(Z2)), + ?m(Data, list_to_binary(Uncompressed)). + +split_bin(<<Part:1997/binary,Rest/binary>>, Acc) -> + split_bin(Rest, [Part|Acc]); +split_bin(Last,Acc) -> + lists:reverse([Last|Acc]). + + +smp(doc) -> "Check concurrent access to zlib driver"; +smp(suite) -> []; +smp(Config) -> + case erlang:system_info(smp_support) of + true -> + NumOfProcs = lists:min([8,erlang:system_info(schedulers)]), + io:format("smp starting ~p workers\n",[NumOfProcs]), + + %% Tests to run in parallel. + Funcs = [zip_usage, gz_usage, compress_usage, dictionary_usage, + crc, adler], + + %% We get all function arguments here to avoid repeated parallel + %% file read access. + FnAList = lists:map(fun(F) -> {F,?MODULE:F({get_arg,Config})} + end, Funcs), + + Pids = [spawn_link(?MODULE, worker, [random:uniform(9999), + list_to_tuple(FnAList), + self()]) + || _ <- lists:seq(1,NumOfProcs)], + wait_pids(Pids); + + false -> + {skipped,"No smp support"} + end. + + +worker(Seed, FnATpl, Parent) -> + io:format("smp worker ~p, seed=~p~n",[self(),Seed]), + random:seed(Seed,Seed,Seed), + worker_loop(100, FnATpl), + Parent ! self(). + +worker_loop(0, _FnATpl) -> + large_deflate(), % the time consuming one as finale + ok; +worker_loop(N, FnATpl) -> + {F,A} = element(random:uniform(size(FnATpl)),FnATpl), + ?MODULE:F(A), + worker_loop(N-1, FnATpl). + +wait_pids([]) -> + ok; +wait_pids(Pids) -> + receive + Pid -> + ?line true = lists:member(Pid,Pids), + Others = lists:delete(Pid,Pids), + io:format("wait_pid got ~p, still waiting for ~p\n",[Pid,Others]), + wait_pids(Others) + end. + + +otp_7359(doc) -> "Deflate/inflate data with size close to multiple of internal buffer size"; +otp_7359(suite) -> []; +otp_7359(_Config) -> + %% Find compressed size + ZTry = zlib:open(), + ok = zlib:deflateInit(ZTry), + ISize = zlib:getBufSize(ZTry), + IData = list_to_binary([Byte band 255 || Byte <- lists:seq(1,ISize)]), + ?line ISize = byte_size(IData), + + ?line DSize = iolist_size(zlib:deflate(ZTry, IData, sync)), + zlib:close(ZTry), + + io:format("Deflated try ~p -> ~p bytes~n", [ISize, DSize]), + + %% Try deflate and inflate with different internal buffer sizes + ISpan = 1, + DSpan = 10, % use larger span around deflated size as it may vary depending on buf size + + Cases = [{DS,IS} || DMul<-[1,2], + DS <- lists:seq((DSize div DMul)-DSpan, + (DSize div DMul)+DSpan), + IMul<-[1,2], + IS <- lists:seq((ISize div IMul)-ISpan, + (ISize div IMul)+ISpan)], + + lists:foreach(fun(Case) -> otp_7359_def_inf(IData,Case) end, + Cases). + + +otp_7359_def_inf(Data,{DefSize,InfSize}) -> + %%io:format("Try: DefSize=~p InfSize=~p~n", [DefSize,InfSize]), + ?line ZDef = zlib:open(), + ?line ok = zlib:deflateInit(ZDef), + ?line ok = zlib:setBufSize(ZDef,DefSize), + ?line DefData = iolist_to_binary(zlib:deflate(ZDef, Data, sync)), + %%io:format("Deflated ~p(~p) -> ~p(~p) bytes~n", + %% [byte_size(Data), InfSize, byte_size(DefData), DefSize]), + ?line ok = zlib:close(ZDef), + + ?line ZInf = zlib:open(), + ?line ok = zlib:inflateInit(ZInf), + ?line ok = zlib:setBufSize(ZInf,InfSize), + ?line Data = iolist_to_binary(zlib:inflate(ZInf, DefData)), + ?line ok = zlib:close(ZInf), + ok. + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%%% Helps with testing directly %%%%%%%%%%%%% + +conf(What,Config) -> + try ?config(What,Config) of + undefined -> + "./zlib_SUITE_data"; + Dir -> + Dir + catch + _:_ -> "./zlib_SUITE_data" + end. + +t() -> t([all]). + +t(What) when not is_list(What) -> + t([What]); +t(What) -> + lists:foreach(fun(T) -> + try ?MODULE:T([]) + catch _E:_R -> + Line = get(test_server_loc), + io:format("Failed ~p:~p ~p ~p ~p~n", + [T,Line,_E,_R, erlang:get_stacktrace()]) + end + end, expand(What)). + +expand(All) -> + lists:reverse(expand(All,[])). +expand([H|T], Acc) -> + case ?MODULE:H(suite) of + [] -> expand(T,[H|Acc]); + Cs -> + R = expand(Cs, Acc), + expand(T, R) + end; +expand([], Acc) -> Acc. + diff --git a/lib/kernel/test/zlib_SUITE_data/png-compressed.zlib b/lib/kernel/test/zlib_SUITE_data/png-compressed.zlib Binary files differnew file mode 100644 index 0000000000..5ce70684e3 --- /dev/null +++ b/lib/kernel/test/zlib_SUITE_data/png-compressed.zlib diff --git a/lib/kernel/test/zlib_SUITE_data/zipdoc b/lib/kernel/test/zlib_SUITE_data/zipdoc new file mode 100644 index 0000000000..e63952e3ef --- /dev/null +++ b/lib/kernel/test/zlib_SUITE_data/zipdoc @@ -0,0 +1,1924 @@ +[Info-ZIP note, 981119: this file is based on PKWARE's appnote.txt of + 15 February 1996, taking into account PKWARE's revised appnote.txt version + of 01 September 1998. It has been unofficially corrected and extended by + Info-ZIP without explicit permission by PKWARE. Although Info-ZIP + believes the information to be accurate and complete, it is provided + under a disclaimer similar to the PKWARE disclaimer below, differing + only in the substitution of "Info-ZIP" for "PKWARE". In other words, + use this information at your own risk, but we think it's correct. + + Specification info from PKWARE that was obviously wrong has been corrected + silently (e.g. missing structure fields, wrong numbers + As of PKZIPW 2.50, two new incompatibilities have been introduced by PKWARE; + they are noted below. Note that the "NTFS tag" conflict is currently not + real; PKZIPW 2.50 actually tags NTFS files as having come from a FAT + file system, too.] + + +Disclaimer +---------- + +Although PKWARE will attempt to supply current and accurate +information relating to its file formats, algorithms, and the +subject programs, the possibility of error can not be eliminated. +PKWARE therefore expressly disclaims any warranty that the +information contained in the associated materials relating to the +subject programs and/or the format of the files created or +accessed by the subject programs and/or the algorithms used by +the subject programs, or any other matter, is current, correct or +accurate as delivered. Any risk of damage due to any possible +inaccurate information is assumed by the user of the information. +Furthermore, the information relating to the subject programs +and/or the file formats created or accessed by the subject +programs and/or the algorithms used by the subject programs is +subject to change without notice. + + +General Format of a ZIP file +---------------------------- + + Files stored in arbitrary order. Large zipfiles can span multiple + diskette media. + + Overall zipfile format: + + [local file header + file data + data_descriptor] . . . + [central directory] end of central directory record + + + A. Local file header: + + local file header signature 4 bytes (0x04034b50) + version needed to extract 2 bytes + general purpose bit flag 2 bytes + compression method 2 bytes + last mod file time 2 bytes + last mod file date 2 bytes + crc-32 4 bytes + compressed size 4 bytes + uncompressed size 4 bytes + filename length 2 bytes + extra field length 2 bytes + + filename (variable size) + extra field (variable size) + + + B. Data descriptor: + + data descriptor signature 4 bytes (0x08074b50) + crc-32 4 bytes + compressed size 4 bytes + uncompressed size 4 bytes + + This descriptor exists only if bit 3 of the general + purpose bit flag is set (see below). It is byte aligned + and immediately follows the last byte of compressed data. + This descriptor is used only when it was not possible to + seek in the output zip file, e.g., when the output zip file + was standard output or a non seekable device. + + C. Central directory structure: + + [file header] . . . end of central dir record + + File header: + + central file header signature 4 bytes (0x02014b50) + version made by 2 bytes + version needed to extract 2 bytes + general purpose bit flag 2 bytes + compression method 2 bytes + last mod file time 2 bytes + last mod file date 2 bytes + crc-32 4 bytes + compressed size 4 bytes + uncompressed size 4 bytes + filename length 2 bytes + extra field length 2 bytes + file comment length 2 bytes + disk number start 2 bytes + internal file attributes 2 bytes + external file attributes 4 bytes + relative offset of local header 4 bytes + + filename (variable size) + extra field (variable size) + file comment (variable size) + + End of central dir record: + + end of central dir signature 4 bytes (0x06054b50) + number of this disk 2 bytes + number of the disk with the + start of the central directory 2 bytes + total number of entries in + the central dir on this disk 2 bytes + total number of entries in + the central dir 2 bytes + size of the central directory 4 bytes + offset of start of central + directory with respect to + the starting disk number 4 bytes + zipfile comment length 2 bytes + zipfile comment (variable size) + + + D. Explanation of fields: + + version made by (2 bytes) + + The upper byte indicates the host system (OS) for the + file. Software can use this information to determine + the line record format for text files etc. The current + mappings are: + + 0 - FAT file system (DOS, OS/2, NT) + PKZIPW 2.50 VFAT, NTFS + 1 - Amiga + 2 - VMS (VAX or Alpha AXP) + 3 - Unix + 4 - VM/CMS + 5 - Atari + 6 - HPFS file system (OS/2, NT 3.x) + 7 - Macintosh + 8 - Z-System + 9 - CP/M + 10 - TOPS-20 [supposedly PKZIPW 2.50 NTFS] + 11 - NTFS file system (NT) [used by Info-ZIP, only] + 12 - SMS/QDOS + 13 - Acorn RISC OS + 14 - VFAT file system (Win95, NT) [Info-ZIP reservation, unused] + 15 - MVS + 16 - BeOS (BeBox or PowerMac) + 17 - Tandem + 18 thru 255 - unused + + The lower byte indicates the version number of the + software used to encode the file. The value/10 + indicates the major version number, and the value + mod 10 is the minor version number. + + version needed to extract (2 bytes) + + The minimum software version needed to extract the + file, mapped as above. + + general purpose bit flag: (2 bytes) + + Bit 0: If set, indicates that the file is encrypted. + + (For Method 6 - Imploding) + Bit 1: If the compression method used was type 6, + Imploding, then this bit, if set, indicates + an 8K sliding dictionary was used. If clear, + then a 4K sliding dictionary was used. + Bit 2: If the compression method used was type 6, + Imploding, then this bit, if set, indicates + an 3 Shannon-Fano trees were used to encode the + sliding dictionary output. If clear, then 2 + Shannon-Fano trees were used. + + (For Method 8 - Deflating) + Bit 2 Bit 1 + 0 0 Normal (-en) compression option was used. + 0 1 Maximum (-ex) compression option was used. + 1 0 Fast (-ef) compression option was used. + 1 1 Super Fast (-es) compression option was used. + + Note: Bits 1 and 2 are undefined if the compression + method is any other. + + Bit 3: If this bit is set, the fields crc-32, compressed size + and uncompressed size are set to zero in the local + header. The correct values are put in the data descriptor + immediately following the compressed data. (Note: PKZIP + version 2.04g for DOS only recognizes this bit for method 8 + compression, newer versions of PKZIP recognize this bit + for any compression method.) + [Info-ZIP note: This bit was introduced by PKZIP 2.04 for + DOS. In general, this feature can only be reliably used + together with compression methods that allow intrinsic + detection of the "end-of-compressed-data" condition. From + the set of compression methods described in this Zip archive + specification, only "deflate" meets this requirement. + Especially, the method STORED does not work! + The Info-ZIP tools recognize this bit regardless of the + compression method; but, they rely on correctly set + "compressed size" information in the central directory entry.] + + Bit 5: If this bit is set, this indicates that the file is compressed + patched data. (Note: Requires PKZIP version 2.70 or greater) + + The upper three bits are reserved and used internally + by the software when processing the zipfile. The + remaining bits are unused. + + compression method: (2 bytes) + + (see accompanying documentation for algorithm + descriptions) + + 0 - The file is stored (no compression) + 1 - The file is Shrunk + 2 - The file is Reduced with compression factor 1 + 3 - The file is Reduced with compression factor 2 + 4 - The file is Reduced with compression factor 3 + 5 - The file is Reduced with compression factor 4 + 6 - The file is Imploded + 7 - Reserved for Tokenizing compression algorithm + 8 - The file is Deflated + 9 - Reserved for enhanced Deflating + 10 - PKWARE Data Compression Library Imploding + + date and time fields: (2 bytes each) + + The date and time are encoded in standard MS-DOS format. + If input came from standard input, the date and time are + those at which compression was started for this data. + + CRC-32: (4 bytes) + + The CRC-32 algorithm was generously contributed by + David Schwaderer and can be found in his excellent + book "C Programmers Guide to NetBIOS" published by + Howard W. Sams & Co. Inc. The 'magic number' for + the CRC is 0xdebb20e3. The proper CRC pre and post + conditioning is used, meaning that the CRC register + is pre-conditioned with all ones (a starting value + of 0xffffffff) and the value is post-conditioned by + taking the one's complement of the CRC residual. + If bit 3 of the general purpose flag is set, this + field is set to zero in the local header and the correct + value is put in the data descriptor and in the central + directory. + + compressed size: (4 bytes) + uncompressed size: (4 bytes) + + The size of the file compressed and uncompressed, + respectively. If bit 3 of the general purpose bit flag + is set, these fields are set to zero in the local header + and the correct values are put in the data descriptor and + in the central directory. + + filename length: (2 bytes) + extra field length: (2 bytes) + file comment length: (2 bytes) + + The length of the filename, extra field, and comment + fields respectively. The combined length of any + directory record and these three fields should not + generally exceed 65,535 bytes. If input came from standard + input, the filename length is set to zero. + + [Info-ZIP note: + This feature is not yet supported by any PKWARE version of ZIP + (at least not in PKZIP for DOS and PKZIP for Windows/WinNT). + The Info-ZIP programs handle standard input differently: + If input came from standard input, the filename is set to "-" + (length one).] + + + disk number start: (2 bytes) + + The number of the disk on which this file begins. + + internal file attributes: (2 bytes) + + The lowest bit of this field indicates, if set, that + the file is apparently an ASCII or text file. If not + set, that the file apparently contains binary data. + The remaining bits are unused in version 1.0. + + external file attributes: (4 bytes) + + The mapping of the external attributes is + host-system dependent (see 'version made by'). For + MS-DOS, the low order byte is the MS-DOS directory + attribute byte. If input came from standard input, this + field is set to zero. + + relative offset of local header: (4 bytes) + + This is the offset from the start of the first disk on + which this file appears, to where the local header should + be found. + + filename: (Variable) + + The name of the file, with optional relative path. + The path stored should not contain a drive or + device letter, or a leading slash. All slashes + should be forward slashes '/' as opposed to + backwards slashes '\' for compatibility with Amiga + and Unix file systems etc. If input came from standard + input, there is no filename field. + [Info-ZIP discrepancy: + If input came from standard input, the file name is set + to "-" (without the quotes). + As far as we know, the PKWARE specification for "input from + stdin" is not supported by PKZIP/PKUNZIP for DOS, OS/2, Windows + Windows NT.] + + extra field: (Variable) + + This is for future expansion. If additional information + needs to be stored in the future, it should be stored + here. Earlier versions of the software can then safely + skip this file, and find the next file or header. This + field will be 0 length in version 1.0. + + In order to allow different programs and different types + of information to be stored in the 'extra' field in .ZIP + files, the following structure should be used for all + programs storing data in this field: + + header1+data1 + header2+data2 . . . + + Each header should consist of: + + Header ID - 2 bytes + Data Size - 2 bytes + + Note: all fields stored in Intel low-byte/high-byte order. + + The Header ID field indicates the type of data that is in + the following data block. + + Header ID's of 0 thru 31 are reserved for use by PKWARE. + The remaining ID's can be used by third party vendors for + proprietary usage. + + The current Header ID mappings defined by PKWARE are: + + 0x0007 AV Info + 0x0009 OS/2 extended attributes (also Info-ZIP) + 0x000a PKWARE Win95/WinNT FileTimes [undocumented!] + 0x000c PKWARE VAX/VMS (also Info-ZIP) + 0x000d PKWARE Unix + 0x000f Patch Descriptor + + The Header ID mappings defined by Info-ZIP and third parties are: + + 0x07c8 Info-ZIP Macintosh (old, J. Lee) + 0x2605 ZipIt Macintosh (first version) + 0x2705 ZipIt Macintosh v 1.3.5 and newer (w/o full filename) + 0x334d Info-ZIP Macintosh (new, D. Haase's 'Mac3' field ) + 0x4341 Acorn/SparkFS (David Pilling) + 0x4453 Windows NT security descriptor (binary ACL) + 0x4704 VM/CMS + 0x470f MVS + 0x4b46 FWKCS MD5 (third party, see below) + 0x4c41 OS/2 access control list (text ACL) + 0x4d49 Info-ZIP VMS (VAX or Alpha) + 0x5356 AOS/VS (binary ACL) + 0x5455 extended timestamp + 0x5855 Info-ZIP Unix (original; also OS/2, NT, etc.) + 0x6542 BeOS (BeBox, PowerMac, etc.) + 0x756e ASi Unix + 0x7855 Info-ZIP Unix (new) + 0xfb4a SMS/QDOS + + The Data Size field indicates the size of the following + data block. Programs can use this value to skip to the + next header block, passing over any data blocks that are + not of interest. + + Note: As stated above, the size of the entire .ZIP file + header, including the filename, comment, and extra + field should not exceed 64K in size. + + In case two different programs should appropriate the same + Header ID value, it is strongly recommended that each + program place a unique signature of at least two bytes in + size (and preferably 4 bytes or bigger) at the start of + each data area. Every program should verify that its + unique signature is present, in addition to the Header ID + value being correct, before assuming that it is a block of + known type. + + In the following descriptions, note that "Short" means two bytes, + "Long" means four bytes, and "Long-Long" means eight bytes, + regardless of their native sizes. Unless specifically noted, all + integer fields should be interpreted as unsigned (non-negative) + numbers. + + + -OS/2 Extended Attributes Extra Field: + ==================================== + + The following is the layout of the OS/2 extended attributes "extra" + block. (Last Revision 19960922) + + Note: all fields stored in Intel low-byte/high-byte order. + + Local-header version: + + Value Size Description + ----- ---- ----------- + (OS/2) 0x0009 Short tag for this extra block type + TSize Short total data size for this block + BSize Long uncompressed EA data size + CType Short compression type + EACRC Long CRC value for uncompressed EA data + (var.) variable compressed EA data + + Central-header version: + + Value Size Description + ----- ---- ----------- + (OS/2) 0x0009 Short tag for this extra block type + TSize Short total data size for this block + BSize Long size of uncompressed local EA data + + The value of CType is interpreted according to the "compression + method" section above; i.e., 0 for stored, 8 for deflated, etc. + + The OS/2 extended attribute structure (FEA2LIST) is compressed and + then stored in its entirety within this structure. There will only + ever be one block of data in the variable-length field. + + + -OS/2 Access Control List Extra Field: + ==================================== + + The following is the layout of the OS/2 ACL extra block. + (Last Revision 19960922) + + Local-header version: + + Value Size Description + ----- ---- ----------- + (ACL) 0x4c41 Short tag for this extra block type + TSize Short total data size for this block + BSize Long uncompressed ACL data size + CType Short compression type + EACRC Long CRC value for uncompressed ACL data + (var.) variable compressed ACL data + + Central-header version: + + Value Size Description + ----- ---- ----------- + (ACL) 0x4c41 Short tag for this extra block type + TSize Short total data size for this block + BSize Long size of uncompressed local ACL data + + The value of CType is interpreted according to the "compression + method" section above; i.e., 0 for stored, 8 for deflated, etc. + + The uncompressed ACL data consist of a text header of the form + "ACL1:%hX,%hd\n", where the first field is the OS/2 ACCINFO acc_attr + member and the second is acc_count, followed by acc_count strings + of the form "%s,%hx\n", where the first field is acl_ugname (user + group name) and the second acl_access. This block type will be + extended for other operating systems as needed. + + + -Windows NT Security Descriptor Extra Field: + ========================================== + + The following is the layout of the NT Security Descriptor (another + type of ACL) extra block. (Last Revision 19960922) + + Local-header version: + + Value Size Description + ----- ---- ----------- + (SD) 0x4453 Short tag for this extra block type + TSize Short total data size for this block + BSize Long uncompressed SD data size + Version Byte version of uncompressed SD data format + CType Short compression type + EACRC Long CRC value for uncompressed SD data + (var.) variable compressed SD data + + Central-header version: + + Value Size Description + ----- ---- ----------- + (SD) 0x4453 Short tag for this extra block type + TSize Short total data size for this block + BSize Long size of uncompressed local SD data + + The value of CType is interpreted according to the "compression + method" section above; i.e., 0 for stored, 8 for deflated, etc. + Version specifies how the compressed data are to be interpreted + and allows for future expansion of this extra field type. Currently + only version 0 is defined. + + For version 0, the compressed data are to be interpreted as a single + valid Windows NT SECURITY_DESCRIPTOR data structure, in self-relative + format. + + + -PKWARE Win95/WinNT Extra Field: + ============================== + + The following description covers PKWARE's undocumented + Windows 95 & Windows NT extra field, introduced with the + release of PKZIP for Windows 2.50. (Last Revision 19980425) + + This field has a fixed data size of 32 bytes and is only stored + as local extra field. + + Value Size Description + ----- ---- ----------- + (WinNT) 0x000a Short Tag for this "extra" block type + TSize Short Total Data Size for this block + Unknwn1 Long ???? (all 0 ?) + Unknwn2 Long ???? + ModTime Long-Long 64-bit NTFS last-modified filetime + AccTime Long-Long 64-bit NTFS last-access filetime + CreTime Long-Long 64-bit NTFS creation filetime + + The NTFS filetimes are 64-bit unsigned integers, stored in Intel + (least significant byte first) byte order. They determine the + number of 1.0E-07 seconds (1/10th microseconds!) past WinNT "epoch", + which is "01-Jan-1601 00:00:00 UTC". + + + -PKWARE VAX/VMS Extra Field: + ========================== + + The following is the layout of PKWARE's VAX/VMS attributes "extra" + block. (Last Revision 12/17/91) + + Note: all fields stored in Intel low-byte/high-byte order. + + Value Size Description + ----- ---- ----------- + (VMS) 0x000c Short Tag for this "extra" block type + TSize Short Total Data Size for this block + CRC Long 32-bit CRC for remainder of the block + Tag1 Short VMS attribute tag value #1 + Size1 Short Size of attribute #1, in bytes + (var.) Size1 Attribute #1 data + . + . + . + TagN Short VMS attribute tage value #N + SizeN Short Size of attribute #N, in bytes + (var.) SizeN Attribute #N data + + Rules: + + 1. There will be one or more of attributes present, which will + each be preceded by the above TagX & SizeX values. These + values are identical to the ATR$C_XXXX and ATR$S_XXXX constants + which are defined in ATR.H under VMS C. Neither of these values + will ever be zero. + + 2. No word alignment or padding is performed. + + 3. A well-behaved PKZIP/VMS program should never produce more than + one sub-block with the same TagX value. Also, there will never + be more than one "extra" block of type 0x000c in a particular + directory record. + + + -Info-ZIP VMS Extra Field: + ======================== + + The following is the layout of Info-ZIP's VMS attributes extra + block for VAX or Alpha AXP. The local-header and central-header + versions are identical. (Last Revision 19960922) + + Value Size Description + ----- ---- ----------- + (VMS2) 0x4d49 Short tag for this extra block type + TSize Short total data size for this block + ID Long block ID + Flags Short info bytes + BSize Short uncompressed block size + Reserved Long (reserved) + (var.) variable compressed VMS file-attributes block + + The block ID is one of the following unterminated strings: + + "VFAB" struct FAB + "VALL" struct XABALL + "VFHC" struct XABFHC + "VDAT" struct XABDAT + "VRDT" struct XABRDT + "VPRO" struct XABPRO + "VKEY" struct XABKEY + "VMSV" version (e.g., "V6.1"; truncated at hyphen) + "VNAM" reserved + + The lower three bits of Flags indicate the compression method. The + currently defined methods are: + + 0 stored (not compressed) + 1 simple "RLE" + 2 deflated + + The "RLE" method simply replaces zero-valued bytes with zero-valued + bits and non-zero-valued bytes with a "1" bit followed by the byte + value. + + The variable-length compressed data contains only the data corre- + sponding to the indicated structure or string. Typically multiple + VMS2 extra fields are present (each with a unique block type). + + + -Info-ZIP Macintosh Extra Field: + ============================== + + The following is the layout of the (old) Info-ZIP resource-fork extra + block for Macintosh. The local-header and central-header versions + are identical. (Last Revision 19960922) + + Value Size Description + ----- ---- ----------- + (Mac) 0x07c8 Short tag for this extra block type + TSize Short total data size for this block + "JLEE" beLong extra-field signature + FInfo 16 bytes Macintosh FInfo structure + CrDat beLong HParamBlockRec fileParam.ioFlCrDat + MdDat beLong HParamBlockRec fileParam.ioFlMdDat + Flags beLong info bits + DirID beLong HParamBlockRec fileParam.ioDirID + VolName 28 bytes volume name (optional) + + All fields but the first two are in native Macintosh format + (big-endian Motorola order, not little-endian Intel). The least + significant bit of Flags is 1 if the file is a data fork, 0 other- + wise. In addition, if this extra field is present, the filename + has an extra 'd' or 'r' appended to indicate data fork or resource + fork. The 28-byte VolName field may be omitted. + + + -ZipIt Macintosh Extra Field (long): + ================================== + + The following is the layout of the ZipIt extra block for Macintosh. + The local-header and central-header versions are identical. + (Last Revision 19970130) + + Value Size Description + ----- ---- ----------- + (Mac2) 0x2605 Short tag for this extra block type + TSize Short total data size for this block + "ZPIT" beLong extra-field signature + FnLen Byte length of FileName + FileName variable full Macintosh filename + FileType Byte[4] four-byte Mac file type string + Creator Byte[4] four-byte Mac creator string + + + -ZipIt Macintosh Extra Field (short): + =================================== + + The following is the layout of a shortened variant of the + ZipIt extra block for Macintosh (without "full name" entry). + This variant is used by ZipIt 1.3.5 and newer for entries that + do not need a "full Mac filename" record. + The local-header and central-header versions are identical. + (Last Revision 19980903) + + Value Size Description + ----- ---- ----------- + (Mac2b) 0x2705 Short tag for this extra block type + TSize Short total data size for this block + "ZPIT" beLong extra-field signature + FileType Byte[4] four-byte Mac file type string + Creator Byte[4] four-byte Mac creator string + + + -Info-ZIP Macintosh Extra Field (new): + ==================================== + + The following is the layout of the (new) Info-ZIP extra + block for Macintosh, designed by Dirk Haase. + All values are in little-endian. + (Last Revision 19981005) + + Local-header version: + + Value Size Description + ----- ---- ----------- + (Mac3) 0x334d Short tag for this extra block type ("M3") + TSize Short total data size for this block + BSize Long uncompressed finder attribute data size + Flags Short info bits + fdType Byte[4] Type of the File (4-byte string) + fdCreator Byte[4] Creator of the File (4-byte string) + (CType) Short compression type + (CRC) Long CRC value for uncompressed MacOS data + Attribs variable finder attribute data (see below) + + + Central-header version: + + Value Size Description + ----- ---- ----------- + (Mac3) 0x334d Short tag for this extra block type ("M3") + TSize Short total data size for this block + BSize Long uncompressed finder attribute data size + Flags Short info bits + fdType Byte[4] Type of the File (4-byte string) + fdCreator Byte[4] Creator of the File (4-byte string) + + The third bit of Flags in both headers indicates whether + the LOCAL extra field is uncompressed (and therefore whether CType + and CRC are omitted): + + Bits of the Flags: + bit 0 if set, file is a data fork; otherwise unset + bit 1 if set, filename will be not changed + bit 2 if set, Attribs is uncompressed (no CType, CRC) + bit 3 if set, date and times are in 64 bit + if zero date and times are in 32 bit. + bit 4 if set, timezone offsets fields for the native + Mac times are omitted (UTC support deactivated) + bits 5-15 reserved; + + + Attributes: + + Attribs is a Mac-specific block of data in little-endian format with + the following structure (if compressed, uncompress it first): + + Value Size Description + ----- ---- ----------- + fdFlags Short Finder Flags + fdLocation.v Short Finder Icon Location + fdLocation.h Short Finder Icon Location + fdFldr Short Folder containing file + + FXInfo 16 bytes Macintosh FXInfo structure + FXInfo-Structure: + fdIconID Short + fdUnused[3] Short unused but reserved 6 bytes + fdScript Byte Script flag and number + fdXFlags Byte More flag bits + fdComment Short Comment ID + fdPutAway Long Home Dir ID + + FVersNum Byte file version number + may be not used by MacOS + ACUser Byte directory access rights + + FlCrDat ULong date and time of creation + FlMdDat ULong date and time of last modification + FlBkDat ULong date and time of last backup + These time numbers are original Mac FileTime values (local time!). + Currently, date-time width is 32-bit, but future version may + support be 64-bit times (see flags) + + CrGMTOffs Long(signed!) difference "local Creat. time - UTC" + MdGMTOffs Long(signed!) difference "local Modif. time - UTC" + BkGMTOffs Long(signed!) difference "local Backup time - UTC" + These "local time - UTC" differences (stored in seconds) may be + used to support timestamp adjustment after inter-timezone transfer. + These fields are optional; bit 4 of the flags word controls their + presence. + + Charset Short TextEncodingBase (Charset) + valid for the following two fields + + FullPath variable Path of the current file. + Zero terminated string (C-String) + Currently coded in the native Charset. + + Comment variable Finder Comment of the current file. + Zero terminated string (C-String) + Currently coded in the native Charset. + + + -Acorn SparkFS Extra Field: + ========================= + + The following is the layout of David Pilling's SparkFS extra block + for Acorn RISC OS. The local-header and central-header versions are + identical. (Last Revision 19960922) + + Value Size Description + ----- ---- ----------- + (Acorn) 0x4341 Short tag for this extra block type + TSize Short total data size for this block + "ARC0" Long extra-field signature + LoadAddr Long load address or file type + ExecAddr Long exec address + Attr Long file permissions + Zero Long reserved; always zero + + The following bits of Attr are associated with the given file + permissions: + + bit 0 user-writable ('W') + bit 1 user-readable ('R') + bit 2 reserved + bit 3 locked ('L') + bit 4 publicly writable ('w') + bit 5 publicly readable ('r') + bit 6 reserved + bit 7 reserved + + + -VM/CMS Extra Field: + ================== + + The following is the layout of the file-attributes extra block for + VM/CMS. The local-header and central-header versions are + identical. (Last Revision 19960922) + + Value Size Description + ----- ---- ----------- + (VM/CMS) 0x4704 Short tag for this extra block type + TSize Short total data size for this block + flData variable file attributes data + + flData is an uncompressed fldata_t struct. + + + -MVS Extra Field: + =============== + + The following is the layout of the file-attributes extra block for + MVS. The local-header and central-header versions are identical. + (Last Revision 19960922) + + Value Size Description + ----- ---- ----------- + (MVS) 0x470f Short tag for this extra block type + TSize Short total data size for this block + flData variable file attributes data + + flData is an uncompressed fldata_t struct. + + + -PKWARE Unix Extra Field: + ======================== + + The following is the layout of PKWARE's Unix "extra" block. + It was introduced with the release of PKZIP for Unix 2.50. + Note: all fields are stored in Intel low-byte/high-byte order. + (Last Revision 19980901) + + This field has a minimum data size of 12 bytes and is only stored + as local extra field. + + Value Size Description + ----- ---- ----------- + (Unix0) 0x000d Short Tag for this "extra" block type + TSize Short Total Data Size for this block + AcTime Long time of last access (UTC/GMT) + ModTime Long time of last modification (UTC/GMT) + UID Short Unix user ID + GID Short Unix group ID + (var) variable Variable length data field + + The variable length data field will contain file type + specific data. Currently the only values allowed are + the original "linked to" file names for hard or symbolic links. + + The fixed part of this field has the same layout as Info-ZIP's + abandoned "Unix1 timestamps & owner ID info" extra field; + only the two tag bytes are different. + + + -PATCH Descriptor Extra Field: + ============================ + + The following is the layout of the Patch Descriptor "extra" + block. + + Note: all fields stored in Intel low-byte/high-byte order. + + Value Size Description + ----- ---- ----------- + (Patch) 0x000f Short Tag for this "extra" block type + TSize Short Size of the total "extra" block + Version Short Version of the descriptor + Flags Long Actions and reactions (see below) + OldSize Long Size of the file about to be patched + OldCRC Long 32-bit CRC of the file about to be patched + NewSize Long Size of the resulting file + NewCRC Long 32-bit CRC of the resulting file + + + Actions and reactions + + Bits Description + ---- ---------------- + 0 Use for autodetection + 1 Treat as selfpatch + 2-3 RESERVED + 4-5 Action (see below) + 6-7 RESERVED + 8-9 Reaction (see below) to absent file + 10-11 Reaction (see below) to newer file + 12-13 Reaction (see below) to unknown file + 14-15 RESERVED + 16-31 RESERVED + + Actions + + Action Value + ------ ----- + none 0 + add 1 + delete 2 + patch 3 + + Reactions + + Reaction Value + -------- ----- + ask 0 + skip 1 + ignore 2 + fail 3 + + + -Extended Timestamp Extra Field: + ============================== + + The following is the layout of the extended-timestamp extra block. + (Last Revision 19970118) + + Local-header version: + + Value Size Description + ----- ---- ----------- + (time) 0x5455 Short tag for this extra block type + TSize Short total data size for this block + Flags Byte info bits + (ModTime) Long time of last modification (UTC/GMT) + (AcTime) Long time of last access (UTC/GMT) + (CrTime) Long time of original creation (UTC/GMT) + + Central-header version: + + Value Size Description + ----- ---- ----------- + (time) 0x5455 Short tag for this extra block type + TSize Short total data size for this block + Flags Byte info bits (refers to local header!) + (ModTime) Long time of last modification (UTC/GMT) + + The central-header extra field contains the modification time only, + or no timestamp at all. TSize is used to flag its presence or + absence. But note: + + If "Flags" indicates that Modtime is present in the local header + field, it MUST be present in the central header field, too! + This correspondence is required because the modification time + value may be used to support trans-timezone freshening and + updating operations with zip archives. + + The time values are in standard Unix signed-long format, indicating + the number of seconds since 1 January 1970 00:00:00. The times + are relative to Coordinated Universal Time (UTC), also sometimes + referred to as Greenwich Mean Time (GMT). To convert to local time, + the software must know the local timezone offset from UTC/GMT. + + The lower three bits of Flags in both headers indicate which time- + stamps are present in the LOCAL extra field: + + bit 0 if set, modification time is present + bit 1 if set, access time is present + bit 2 if set, creation time is present + bits 3-7 reserved for additional timestamps; not set + + Those times that are present will appear in the order indicated, but + any combination of times may be omitted. (Creation time may be + present without access time, for example.) TSize should equal + (1 + 4*(number of set bits in Flags)), as the block is currently + defined. Other timestamps may be added in the future. + + + -Info-ZIP Unix Extra Field (type 1): + ================================== + + The following is the layout of the old Info-ZIP extra block for + Unix. It has been replaced by the extended-timestamp extra block + (0x5455) and the Unix type 2 extra block (0x7855). + (Last Revision 19970118) + + Local-header version: + + Value Size Description + ----- ---- ----------- + (Unix1) 0x5855 Short tag for this extra block type + TSize Short total data size for this block + AcTime Long time of last access (UTC/GMT) + ModTime Long time of last modification (UTC/GMT) + UID Short Unix user ID + GID Short Unix group ID + + Central-header version: + + Value Size Description + ----- ---- ----------- + (Unix1) 0x5855 Short tag for this extra block type + TSize Short total data size for this block + AcTime Long time of last access (GMT/UTC) + ModTime Long time of last modification (GMT/UTC) + + The file access and modification times are in standard Unix signed- + long format, indicating the number of seconds since 1 January 1970 + 00:00:00. The times are relative to Coordinated Universal Time + (UTC), also sometimes referred to as Greenwich Mean Time (GMT). To + convert to local time, the software must know the local timezone + offset from UTC/GMT. The modification time may be used by non-Unix + systems to support inter-timezone freshening and updating of zip + archives. + + The local-header extra block may optionally contain UID and GID + info for the file. The local-header TSize value is the only + indication of this. Note that Unix UIDs and GIDs are usually + specific to a particular machine, and they generally require root + access to restore. + + This extra field type is obsolete, but it has been in use since + mid-1994. Therefore future archiving software should continue to + support it. Some guidelines: + + An archive member should either contain the old "Unix1" + extra field block or the new extra field types "time" and/or + "Unix2". + + If both the old "Unix1" block type and one or both of the new + block types "time" and "Unix2" are found, the "Unix1" block + should be considered invalid and ignored. + + Unarchiving software should recognize both old and new extra + field block types, but the info from new types overrides the + old "Unix1" field. + + Archiving software should recognize "Unix1" extra fields for + timestamp comparison but never create it for updated, freshened + or new archive members. When copying existing members to a new + archive, any "Unix1" extra field blocks should be converted to + the new "time" and/or "Unix2" types. + + + -Info-ZIP Unix Extra Field (type 2): + ================================== + + The following is the layout of the new Info-ZIP extra block for + Unix. (Last Revision 19960922) + + Local-header version: + + Value Size Description + ----- ---- ----------- + (Unix2) 0x7855 Short tag for this extra block type + TSize Short total data size for this block + UID Short Unix user ID + GID Short Unix group ID + + Central-header version: + + Value Size Description + ----- ---- ----------- + (Unix2) 0x7855 Short tag for this extra block type + TSize Short total data size for this block + + The data size of the central-header version is zero; it is used + solely as a flag that UID/GID info is present in the local-header + extra field. If additional fields are ever added to the local + version, the central version may be extended to indicate this. + + Note that Unix UIDs and GIDs are usually specific to a particular + machine, and they generally require root access to restore. + + + -ASi Unix Extra Field: + ==================== + + The following is the layout of the ASi extra block for Unix. The + local-header and central-header versions are identical. + (Last Revision 19960916) + + Value Size Description + ----- ---- ----------- + (Unix3) 0x756e Short tag for this extra block type + TSize Short total data size for this block + CRC Long CRC-32 of the remaining data + Mode Short file permissions + SizDev Long symlink'd size OR major/minor dev num + UID Short user ID + GID Short group ID + (var.) variable symbolic link filename + + Mode is the standard Unix st_mode field from struct stat, containing + user/group/other permissions, setuid/setgid and symlink info, etc. + + If Mode indicates that this file is a symbolic link, SizDev is the + size of the file to which the link points. Otherwise, if the file + is a device, SizDev contains the standard Unix st_rdev field from + struct stat (includes the major and minor numbers of the device). + SizDev is undefined in other cases. + + If Mode indicates that the file is a symbolic link, the final field + will be the name of the file to which the link points. The file- + name length can be inferred from TSize. + + [Note that TSize may incorrectly refer to the data size not counting + the CRC; i.e., it may be four bytes too small.] + + + -BeOS Extra Field: + ================ + + The following is the layout of the file-attributes extra block for + BeOS. (Last Revision 19970531) + + Local-header version: + + Value Size Description + ----- ---- ----------- + (BeOS) 0x6542 Short tag for this extra block type + TSize Short total data size for this block + BSize Long uncompressed file attribute data size + Flags Byte info bits + (CType) Short compression type + (CRC) Long CRC value for uncompressed file attribs + Attribs variable file attribute data + + Central-header version: + + Value Size Description + ----- ---- ----------- + (BeOS) 0x6542 Short tag for this extra block type + TSize Short total data size for this block + BSize Long size of uncompressed local EF block data + Flags Byte info bits + + The least significant bit of Flags in both headers indicates whether + the LOCAL extra field is uncompressed (and therefore whether CType + and CRC are omitted): + + bit 0 if set, Attribs is uncompressed (no CType, CRC) + bits 1-7 reserved; if set, assume error or unknown data + + Currently the only supported compression types are deflated (type 8) + and stored (type 0); the latter is not used by Info-ZIP's Zip but is + supported by UnZip. + + Attribs is a BeOS-specific block of data in big-endian format with + the following structure (if compressed, uncompress it first): + + Value Size Description + ----- ---- ----------- + Name variable attribute name (null-terminated string) + Type Long attribute type (32-bit unsigned integer) + Size Long Long data size for this sub-block (64 bits) + Data variable attribute data + + The attribute structure is repeated for every attribute. The Data + field may contain anything--text, flags, bitmaps, etc. + + + -SMS/QDOS Extra Field: + ==================== + + The following is the layout of the file-attributes extra block for + SMS/QDOS. The local-header and central-header versions are identical. + (Last Revision 19960929) + + Value Size Description + ----- ---- ----------- + (QDOS) 0xfb4a Short tag for this extra block type + TSize Short total data size for this block + LongID Long extra-field signature + (ExtraID) Long additional signature/flag bytes + QDirect 64 bytes qdirect structure + + LongID may be "QZHD" or "QDOS". In the latter case, ExtraID will + be present. Its first three bytes are "02\0"; the last byte is + currently undefined. + + QDirect contains the file's uncompressed directory info (qdirect + struct). Its elements are in native (big-endian) format: + + d_length beLong file length + d_access byte file access type + d_type byte file type + d_datalen beLong data length + d_reserved beLong unused + d_szname beShort size of filename + d_name 36 bytes filename + d_update beLong time of last update + d_refdate beLong file version number + d_backup beLong time of last backup (archive date) + + + -AOS/VS Extra Field: + ================== + + The following is the layout of the extra block for Data General + AOS/VS. The local-header and central-header versions are identical. + (Last Revision 19961125) + + Value Size Description + ----- ---- ----------- + (AOSVS) 0x5356 Short tag for this extra block type + TSize Short total data size for this block + "FCI\0" Long extra-field signature + Version Byte version of AOS/VS extra block (10 = 1.0) + Fstat variable fstat packet + AclBuf variable raw ACL data ($MXACL bytes) + + Fstat contains the file's uncompressed fstat packet, which is one of + the following: + + normal fstat packet (P_FSTAT struct) + DIR/CPD fstat packet (P_FSTAT_DIR struct) + unit (device) fstat packet (P_FSTAT_UNIT struct) + IPC file fstat packet (P_FSTAT_IPC struct) + + AclBuf contains the raw ACL data; its length is $MXACL. + + + -FWKCS MD5 Extra Field: + ===================== + + The following is the layout of the optional extra block used by the + FWKCS utility. There is no local-header version; the following + applies only to the central header. (Last Revision 19961207) + + Central-header version: + + Value Size Description + ----- ---- ----------- + (MD5) 0x4b46 Short tag for this extra block type + TSize Short total data size for this block (19) + "MD5" 3 bytes extra-field signature + MD5hash 16 bytes 128-bit MD5 hash of uncompressed data + + The MD5 hash in this extra block is used to automatically identify + files independent of their filenames; it is an an enhanced contents- + signature. + + FWKCS provides an option to strip this extra field, if + present, from a zipfile central directory. In adding + this extra field, FWKCS preserves Zipfile Authenticity + Verification; if stripping this extra field, FWKCS + preserves all versions of AV through PKZIP version 2.04g. + + ``The MD5 algorithm is being placed in the public domain for review + and possible adoption as a standard.'' (Ron Rivest, MIT Laboratory + for Computer Science and RSA Data Security, Inc., April 1992, RFC + 1321, 11.76-77). FWKCS, and FWKCS Contents_Signature System, are + trademarks of Frederick W. Kantor. + + + + file comment: (Variable) + + The comment for this file. + + number of this disk: (2 bytes) + + The number of this disk, which contains central + directory end record. + + number of the disk with the start of the central directory: (2 bytes) + + The number of the disk on which the central + directory starts. + + total number of entries in the central dir on this disk: (2 bytes) + + The number of central directory entries on this disk. + + total number of entries in the central dir: (2 bytes) + + The total number of files in the zipfile. + + + size of the central directory: (4 bytes) + + The size (in bytes) of the entire central directory. + + offset of start of central directory with respect to + the starting disk number: (4 bytes) + + Offset of the start of the central directory on the + disk on which the central directory starts. + + zipfile comment length: (2 bytes) + + The length of the comment for this zipfile. + + zipfile comment: (Variable) + + The comment for this zipfile. + + + D. General notes: + + 1) All fields unless otherwise noted are unsigned and stored + in Intel low-byte:high-byte, low-word:high-word order. + + 2) String fields are not null terminated, since the + length is given explicitly. + + 3) Local headers should not span disk boundaries. Also, even + though the central directory can span disk boundaries, no + single record in the central directory should be split + across disks. + + 4) The entries in the central directory may not necessarily + be in the same order that files appear in the zipfile. + +UnShrinking - Method 1 +---------------------- + +Shrinking is a Dynamic Ziv-Lempel-Welch compression algorithm +with partial clearing. The initial code size is 9 bits, and +the maximum code size is 13 bits. Shrinking differs from +conventional Dynamic Ziv-Lempel-Welch implementations in several +respects: + +1) The code size is controlled by the compressor, and is not + automatically increased when codes larger than the current + code size are created (but not necessarily used). When + the decompressor encounters the code sequence 256 + (decimal) followed by 1, it should increase the code size + read from the input stream to the next bit size. No + blocking of the codes is performed, so the next code at + the increased size should be read from the input stream + immediately after where the previous code at the smaller + bit size was read. Again, the decompressor should not + increase the code size used until the sequence 256,1 is + encountered. + +2) When the table becomes full, total clearing is not + performed. Rather, when the compressor emits the code + sequence 256,2 (decimal), the decompressor should clear + all leaf nodes from the Ziv-Lempel tree, and continue to + use the current code size. The nodes that are cleared + from the Ziv-Lempel tree are then re-used, with the lowest + code value re-used first, and the highest code value + re-used last. The compressor can emit the sequence 256,2 + at any time. + + + +Expanding - Methods 2-5 +----------------------- + +The Reducing algorithm is actually a combination of two +distinct algorithms. The first algorithm compresses repeated +byte sequences, and the second algorithm takes the compressed +stream from the first algorithm and applies a probabilistic +compression method. + +The probabilistic compression stores an array of 'follower +sets' S(j), for j=0 to 255, corresponding to each possible +ASCII character. Each set contains between 0 and 32 +characters, to be denoted as S(j)[0],...,S(j)[m], where m<32. +The sets are stored at the beginning of the data area for a +Reduced file, in reverse order, with S(255) first, and S(0) +last. + +The sets are encoded as { N(j), S(j)[0],...,S(j)[N(j)-1] }, +where N(j) is the size of set S(j). N(j) can be 0, in which +case the follower set for S(j) is empty. Each N(j) value is +encoded in 6 bits, followed by N(j) eight bit character values +corresponding to S(j)[0] to S(j)[N(j)-1] respectively. If +N(j) is 0, then no values for S(j) are stored, and the value +for N(j-1) immediately follows. + +Immediately after the follower sets, is the compressed data +stream. The compressed data stream can be interpreted for the +probabilistic decompression as follows: + + +let Last-Character <- 0. +loop until done + if the follower set S(Last-Character) is empty then + read 8 bits from the input stream, and copy this + value to the output stream. + otherwise if the follower set S(Last-Character) is non-empty then + read 1 bit from the input stream. + if this bit is not zero then + read 8 bits from the input stream, and copy this + value to the output stream. + otherwise if this bit is zero then + read B(N(Last-Character)) bits from the input + stream, and assign this value to I. + Copy the value of S(Last-Character)[I] to the + output stream. + + assign the last value placed on the output stream to + Last-Character. +end loop + + +B(N(j)) is defined as the minimal number of bits required to +encode the value N(j)-1. + + +The decompressed stream from above can then be expanded to +re-create the original file as follows: + + +let State <- 0. + +loop until done + read 8 bits from the input stream into C. + case State of + 0: if C is not equal to DLE (144 decimal) then + copy C to the output stream. + otherwise if C is equal to DLE then + let State <- 1. + + 1: if C is non-zero then + let V <- C. + let Len <- L(V) + let State <- F(Len). + otherwise if C is zero then + copy the value 144 (decimal) to the output stream. + let State <- 0 + + 2: let Len <- Len + C + let State <- 3. + + 3: move backwards D(V,C) bytes in the output stream + (if this position is before the start of the output + stream, then assume that all the data before the + start of the output stream is filled with zeros). + copy Len+3 bytes from this position to the output stream. + let State <- 0. + end case +end loop + + +The functions F,L, and D are dependent on the 'compression +factor', 1 through 4, and are defined as follows: + +For compression factor 1: + L(X) equals the lower 7 bits of X. + F(X) equals 2 if X equals 127 otherwise F(X) equals 3. + D(X,Y) equals the (upper 1 bit of X) * 256 + Y + 1. +For compression factor 2: + L(X) equals the lower 6 bits of X. + F(X) equals 2 if X equals 63 otherwise F(X) equals 3. + D(X,Y) equals the (upper 2 bits of X) * 256 + Y + 1. +For compression factor 3: + L(X) equals the lower 5 bits of X. + F(X) equals 2 if X equals 31 otherwise F(X) equals 3. + D(X,Y) equals the (upper 3 bits of X) * 256 + Y + 1. +For compression factor 4: + L(X) equals the lower 4 bits of X. + F(X) equals 2 if X equals 15 otherwise F(X) equals 3. + D(X,Y) equals the (upper 4 bits of X) * 256 + Y + 1. + + +Imploding - Method 6 +-------------------- + +The Imploding algorithm is actually a combination of two distinct +algorithms. The first algorithm compresses repeated byte +sequences using a sliding dictionary. The second algorithm is +used to compress the encoding of the sliding dictionary output, +using multiple Shannon-Fano trees. + +The Imploding algorithm can use a 4K or 8K sliding dictionary +size. The dictionary size used can be determined by bit 1 in the +general purpose flag word; a 0 bit indicates a 4K dictionary +while a 1 bit indicates an 8K dictionary. + +The Shannon-Fano trees are stored at the start of the compressed +file. The number of trees stored is defined by bit 2 in the +general purpose flag word; a 0 bit indicates two trees stored, a +1 bit indicates three trees are stored. If 3 trees are stored, +the first Shannon-Fano tree represents the encoding of the +Literal characters, the second tree represents the encoding of +the Length information, the third represents the encoding of the +Distance information. When 2 Shannon-Fano trees are stored, the +Length tree is stored first, followed by the Distance tree. + +The Literal Shannon-Fano tree, if present is used to represent +the entire ASCII character set, and contains 256 values. This +tree is used to compress any data not compressed by the sliding +dictionary algorithm. When this tree is present, the Minimum +Match Length for the sliding dictionary is 3. If this tree is +not present, the Minimum Match Length is 2. + +The Length Shannon-Fano tree is used to compress the Length part +of the (length,distance) pairs from the sliding dictionary +output. The Length tree contains 64 values, ranging from the +Minimum Match Length, to 63 plus the Minimum Match Length. + +The Distance Shannon-Fano tree is used to compress the Distance +part of the (length,distance) pairs from the sliding dictionary +output. The Distance tree contains 64 values, ranging from 0 to +63, representing the upper 6 bits of the distance value. The +distance values themselves will be between 0 and the sliding +dictionary size, either 4K or 8K. + +The Shannon-Fano trees themselves are stored in a compressed +format. The first byte of the tree data represents the number of +bytes of data representing the (compressed) Shannon-Fano tree +minus 1. The remaining bytes represent the Shannon-Fano tree +data encoded as: + + High 4 bits: Number of values at this bit length + 1. (1 - 16) + Low 4 bits: Bit Length needed to represent value + 1. (1 - 16) + +The Shannon-Fano codes can be constructed from the bit lengths +using the following algorithm: + +1) Sort the Bit Lengths in ascending order, while retaining the + order of the original lengths stored in the file. + +2) Generate the Shannon-Fano trees: + + Code <- 0 + CodeIncrement <- 0 + LastBitLength <- 0 + i <- number of Shannon-Fano codes - 1 (either 255 or 63) + + loop while i >= 0 + Code = Code + CodeIncrement + if BitLength(i) <> LastBitLength then + LastBitLength=BitLength(i) + CodeIncrement = 1 shifted left (16 - LastBitLength) + ShannonCode(i) = Code + i <- i - 1 + end loop + + +3) Reverse the order of all the bits in the above ShannonCode() + vector, so that the most significant bit becomes the least + significant bit. For example, the value 0x1234 (hex) would + become 0x2C48 (hex). + +4) Restore the order of Shannon-Fano codes as originally stored + within the file. + +Example: + + This example will show the encoding of a Shannon-Fano tree + of size 8. Notice that the actual Shannon-Fano trees used + for Imploding are either 64 or 256 entries in size. + +Example: 0x02, 0x42, 0x01, 0x13 + + The first byte indicates 3 values in this table. Decoding the + bytes: + 0x42 = 5 codes of 3 bits long + 0x01 = 1 code of 2 bits long + 0x13 = 2 codes of 4 bits long + + This would generate the original bit length array of: + (3, 3, 3, 3, 3, 2, 4, 4) + + There are 8 codes in this table for the values 0 thru 7. Using the + algorithm to obtain the Shannon-Fano codes produces: + + Reversed Order Original +Val Sorted Constructed Code Value Restored Length +--- ------ ----------------- -------- -------- ------ +0: 2 1100000000000000 11 101 3 +1: 3 1010000000000000 101 001 3 +2: 3 1000000000000000 001 110 3 +3: 3 0110000000000000 110 010 3 +4: 3 0100000000000000 010 100 3 +5: 3 0010000000000000 100 11 2 +6: 4 0001000000000000 1000 1000 4 +7: 4 0000000000000000 0000 0000 4 + + +The values in the Val, Order Restored and Original Length columns +now represent the Shannon-Fano encoding tree that can be used for +decoding the Shannon-Fano encoded data. How to parse the +variable length Shannon-Fano values from the data stream is beyond the +scope of this document. (See the references listed at the end of +this document for more information.) However, traditional decoding +schemes used for Huffman variable length decoding, such as the +Greenlaw algorithm, can be successfully applied. + +The compressed data stream begins immediately after the +compressed Shannon-Fano data. The compressed data stream can be +interpreted as follows: + +loop until done + read 1 bit from input stream. + + if this bit is non-zero then (encoded data is literal data) + if Literal Shannon-Fano tree is present + read and decode character using Literal Shannon-Fano tree. + otherwise + read 8 bits from input stream. + copy character to the output stream. + otherwise (encoded data is sliding dictionary match) + if 8K dictionary size + read 7 bits for offset Distance (lower 7 bits of offset). + otherwise + read 6 bits for offset Distance (lower 6 bits of offset). + + using the Distance Shannon-Fano tree, read and decode the + upper 6 bits of the Distance value. + + using the Length Shannon-Fano tree, read and decode + the Length value. + + Length <- Length + Minimum Match Length + + if Length = 63 + Minimum Match Length + read 8 bits from the input stream, + add this value to Length. + + move backwards Distance+1 bytes in the output stream, and + copy Length characters from this position to the output + stream. (if this position is before the start of the output + stream, then assume that all the data before the start of + the output stream is filled with zeros). +end loop + +Tokenizing - Method 7 +-------------------- + +This method is not used by PKZIP. + +Deflating - Method 8 +----------------- + +The Deflate algorithm is similar to the Implode algorithm using +a sliding dictionary of up to 32K with secondary compression +from Huffman/Shannon-Fano codes. + +The compressed data is stored in blocks with a header describing +the block and the Huffman codes used in the data block. The header +format is as follows: + + Bit 0: Last Block bit This bit is set to 1 if this is the last + compressed block in the data. + Bits 1-2: Block type + 00 (0) - Block is stored - All stored data is byte aligned. + Skip bits until next byte, then next word = block length, + followed by the ones compliment of the block length word. + Remaining data in block is the stored data. + + 01 (1) - Use fixed Huffman codes for literal and distance codes. + Lit Code Bits Dist Code Bits + --------- ---- --------- ---- + 0 - 143 8 0 - 31 5 + 144 - 255 9 + 256 - 279 7 + 280 - 287 8 + + Literal codes 286-287 and distance codes 30-31 are never + used but participate in the huffman construction. + + 10 (2) - Dynamic Huffman codes. (See expanding Huffman codes) + + 11 (3) - Reserved - Flag a "Error in compressed data" if seen. + +Expanding Huffman Codes +----------------------- +If the data block is stored with dynamic Huffman codes, the Huffman +codes are sent in the following compressed format: + + 5 Bits: # of Literal codes sent - 257 (257 - 286) + All other codes are never sent. + 5 Bits: # of Dist codes - 1 (1 - 32) + 4 Bits: # of Bit Length codes - 4 (4 - 19) + +The Huffman codes are sent as bit lengths and the codes are built as +described in the implode algorithm. The bit lengths themselves are +compressed with Huffman codes. There are 19 bit length codes: + + 0 - 15: Represent bit lengths of 0 - 15 + 16: Copy the previous bit length 3 - 6 times. + The next 2 bits indicate repeat length (0 = 3, ... ,3 = 6) + Example: Codes 8, 16 (+2 bits 11), 16 (+2 bits 10) will + expand to 12 bit lengths of 8 (1 + 6 + 5) + 17: Repeat a bit length of 0 for 3 - 10 times. (3 bits of length) + 18: Repeat a bit length of 0 for 11 - 138 times (7 bits of length) + +The lengths of the bit length codes are sent packed 3 bits per value +(0 - 7) in the following order: + + 16, 17, 18, 0, 8, 7, 9, 6, 10, 5, 11, 4, 12, 3, 13, 2, 14, 1, 15 + +The Huffman codes should be built as described in the Implode algorithm +except codes are assigned starting at the shortest bit length, i.e. the +shortest code should be all 0's rather than all 1's. Also, codes with +a bit length of zero do not participate in the tree construction. The +codes are then used to decode the bit lengths for the literal and distance +tables. + +The bit lengths for the literal tables are sent first with the number +of entries sent described by the 5 bits sent earlier. There are up +to 286 literal characters; the first 256 represent the respective 8 +bit character, code 256 represents the End-Of-Block code, the remaining +29 codes represent copy lengths of 3 thru 258. There are up to 30 +distance codes representing distances from 1 thru 32k as described +below. + + Length Codes + ------------ + Extra Extra Extra Extra + Code Bits Length Code Bits Lengths Code Bits Lengths Code Bits Length(s) + ---- ---- ------ ---- ---- ------- ---- ---- ------- ---- ---- --------- + 257 0 3 265 1 11,12 273 3 35-42 281 5 131-162 + 258 0 4 266 1 13,14 274 3 43-50 282 5 163-194 + 259 0 5 267 1 15,16 275 3 51-58 283 5 195-226 + 260 0 6 268 1 17,18 276 3 59-66 284 5 227-257 + 261 0 7 269 2 19-22 277 4 67-82 285 0 258 + 262 0 8 270 2 23-26 278 4 83-98 + 263 0 9 271 2 27-30 279 4 99-114 + 264 0 10 272 2 31-34 280 4 115-130 + + Distance Codes + -------------- + Extra Extra Extra Extra + Code Bits Dist Code Bits Dist Code Bits Distance Code Bits Distance + ---- ---- ---- ---- ---- ------ ---- ---- -------- ---- ---- -------- + 0 0 1 8 3 17-24 16 7 257-384 24 11 4097-6144 + 1 0 2 9 3 25-32 17 7 385-512 25 11 6145-8192 + 2 0 3 10 4 33-48 18 8 513-768 26 12 8193-12288 + 3 0 4 11 4 49-64 19 8 769-1024 27 12 12289-16384 + 4 1 5,6 12 5 65-96 20 9 1025-1536 28 13 16385-24576 + 5 1 7,8 13 5 97-128 21 9 1537-2048 29 13 24577-32768 + 6 2 9-12 14 6 129-192 22 10 2049-3072 + 7 2 13-16 15 6 193-256 23 10 3073-4096 + +The compressed data stream begins immediately after the +compressed header data. The compressed data stream can be +interpreted as follows: + +do + read header from input stream. + + if stored block + skip bits until byte aligned + read count and 1's compliment of count + copy count bytes data block + otherwise + loop until end of block code sent + decode literal character from input stream + if literal < 256 + copy character to the output stream + otherwise + if literal = end of block + break from loop + otherwise + decode distance from input stream + + move backwards distance bytes in the output stream, and + copy length characters from this position to the output + stream. + end loop +while not last block + +if data descriptor exists + skip bits until byte aligned + check data descriptor signature + read crc and sizes +endif + +Decryption +---------- + +The encryption used in PKZIP was generously supplied by Roger +Schlafly. PKWARE is grateful to Mr. Schlafly for his expert +help and advice in the field of data encryption. + +PKZIP encrypts the compressed data stream. Encrypted files must +be decrypted before they can be extracted. + +Each encrypted file has an extra 12 bytes stored at the start of +the data area defining the encryption header for that file. The +encryption header is originally set to random values, and then +itself encrypted, using three, 32-bit keys. The key values are +initialized using the supplied encryption password. After each byte +is encrypted, the keys are then updated using pseudo-random number +generation techniques in combination with the same CRC-32 algorithm +used in PKZIP and described elsewhere in this document. + +The following is the basic steps required to decrypt a file: + +1) Initialize the three 32-bit keys with the password. +2) Read and decrypt the 12-byte encryption header, further + initializing the encryption keys. +3) Read and decrypt the compressed data stream using the + encryption keys. + + +Step 1 - Initializing the encryption keys +----------------------------------------- + +Key(0) <- 305419896 +Key(1) <- 591751049 +Key(2) <- 878082192 + +loop for i <- 0 to length(password)-1 + update_keys(password(i)) +end loop + + +Where update_keys() is defined as: + + +update_keys(char): + Key(0) <- crc32(key(0),char) + Key(1) <- Key(1) + (Key(0) & 000000ffH) + Key(1) <- Key(1) * 134775813 + 1 + Key(2) <- crc32(key(2),key(1) >> 24) +end update_keys + + +Where crc32(old_crc,char) is a routine that given a CRC value and a +character, returns an updated CRC value after applying the CRC-32 +algorithm described elsewhere in this document. + + +Step 2 - Decrypting the encryption header +----------------------------------------- + +The purpose of this step is to further initialize the encryption +keys, based on random data, to render a plaintext attack on the +data ineffective. + + +Read the 12-byte encryption header into Buffer, in locations +Buffer(0) thru Buffer(11). + +loop for i <- 0 to 11 + C <- buffer(i) ^ decrypt_byte() + update_keys(C) + buffer(i) <- C +end loop + + +Where decrypt_byte() is defined as: + + +unsigned char decrypt_byte() + local unsigned short temp + temp <- Key(2) | 2 + decrypt_byte <- (temp * (temp ^ 1)) >> 8 +end decrypt_byte + + +After the header is decrypted, the last 1 or 2 bytes in Buffer +should be the high-order word/byte of the CRC for the file being +decrypted, stored in Intel low-byte/high-byte order, or the high-order +byte of the file time if bit 3 of the general purpose bit flag is set. +Versions of PKZIP prior to 2.0 used a 2 byte CRC check; a 1 byte CRC check is +used on versions after 2.0. This can be used to test if the password +supplied is correct or not. + + +Step 3 - Decrypting the compressed data stream +---------------------------------------------- + +The compressed data stream can be decrypted as follows: + + +loop until done + read a character into C + Temp <- C ^ decrypt_byte() + update_keys(temp) + output Temp +end loop + + +In addition to the above mentioned contributors to PKZIP and PKUNZIP, +I would like to extend special thanks to Robert Mahoney for suggesting +the extension .ZIP for this software. + + +References: + + Fiala, Edward R., and Greene, Daniel H., "Data compression with + finite windows", Communications of the ACM, Volume 32, Number 4, + April 1989, pages 490-505. + + Held, Gilbert, "Data Compression, Techniques and Applications, + Hardware and Software Considerations", + John Wiley & Sons, 1987. + + Huffman, D.A., "A method for the construction of minimum-redundancy + codes", Proceedings of the IRE, Volume 40, Number 9, September 1952, + pages 1098-1101. + + Nelson, Mark, "LZW Data Compression", Dr. Dobbs Journal, Volume 14, + Number 10, October 1989, pages 29-37. + + Nelson, Mark, "The Data Compression Book", M&T Books, 1991. + + Storer, James A., "Data Compression, Methods and Theory", + Computer Science Press, 1988 + + Welch, Terry, "A Technique for High-Performance Data Compression", + IEEE Computer, Volume 17, Number 6, June 1984, pages 8-19. + + Ziv, J. and Lempel, A., "A universal algorithm for sequential data + compression", Communications of the ACM, Volume 30, Number 6, + June 1987, pages 520-540. + + Ziv, J. and Lempel, A., "Compression of individual sequences via + variable-rate coding", IEEE Transactions on Information Theory, + Volume 24, Number 5, September 1978, pages 530-536. diff --git a/lib/kernel/test/zlib_SUITE_data/zipdoc.1.gz b/lib/kernel/test/zlib_SUITE_data/zipdoc.1.gz Binary files differnew file mode 100644 index 0000000000..eb72160328 --- /dev/null +++ b/lib/kernel/test/zlib_SUITE_data/zipdoc.1.gz diff --git a/lib/kernel/test/zlib_SUITE_data/zipdoc.txt.gz b/lib/kernel/test/zlib_SUITE_data/zipdoc.txt.gz Binary files differnew file mode 100644 index 0000000000..23d2280be5 --- /dev/null +++ b/lib/kernel/test/zlib_SUITE_data/zipdoc.txt.gz diff --git a/lib/kernel/test/zlib_SUITE_data/zipdoc.zip b/lib/kernel/test/zlib_SUITE_data/zipdoc.zip Binary files differnew file mode 100644 index 0000000000..c471b311dd --- /dev/null +++ b/lib/kernel/test/zlib_SUITE_data/zipdoc.zip |