diff options
Diffstat (limited to 'lib')
168 files changed, 4279 insertions, 2275 deletions
diff --git a/lib/asn1/test/Makefile b/lib/asn1/test/Makefile index 4f3776e478..7ecd544d4b 100644 --- a/lib/asn1/test/Makefile +++ b/lib/asn1/test/Makefile @@ -194,7 +194,7 @@ release_tests_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/asn1_bin_v2_SUITE_data $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR) $(INSTALL_DATA) asn1.spec asn1.cover $(INSTALL_PROGS) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) cd asn1_SUITE_data; tar cfh $(RELSYSDIR)/asn1_SUITE_data.tar * cd $(RELSYSDIR)/asn1_SUITE_data; tar xf $(RELSYSDIR)/asn1_SUITE_data.tar cd $(RELSYSDIR)/asn1_bin_SUITE_data; tar xf $(RELSYSDIR)/asn1_SUITE_data.tar diff --git a/lib/common_test/doc/src/common_test_app.xml b/lib/common_test/doc/src/common_test_app.xml index 1ee73b890b..c92566de37 100644 --- a/lib/common_test/doc/src/common_test_app.xml +++ b/lib/common_test/doc/src/common_test_app.xml @@ -296,7 +296,7 @@ </func> <func> - <name>Module:init_per_testcase(TestCase, Config) -> NewConfig | {skip,Reason}</name> + <name>Module:init_per_testcase(TestCase, Config) -> NewConfig | {fail,Reason} | {skip,Reason}</name> <fsummary>Test case initialization.</fsummary> <type> <v> TestCase = atom()</v> @@ -311,10 +311,12 @@ <p>This function is called before each test case. The <c>TestCase</c> argument is the name of the test case, and - <c>Config</c> is the configuration which can be modified - here. Whatever is returned from this function is given as - <c>Config</c> to the test case. If <c>{skip,Reason}</c> is returned, - the test case will be skipped and <c>Reason</c> printed + <c>Config</c> (list of key-value tuples) is the configuration + data that can be modified here. The <c>NewConfig</c> list returned + from this function is given as <c>Config</c> to the test case. + If <c>{fail,Reason}</c> is returned, the test case is + marked as failed without being executed. If <c>{skip,Reason}</c> is + returned, the test case will be skipped and <c>Reason</c> printed in the overview log for the suite.</p> </desc> </func> diff --git a/lib/common_test/doc/src/write_test_chapter.xml b/lib/common_test/doc/src/write_test_chapter.xml index 723492d8f3..3f9fdb7121 100644 --- a/lib/common_test/doc/src/write_test_chapter.xml +++ b/lib/common_test/doc/src/write_test_chapter.xml @@ -167,12 +167,16 @@ returning <c>{fail,Reason}</c>, nor will it be able to save data with <c>{save_config,Data}</c>.</p> - <p>If <c>init_per_testcase</c> crashes, the test case itself is skipped + <p>If <c>init_per_testcase</c> crashes, the test case itself gets skipped automatically (so called <em>auto skipped</em>). If <c>init_per_testcase</c> - returns a <c>skip</c> tuple, also then will the test case be skipped (so - called <em>user skipped</em>). In either event, the <c>end_per_testcase</c> is - never called. + returns a tuple <c>{skip,Reason}</c>, also then the test case gets skipped + (so called <em>user skipped</em>). It is also possible, by returning a tuple + <c>{fail,Reason}</c> from <c>init_per_testcase</c>, to mark the test case + as failed without actually executing it. </p> + <note><p>If <c>init_per_testcase</c> crashes, or returns <c>{skip,Reason}</c> + or <c>{fail,Reason}</c>, the <c>end_per_testcase</c> function is not called. + </p></note> <p>If it is determined during execution of <c>end_per_testcase</c> that the status of a successful test case should be changed to failed, diff --git a/lib/common_test/src/ct.erl b/lib/common_test/src/ct.erl index dfec2b7a67..66da3ef742 100644 --- a/lib/common_test/src/ct.erl +++ b/lib/common_test/src/ct.erl @@ -861,6 +861,7 @@ remove_config(Callback, Config) -> %%% %%% @doc <p>Use this function to set a new timetrap for the running test case.</p> timetrap(Time) -> + test_server:timetrap_cancel(), test_server:timetrap(Time). %%%----------------------------------------------------------------- diff --git a/lib/common_test/src/ct_framework.erl b/lib/common_test/src/ct_framework.erl index f3c23868cc..809616d8e3 100644 --- a/lib/common_test/src/ct_framework.erl +++ b/lib/common_test/src/ct_framework.erl @@ -24,7 +24,7 @@ -module(ct_framework). --export([init_tc/3, end_tc/4, get_suite/2, report/2, warn/1]). +-export([init_tc/3, end_tc/3, end_tc/4, get_suite/2, report/2, warn/1]). -export([error_notification/4]). -export([overview_html_header/1]). @@ -434,6 +434,9 @@ try_set_default(Name,Key,Info,Where) -> %%% %%% @doc Test server framework callback, called by the test_server %%% when a test case is finished. +end_tc(Mod, Fun, Args) -> + %% Have to keep end_tc/3 for backwards compatabilty issues + end_tc(Mod, Fun, Args, '$end_tc_dummy'). end_tc(?MODULE,error_in_suite,_, _) -> % bad start! ok; end_tc(Mod,Func,{TCPid,Result,[Args]}, Return) when is_pid(TCPid) -> @@ -490,9 +493,9 @@ end_tc(Mod,Func,TCPid,Result,Args,Return) -> case ct_hooks:end_tc( Mod, FuncSpec, Args, Result, Return) of '$ct_no_change' -> - {FinalResult = ok,Result}; - FinalResult -> - {FinalResult,FinalResult} + {ok,Result}; + FinalResult1 -> + {FinalResult1,FinalResult1} end, % send sync notification so that event handlers may print % in the log file before it gets closed @@ -734,7 +737,7 @@ get_suite(Mod, Group={conf,Props,_Init,TCs,_End}) -> %% (and only) test case so we can report Error properly [{?MODULE,error_in_suite,[[Error]]}]; [] -> - {error,{invalid_group_spec,Name}}; + []; ConfTests -> case lists:member(skipped, Props) of true -> @@ -764,23 +767,7 @@ get_suite(Mod, Name) -> find_groups(Mod, Name, TCs, GroupDefs) -> Found = find(Mod, Name, TCs, GroupDefs, [], GroupDefs, false), - Trimmed = trim(Found), - %% I cannot find a reason to why this function is called, - %% It deletes any group which is referenced in any other - %% group. i.e. - %% groups() -> - %% [{test, [], [testcase1]}, - %% {testcases, [], [{group, test}]}]. - %% Would be changed to - %% groups() -> - %% [{testcases, [], [testcase1]}]. - %% instead of what I believe is correct: - %% groups() -> - %% [{test, [], [testcase1]}, - %% {testcases, [], [testcase1]}]. - %% Have to double check with peppe - delete_subs(Trimmed, Trimmed), - Trimmed. + trim(Found). find(Mod, all, _TCs, [{Name,Props,Tests} | Gs], Known, Defs, _) when is_atom(Name), is_list(Props), is_list(Tests) -> @@ -1170,12 +1157,14 @@ error_in_suite(Config) -> %% if the group config functions are missing in the suite, %% use these instead ct_init_per_group(GroupName, Config) -> - ct_logs:log("WARNING", "init_per_group/2 for ~w missing in suite, using default.", + ct_logs:log("WARNING", "init_per_group/2 for ~w missing " + "in suite, using default.", [GroupName]), Config. ct_end_per_group(GroupName, _) -> - ct_logs:log("WARNING", "end_per_group/2 for ~w missing in suite, using default.", + ct_logs:log("WARNING", "end_per_group/2 for ~w missing " + "in suite, using default.", [GroupName]), ok. @@ -1184,6 +1173,13 @@ ct_end_per_group(GroupName, _) -> %%% @spec report(What,Data) -> ok report(What,Data) -> case What of + loginfo -> + %% logfiles and direcories have been created for a test and the + %% top level test index page needs to be refreshed + TestName = filename:basename(proplists:get_value(topdir, Data), ".logs"), + RunDir = proplists:get_value(rundir, Data), + ct_logs:make_all_suites_index({TestName,RunDir}), + ok; tests_start -> case ct_util:get_testdata(cover) of undefined -> diff --git a/lib/common_test/src/ct_hooks.erl b/lib/common_test/src/ct_hooks.erl index 5eddefffce..984e04b90f 100644 --- a/lib/common_test/src/ct_hooks.erl +++ b/lib/common_test/src/ct_hooks.erl @@ -122,11 +122,11 @@ end_tc(_Mod, TC, Config, Result, _Return) -> call(fun call_generic/3, Result, [post_end_per_testcase, TC, Config], '$ct_no_change'). -on_tc_skip(How, {_Suite, Case, Reason}) -> - call(fun call_cleanup/3, {How, Reason}, [on_tc_skip, Case]). +on_tc_skip(How, {Suite, Case, Reason}) -> + call(fun call_cleanup/3, {How, Reason}, [on_tc_skip, Suite, Case]). -on_tc_fail(_How, {_Suite, Case, Reason}) -> - call(fun call_cleanup/3, Reason, [on_tc_fail, Case]). +on_tc_fail(_How, {Suite, Case, Reason}) -> + call(fun call_cleanup/3, Reason, [on_tc_fail, Suite, Case]). %% ------------------------------------------------------------------------- %% Internal Functions @@ -145,7 +145,7 @@ call_terminate({Mod, State}, _, _) -> catch_apply(Mod,terminate,[State], ok), {[],{Mod,State}}. -call_cleanup({Mod, State}, Reason, [Function | Args]) -> +call_cleanup({Mod, State}, Reason, [Function, _Suite | Args]) -> NewState = catch_apply(Mod,Function, Args ++ [Reason, State], State), {Reason, {Mod, NewState}}. @@ -229,6 +229,11 @@ scope([post_init_per_suite, SuiteName|_]) -> scope(init) -> none. +terminate_if_scope_ends(HookId, [on_tc_skip,_Suite,{end_per_group,Name}], + Hooks) -> + terminate_if_scope_ends(HookId, [post_end_per_group, Name], Hooks); +terminate_if_scope_ends(HookId, [on_tc_skip,Suite,end_per_suite], Hooks) -> + terminate_if_scope_ends(HookId, [post_end_per_suite, Suite], Hooks); terminate_if_scope_ends(HookId, [Function,Tag|T], Hooks) when T =/= [] -> terminate_if_scope_ends(HookId,[Function,Tag],Hooks); terminate_if_scope_ends(HookId, Function, Hooks) -> diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl index f8ace73cbf..ba4adb8683 100644 --- a/lib/common_test/src/ct_logs.erl +++ b/lib/common_test/src/ct_logs.erl @@ -97,11 +97,11 @@ logdir_node_prefix() -> logdir_prefix()++"."++atom_to_list(node()). %%%----------------------------------------------------------------- -%%% @spec close(How) -> ok +%%% @spec close(Info) -> ok %%% %%% @doc Create index pages with test results and close the CT Log %%% (tool-internal use only). -close(How) -> +close(Info) -> make_last_run_index(), ct_event:notify(#event{name=stop_logging,node=node(),data=[]}), @@ -118,7 +118,7 @@ close(How) -> ok end, - if How == clean -> + if Info == clean -> case cleanup() of ok -> ok; @@ -427,8 +427,8 @@ logger(Parent,Mode) -> file:make_dir(Dir), ct_event:notify(#event{name=start_logging,node=node(), data=?abs(Dir)}), - make_all_suites_index(start), make_all_runs_index(start), + make_all_suites_index(start), case Mode of interactive -> interactive_link(); _ -> ok @@ -796,24 +796,29 @@ make_one_index_entry(SuiteName, LogDir, Label, All, Missing) -> {Succ,Fail,UserSkip,AutoSkip} -> NotBuilt = not_built(SuiteName, LogDir, All, Missing), NewResult = make_one_index_entry1(SuiteName, LogDir, Label, Succ, Fail, - UserSkip, AutoSkip, NotBuilt, All), + UserSkip, AutoSkip, NotBuilt, All, + normal), {NewResult,Succ,Fail,UserSkip,AutoSkip,NotBuilt}; error -> error end. make_one_index_entry1(SuiteName, Link, Label, Success, Fail, UserSkip, AutoSkip, - NotBuilt, All) -> + NotBuilt, All, Mode) -> LogFile = filename:join(Link, ?suitelog_name ++ ".html"), - CrashDumpName = SuiteName ++ "_erl_crash.dump", - CrashDumpLink = - case filelib:is_file(CrashDumpName) of - true -> - [" <A HREF=\"", CrashDumpName, - "\">(CrashDump)</A>"]; - false -> - "" - end, + CrashDumpLink = case Mode of + cached -> + ""; + normal -> + CrashDumpName = SuiteName ++ "_erl_crash.dump", + case filelib:is_file(CrashDumpName) of + true -> + [" <A HREF=\"", CrashDumpName, + "\">(CrashDump)</A>"]; + false -> + "" + end + end, {Lbl,Timestamp,Node,AllInfo} = case All of {true,OldRuns} -> @@ -975,9 +980,13 @@ index_header(Label, StartTime) -> "<th>Missing<br>Suites</th>\n" "\n"]]. + all_suites_index_header() -> {ok,Cwd} = file:get_cwd(), - LogDir = filename:basename(Cwd), + all_suites_index_header(Cwd). + +all_suites_index_header(IndexDir) -> + LogDir = filename:basename(IndexDir), AllRuns = "All test runs in \"" ++ LogDir ++ "\"", [header("Test Results") | ["<CENTER>\n", @@ -1414,15 +1423,72 @@ timestamp(Dir) -> [S,Min,H,D,M,Y] = [list_to_integer(N) || N <- lists:sublist(TsR,6)], format_time({{Y,M,D},{H,Min,S}}). -make_all_suites_index(When) -> +%% ----------------------------- NOTE -------------------------------------- +%% The top level index file is generated based on the file contents under +%% logdir. This takes place initially when the test run starts (When = start) +%% and an update takes place at the end of the test run, or when the user +%% requests an explicit refresh (When = refresh). +%% The index file needs to be updated also at the start of each individual +%% test (in order for the user to be able to track test progress by refreshing +%% the browser). Since it would be too expensive to generate a new file from +%% scratch every time (by reading the data from disk), a copy of the dir tree +%% is cached as a result of the first index file creation. This copy is then +%% used for all top level index page updates that occur during the test run. +%% This means that any changes to the dir tree under logdir during the test +%% run will not show until after the final refresh. +%% ------------------------------------------------------------------------- + +%% Creates the top level index file. When == start | refresh. +%% A copy of the dir tree under logdir is cached as a result. +make_all_suites_index(When) when is_atom(When) -> AbsIndexName = ?abs(?index_name), notify_and_lock_file(AbsIndexName), LogDirs = filelib:wildcard(logdir_prefix()++".*/*"++?logdir_ext), - Sorted = sort_logdirs(LogDirs,[]), - Result = make_all_suites_index1(When,Sorted), + Sorted = sort_logdirs(LogDirs, []), + Result = make_all_suites_index1(When, AbsIndexName, Sorted), notify_and_unlock_file(AbsIndexName), - Result. - + Result; + +%% This updates the top level index file using cached data from +%% the initial index file creation. +make_all_suites_index(NewTestData = {_TestName,DirName}) -> + %% AllLogDirs = [{TestName,Label,Missing,{LastLogDir,Summary},OldDirs}|...] + {AbsIndexName,LogDirData} = ct_util:get_testdata(test_index), + + CtRunDirPos = length(filename:split(AbsIndexName)), + CtRunDir = filename:join(lists:sublist(filename:split(DirName), + CtRunDirPos)), + + Label = case read_totals_file(filename:join(CtRunDir, ?totals_name)) of + {_,"-",_,_} -> "..."; + {_,Lbl,_,_} -> Lbl; + _ -> "..." + end, + notify_and_lock_file(AbsIndexName), + Result = + case catch make_all_suites_ix_cached(AbsIndexName, + NewTestData, + Label, + LogDirData) of + {'EXIT',Reason} -> + io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"), + io:format("~p~n", [Reason]), + {error,Reason}; + {error,Reason} -> + io:put_chars("FAILED while updating " ++ AbsIndexName ++ "\n"), + io:format("~p~n", [Reason]), + {error,Reason}; + ok -> + ok; + Err -> + io:format("Unknown internal error while updating ~s. " + "Please report.\n(Err: ~p, ID: 1)", + [AbsIndexName,Err]), + {error, Err} + end, + notify_and_unlock_file(AbsIndexName), + Result. + sort_logdirs([Dir|Dirs],Groups) -> TestName = filename:rootname(filename:basename(Dir)), case filelib:wildcard(filename:join(Dir,"run.*")) of @@ -1448,13 +1514,12 @@ sort_each_group([{Test,IxDirs}|Groups]) -> sort_each_group([]) -> []. -make_all_suites_index1(When,AllSuitesLogDirs) -> +make_all_suites_index1(When, AbsIndexName, AllLogDirs) -> IndexName = ?index_name, - AbsIndexName = ?abs(IndexName), if When == start -> ok; true -> io:put_chars("Updating " ++ AbsIndexName ++ "... ") end, - case catch make_all_suites_index2(IndexName,AllSuitesLogDirs) of + case catch make_all_suites_index2(IndexName, AllLogDirs) of {'EXIT', Reason} -> io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"), io:format("~p~n", [Reason]), @@ -1463,11 +1528,16 @@ make_all_suites_index1(When,AllSuitesLogDirs) -> io:put_chars("FAILED while updating " ++ AbsIndexName ++ "\n"), io:format("~p~n", [Reason]), {error, Reason}; - ok -> - if When == start -> ok; - true -> io:put_chars("done\n") - end, - ok; + {ok,CacheData} -> + case When of + start -> + ct_util:set_testdata_async({test_index,{AbsIndexName, + CacheData}}), + ok; + _ -> + io:put_chars("done\n"), + ok + end; Err -> io:format("Unknown internal error while updating ~s. " "Please report.\n(Err: ~p, ID: 1)", @@ -1475,56 +1545,124 @@ make_all_suites_index1(When,AllSuitesLogDirs) -> {error, Err} end. -make_all_suites_index2(IndexName,AllSuitesLogDirs) -> - {ok,Index0,_Totals} = make_all_suites_index3(AllSuitesLogDirs, - all_suites_index_header(), - 0, 0, 0, 0, 0, []), +make_all_suites_index2(IndexName, AllTestLogDirs) -> + {ok,Index0,_Totals,CacheData} = + make_all_suites_index3(AllTestLogDirs, + all_suites_index_header(), + 0, 0, 0, 0, 0, [], []), Index = [Index0|index_footer()], case force_write_file(IndexName, Index) of ok -> - ok; + {ok,CacheData}; {error, Reason} -> {error,{index_write_error, Reason}} end. -make_all_suites_index3([{SuiteName,[LastLogDir|OldDirs]}|Rest], +make_all_suites_index3([{TestName,[LastLogDir|OldDirs]}|Rest], Result, TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt, - Labels) -> + Labels, CacheData) -> [EntryDir|_] = filename:split(LastLogDir), Missing = - case file:read_file(filename:join(EntryDir,?missing_suites_info)) of + case file:read_file(filename:join(EntryDir, ?missing_suites_info)) of {ok,Bin} -> binary_to_term(Bin); _ -> [] end, {Label,Labels1} = case proplists:get_value(EntryDir, Labels) of undefined -> - case read_totals_file(filename:join(EntryDir,?totals_name)) of + case read_totals_file(filename:join(EntryDir, ?totals_name)) of {_,Lbl,_,_} -> {Lbl,[{EntryDir,Lbl}|Labels]}; _ -> {"-",[{EntryDir,"-"}|Labels]} end; Lbl -> {Lbl,Labels} end, - case make_one_index_entry(SuiteName, LastLogDir, Label, {true,OldDirs}, Missing) of + case make_one_index_entry(TestName, LastLogDir, Label, {true,OldDirs}, Missing) of {Result1,Succ,Fail,USkip,ASkip,NotBuilt} -> %% for backwards compatibility AutoSkip1 = case catch AutoSkip+ASkip of {'EXIT',_} -> undefined; Res -> Res end, + IxEntry = {TestName,Label,Missing, + {LastLogDir,{Succ,Fail,USkip,ASkip}},OldDirs}, make_all_suites_index3(Rest, [Result|Result1], TotSucc+Succ, TotFail+Fail, UserSkip+USkip, AutoSkip1, - TotNotBuilt+NotBuilt,Labels1); + TotNotBuilt+NotBuilt, Labels1, + [IxEntry|CacheData]); error -> + IxEntry = {TestName,Label,Missing,{LastLogDir,error},OldDirs}, make_all_suites_index3(Rest, Result, TotSucc, TotFail, - UserSkip, AutoSkip, TotNotBuilt,Labels1) + UserSkip, AutoSkip, TotNotBuilt, Labels1, + [IxEntry|CacheData]) end; make_all_suites_index3([], Result, TotSucc, TotFail, UserSkip, AutoSkip, - TotNotBuilt,_) -> + TotNotBuilt, _, CacheData) -> {ok, [Result|total_row(TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt,true)], - {TotSucc,TotFail,UserSkip,AutoSkip,TotNotBuilt}}. + {TotSucc,TotFail,UserSkip,AutoSkip,TotNotBuilt}, lists:reverse(CacheData)}. + + +make_all_suites_ix_cached(AbsIndexName, NewTestData, Label, AllTestLogDirs) -> + AllTestLogDirs1 = insert_new_test_data(NewTestData, Label, AllTestLogDirs), + IndexDir = filename:dirname(AbsIndexName), + Index0 = make_all_suites_ix_cached1(AllTestLogDirs1, + all_suites_index_header(IndexDir), + 0, 0, 0, 0, 0), + Index = [Index0|index_footer()], + case force_write_file(AbsIndexName, Index) of + ok -> + ok; + {error, Reason} -> + {error,{index_write_error, Reason}} + end. + +insert_new_test_data({NewTestName,NewTestDir}, NewLabel, AllTestLogDirs) -> + AllTestLogDirs1 = + case lists:keysearch(NewTestName, 1, AllTestLogDirs) of + {value,{_,_,_,{LastLogDir,_},OldDirs}} -> + [{NewTestName,NewLabel,[],{NewTestDir,{0,0,0,0}}, + [LastLogDir|OldDirs]} | + lists:keydelete(NewTestName, 1, AllTestLogDirs)]; + false -> + [{NewTestName,NewLabel,[],{NewTestDir,{0,0,0,0}},[]} | + AllTestLogDirs] + end, + lists:keysort(1, AllTestLogDirs1). + +make_all_suites_ix_cached1([{TestName,Label,Missing,LastLogDirData,OldDirs}|Rest], + Result, TotSucc, TotFail, UserSkip, AutoSkip, + TotNotBuilt) -> + case make_one_ix_entry_cached(TestName, LastLogDirData, + Label, {true,OldDirs}, Missing) of + {Result1,Succ,Fail,USkip,ASkip,NotBuilt} -> + %% for backwards compatibility + AutoSkip1 = case catch AutoSkip+ASkip of + {'EXIT',_} -> undefined; + Res -> Res + end, + make_all_suites_ix_cached1(Rest, [Result|Result1], TotSucc+Succ, + TotFail+Fail, UserSkip+USkip, AutoSkip1, + TotNotBuilt+NotBuilt); + error -> + make_all_suites_ix_cached1(Rest, Result, TotSucc, TotFail, + UserSkip, AutoSkip, TotNotBuilt) + end; +make_all_suites_ix_cached1([], Result, TotSucc, TotFail, UserSkip, AutoSkip, + TotNotBuilt) -> + [Result|total_row(TotSucc, TotFail, UserSkip, AutoSkip, TotNotBuilt, true)]. + +make_one_ix_entry_cached(TestName, {LogDir,Summary}, Label, All, Missing) -> + case Summary of + {Succ,Fail,UserSkip,AutoSkip} -> + NotBuilt = not_built(TestName, LogDir, All, Missing), + NewResult = make_one_index_entry1(TestName, LogDir, Label, + Succ, Fail, UserSkip, AutoSkip, + NotBuilt, All, cached), + {NewResult,Succ,Fail,UserSkip,AutoSkip,NotBuilt}; + error -> + error + end. %%----------------------------------------------------------------- %% Remove log files. diff --git a/lib/common_test/src/ct_run.erl b/lib/common_test/src/ct_run.erl index 7bd7dc7d66..c01e97b358 100644 --- a/lib/common_test/src/ct_run.erl +++ b/lib/common_test/src/ct_run.erl @@ -262,15 +262,15 @@ run_or_refresh(StartOpts = #opts{logdir = LogDir}, Args) -> %% give the shell time to print version etc timer:sleep(500), io:nl(), - case catch ct_logs:make_all_suites_index(refresh) of - {'EXIT',ASReason} -> + case catch ct_logs:make_all_runs_index(refresh) of + {'EXIT',ARReason} -> file:set_cwd(Cwd), - {error,{all_suites_index,ASReason}}; + {error,{all_runs_index,ARReason}}; _ -> - case catch ct_logs:make_all_runs_index(refresh) of - {'EXIT',ARReason} -> + case catch ct_logs:make_all_suites_index(refresh) of + {'EXIT',ASReason} -> file:set_cwd(Cwd), - {error,{all_runs_index,ARReason}}; + {error,{all_suites_index,ASReason}}; _ -> file:set_cwd(Cwd), io:format("Logs in ~s refreshed!~n~n", [LogDir1]), @@ -1111,6 +1111,8 @@ run(TestDirs) -> install([]), reformat_result(catch do_run(tests(TestDirs), [])). +reformat_result({'EXIT',{user_error,Reason}}) -> + {error,Reason}; reformat_result({user_error,Reason}) -> {error,Reason}; reformat_result(Result) -> diff --git a/lib/common_test/src/ct_util.erl b/lib/common_test/src/ct_util.erl index 115207beed..b3e345b4e5 100644 --- a/lib/common_test/src/ct_util.erl +++ b/lib/common_test/src/ct_util.erl @@ -37,7 +37,7 @@ read_suite_data/1, delete_suite_data/0, delete_suite_data/1, match_delete_suite_data/1, delete_testdata/0, delete_testdata/1, set_testdata/1, get_testdata/1, - update_testdata/2]). + set_testdata_async/1, update_testdata/2]). -export([override_silence_all_connections/0, override_silence_connections/1, get_overridden_silenced_connections/0, @@ -96,7 +96,8 @@ start(Mode,LogDir) -> Pid = spawn_link(fun() -> do_start(S,Mode,LogDir) end), receive {Pid,started} -> Pid; - {Pid,Error} -> exit(Error) + {Pid,Error} -> exit(Error); + {_Ref,{Pid,Error}} -> exit(Error) end; Pid -> case get_mode() of @@ -162,21 +163,19 @@ do_start(Parent,Mode,LogDir) -> end, {StartTime,TestLogDir} = ct_logs:init(Mode), - %% Initiate ct_hooks + ct_event:notify(#event{name=test_start, + node=node(), + data={StartTime, + lists:flatten(TestLogDir)}}), + %% Initialize ct_hooks case catch ct_hooks:init(Opts) of ok -> - ok; + Parent ! {self(),started}; {_,CTHReason} -> ct_logs:tc_print('Suite Callback',CTHReason,[]), - Parent ! {self(), CTHReason}, - self() ! {{stop,normal},{self(),make_ref()}} + self() ! {{stop,{self(),{user_error,CTHReason}}}, + {Parent,make_ref()}} end, - - ct_event:notify(#event{name=test_start, - node=node(), - data={StartTime, - lists:flatten(TestLogDir)}}), - Parent ! {self(),started}, loop(Mode,[],StartDir). create_table(TableName,KeyPos) -> @@ -232,6 +231,9 @@ update_testdata(Key, Fun) -> set_testdata(TestData) -> call({set_testdata, TestData}). +set_testdata_async(TestData) -> + cast({set_testdata, TestData}). + get_testdata(Key) -> call({get_testdata, Key}). @@ -317,7 +319,7 @@ loop(Mode,TestData,StartDir) -> {reset_cwd,From} -> return(From,file:set_cwd(StartDir)), loop(From,TestData,StartDir); - {{stop,How},From} -> + {{stop,Info},From} -> Time = calendar:local_time(), ct_event:sync_notify(#event{name=test_done, node=node(), @@ -330,11 +332,11 @@ loop(Mode,TestData,StartDir) -> ets:delete(?conn_table), ets:delete(?board_table), ets:delete(?suite_table), - ct_logs:close(How), + ct_logs:close(Info), ct_event:stop(), ct_config:stop(), file:set_cwd(StartDir), - return(From,ok); + return(From, Info); {Ref, _Msg} when is_reference(Ref) -> %% This clause is used when doing cast operations. loop(Mode,TestData,StartDir); @@ -537,16 +539,16 @@ reset_silent_connections() -> %%%----------------------------------------------------------------- -%%% @spec stop(How) -> ok +%%% @spec stop(Info) -> ok %%% %%% @doc Stop the ct_util_server and close all existing connections %%% (tool-internal use only). %%% %%% @see ct -stop(How) -> +stop(Info) -> case whereis(ct_util_server) of undefined -> ok; - _ -> call({stop,How}) + _ -> call({stop,Info}) end. %%%----------------------------------------------------------------- diff --git a/lib/common_test/src/vts.erl b/lib/common_test/src/vts.erl index 2ee982d726..081f98e889 100644 --- a/lib/common_test/src/vts.erl +++ b/lib/common_test/src/vts.erl @@ -281,9 +281,7 @@ run_test1(State=#state{tests=Tests,current_log_dir=LogDir}) -> end, unlink(Self) end, - Pid = spawn_link(RunTest), - Total = receive {{test_info,start_info,{_,_,Cases}},From} -> @@ -480,7 +478,7 @@ create_testdir_entries([],_N) -> []. testdir_entry(Dir,Suite,Case,N) -> - NStr = integer_to_list(N), + NStr = vts_integer_to_list(N), tr([td(delete_button(NStr)), td(Dir), td(suite_select(Dir,Suite,NStr)), @@ -691,11 +689,11 @@ result_summary_frame1(State) -> result_summary_body(State) -> N = State#state.ok + State#state.fail + State#state.skip, [h2("Result Summary"), - p([b(integer_to_list(N))," cases executed (of ", - b(integer_to_list(State#state.total)),")"]), - p([green([b(integer_to_list(State#state.ok))," successful"]),br(), - red([b(integer_to_list(State#state.fail))," failed"]),br(), - orange([b(integer_to_list(State#state.skip))," skipped"])]), + p([b(vts_integer_to_list(N))," cases executed (of ", + b(vts_integer_to_list(State#state.total)),")"]), + p([green([b(vts_integer_to_list(State#state.ok))," successful"]),br(), + red([b(vts_integer_to_list(State#state.fail))," failed"]),br(), + orange([b(vts_integer_to_list(State#state.skip))," skipped"])]), executed_test_list(State)]. executed_test_list(#state{testruns=[]}) -> @@ -735,6 +733,14 @@ report1(tc_done,{_Suite,init_per_suite,_},State) -> State; report1(tc_done,{_Suite,end_per_suite,_},State) -> State; +report1(tc_done,{_Suite,init_per_group,_},State) -> + State; +report1(tc_done,{_Suite,end_per_group,_},State) -> + State; +report1(tc_done,{_Suite,ct_init_per_group,_},State) -> + State; +report1(tc_done,{_Suite,ct_end_per_group,_},State) -> + State; report1(tc_done,{_Suite,_Case,ok},State) -> State#state{ok=State#state.ok+1}; report1(tc_done,{_Suite,_Case,{failed,_Reason}},State) -> @@ -742,7 +748,9 @@ report1(tc_done,{_Suite,_Case,{failed,_Reason}},State) -> report1(tc_done,{_Suite,_Case,{skipped,_Reason}},State) -> State#state{skip=State#state.skip+1}; report1(tc_user_skip,{_Suite,_Case,_Reason},State) -> - State#state{skip=State#state.skip+1}. + State#state{skip=State#state.skip+1}; +report1(loginfo,_,State) -> + State. get_test_log(TestName,LogDir) -> [Log] = @@ -882,3 +890,7 @@ get_input_data(Input,Key)-> parse(Input) -> httpd:parse_query(Input). +vts_integer_to_list(X) when is_atom(X) -> + atom_to_list(X); +vts_integer_to_list(X) when is_integer(X) -> + integer_to_list(X). diff --git a/lib/common_test/test/Makefile b/lib/common_test/test/Makefile index 115565aaa0..b7b099069c 100644 --- a/lib/common_test/test/Makefile +++ b/lib/common_test/test/Makefile @@ -96,7 +96,7 @@ release_tests_spec: $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(ERL_FILES) $(COVERFILE) $(RELSYSDIR) $(INSTALL_DATA) common_test.spec $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/common_test/test/ct_config_SUITE.erl b/lib/common_test/test/ct_config_SUITE.erl index b6b50f33e0..8ce75f582a 100644 --- a/lib/common_test/test/ct_config_SUITE.erl +++ b/lib/common_test/test/ct_config_SUITE.erl @@ -174,7 +174,8 @@ run_test(Name, Config, CTConfig, SuiteNames)-> TestEvents = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(Name, reformat_events(TestEvents, ?eh), - ?config(config_dir, Config)), + ?config(config_dir, Config), + Opts), ExpEvents = events_to_check(Name), ok = ct_test_support:verify_events(ExpEvents, TestEvents, Config). diff --git a/lib/common_test/test/ct_error_SUITE.erl b/lib/common_test/test/ct_error_SUITE.erl index ad6cf1ba8f..6867e59b60 100644 --- a/lib/common_test/test/ct_error_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE.erl @@ -102,8 +102,9 @@ cfg_error(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(cfg_error, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(cfg_error), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -120,8 +121,9 @@ lib_error(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(lib_error, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(lib_error), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -138,8 +140,9 @@ no_compile(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(no_compile, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(no_compile), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -156,7 +159,8 @@ timetrap_end_conf(Config) when is_list(Config) -> ct_test_support:log_events(timetrap_end_conf, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(timetrap_end_conf), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -176,7 +180,8 @@ timetrap_normal(Config) when is_list(Config) -> ct_test_support:log_events(timetrap_normal, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(timetrap_normal), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -198,12 +203,31 @@ timetrap_extended(Config) when is_list(Config) -> ct_test_support:log_events(timetrap_extended, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(timetrap_extended), ok = ct_test_support:verify_events(TestEvents, Events, Config). %%%----------------------------------------------------------------- +%%% +timetrap_parallel(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + Join = fun(D, S) -> filename:join(D, "error/test/"++S) end, + Suite = Join(DataDir, "timetrap_3_SUITE"), + {Opts,ERPid} = setup([{suite,Suite}], Config), + ok = ct_test_support:run(Opts, Config), + Events = ct_test_support:get_events(ERPid, Config), + + ct_test_support:log_events(timetrap_parallel, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + + TestEvents = events_to_check(timetrap_parallel), + ok = ct_test_support:verify_events(TestEvents, Events, Config). + +%%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -236,7 +260,7 @@ test_events(cfg_error) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - {?eh,start_info,{14,14,42}}, + {?eh,start_info,{14,14,43}}, {?eh,tc_start,{cfg_error_1_SUITE,init_per_suite}}, {?eh,tc_done, @@ -405,7 +429,6 @@ test_events(cfg_error) -> {cfg_error_8_SUITE,{init_per_group,g3,[]}, {failed,{error,{{badmatch,42}, [{cfg_error_8_SUITE,init_per_group,2}, - {cfg_error_8_SUITE,init_per_group,2}, {test_server,my_apply,3}, {test_server,ts_tc,3}, {test_server,run_test_case_eval1,6}, @@ -415,7 +438,6 @@ test_events(cfg_error) -> {failed,{cfg_error_8_SUITE,init_per_group, {'EXIT',{{badmatch,42}, [{cfg_error_8_SUITE,init_per_group,2}, - {cfg_error_8_SUITE,init_per_group,2}, {test_server,my_apply,3}, {test_server,ts_tc,3}, {test_server,run_test_case_eval1,6}, @@ -426,7 +448,6 @@ test_events(cfg_error) -> {failed,{cfg_error_8_SUITE,init_per_group, {'EXIT',{{badmatch,42}, [{cfg_error_8_SUITE,init_per_group,2}, - {cfg_error_8_SUITE,init_per_group,2}, {test_server,my_apply,3}, {test_server,ts_tc,3}, {test_server,run_test_case_eval1,6}, @@ -520,16 +541,19 @@ test_events(cfg_error) -> %%! end_tc failes the testcase {?eh,tc_done,{cfg_error_9_SUITE,tc6,ok}}, {?eh,test_stats,{9,2,{0,18}}}, + {?eh,tc_start,{cfg_error_9_SUITE,tc7}}, + {?eh,tc_done,{cfg_error_9_SUITE,tc7,{failed,{error,tc7_should_be_failed}}}}, + {ct_test_support_eh,test_stats,{9,3,{0,18}}}, {?eh,tc_start,{cfg_error_9_SUITE,tc11}}, {?eh,tc_done,{cfg_error_9_SUITE,tc11, {failed,{cfg_error_9_SUITE,end_per_testcase, {'EXIT',warning_should_be_printed}}}}}, - {?eh,test_stats,{10,2,{0,18}}}, + {?eh,test_stats,{10,3,{0,18}}}, {?eh,tc_start,{cfg_error_9_SUITE,tc12}}, {?eh,tc_done,{cfg_error_9_SUITE,tc12, {failed,{cfg_error_9_SUITE,end_per_testcase, {timetrap_timeout,2000}}}}}, - {?eh,test_stats,{11,2,{0,18}}}, + {?eh,test_stats,{11,3,{0,18}}}, {?eh,tc_start,{cfg_error_9_SUITE,tc13}}, {?eh,tc_done,{cfg_error_9_SUITE,tc13, {failed,{cfg_error_9_SUITE,end_per_testcase, @@ -539,11 +563,11 @@ test_events(cfg_error) -> {test_server,do_end_per_testcase,4}, {test_server,run_test_case_eval1,6}, {test_server,run_test_case_eval,8}]}}}}}}, - {?eh,test_stats,{12,2,{0,18}}}, + {?eh,test_stats,{12,3,{0,18}}}, {?eh,tc_start,{cfg_error_9_SUITE,tc14}}, {?eh,tc_done, {cfg_error_9_SUITE,tc14,{failed,{error,tc14_should_be_failed}}}}, - {?eh,test_stats,{12,3,{0,18}}}, + {?eh,test_stats,{12,4,{0,18}}}, {?eh,tc_start,{cfg_error_9_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_9_SUITE,end_per_suite,ok}}, @@ -554,7 +578,7 @@ test_events(cfg_error) -> {?eh,tc_auto_skip,{cfg_error_10_SUITE,tc1, {failed,{cfg_error_10_SUITE,init_per_suite, {failed,fail_init_per_suite}}}}}, - {?eh,test_stats,{12,3,{0,19}}}, + {?eh,test_stats,{12,4,{0,19}}}, {?eh,tc_auto_skip,{cfg_error_10_SUITE,end_per_suite, {failed,{cfg_error_10_SUITE,init_per_suite, {failed,fail_init_per_suite}}}}}, @@ -563,40 +587,40 @@ test_events(cfg_error) -> {?eh,tc_start,{cfg_error_11_SUITE,tc1}}, {?eh,tc_done,{cfg_error_11_SUITE,tc1, {skipped,{config_name_already_in_use,[dummy0]}}}}, - {?eh,test_stats,{12,3,{1,19}}}, + {?eh,test_stats,{12,4,{1,19}}}, {?eh,tc_start,{cfg_error_11_SUITE,tc2}}, {?eh,tc_done,{cfg_error_11_SUITE,tc2,ok}}, - {?eh,test_stats,{13,3,{1,19}}}, + {?eh,test_stats,{13,4,{1,19}}}, {?eh,tc_start,{cfg_error_11_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_11_SUITE,end_per_suite,ok}}, {?eh,tc_start,{cfg_error_12_SUITE,tc1}}, {?eh,tc_done,{cfg_error_12_SUITE,tc1,{failed,{timetrap_timeout,500}}}}, - {?eh,test_stats,{13,4,{1,19}}}, + {?eh,test_stats,{13,5,{1,19}}}, {?eh,tc_start,{cfg_error_12_SUITE,tc2}}, {?eh,tc_done,{cfg_error_12_SUITE,tc2,{failed, {cfg_error_12_SUITE,end_per_testcase, {timetrap_timeout,500}}}}}, - {?eh,test_stats,{14,4,{1,19}}}, + {?eh,test_stats,{14,5,{1,19}}}, {?eh,tc_start,{cfg_error_12_SUITE,tc3}}, {?eh,tc_done,{cfg_error_12_SUITE,tc3,ok}}, - {?eh,test_stats,{15,4,{1,19}}}, + {?eh,test_stats,{15,5,{1,19}}}, {?eh,tc_start,{cfg_error_12_SUITE,tc4}}, {?eh,tc_done,{cfg_error_12_SUITE,tc4,{failed, {cfg_error_12_SUITE,end_per_testcase, {timetrap_timeout,500}}}}}, - {?eh,test_stats,{16,4,{1,19}}}, + {?eh,test_stats,{16,5,{1,19}}}, {?eh,tc_start,{cfg_error_13_SUITE,init_per_suite}}, {?eh,tc_done,{cfg_error_13_SUITE,init_per_suite,ok}}, {?eh,tc_start,{cfg_error_13_SUITE,tc1}}, {?eh,tc_done,{cfg_error_13_SUITE,tc1,ok}}, - {?eh,test_stats,{17,4,{1,19}}}, + {?eh,test_stats,{17,5,{1,19}}}, {?eh,tc_start,{cfg_error_13_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_13_SUITE,end_per_suite,ok}}, {?eh,tc_start,{cfg_error_14_SUITE,init_per_suite}}, {?eh,tc_done,{cfg_error_14_SUITE,init_per_suite,ok}}, {?eh,tc_start,{cfg_error_14_SUITE,tc1}}, {?eh,tc_done,{cfg_error_14_SUITE,tc1,ok}}, - {?eh,test_stats,{18,4,{1,19}}}, + {?eh,test_stats,{18,5,{1,19}}}, {?eh,tc_start,{cfg_error_14_SUITE,end_per_suite}}, {?eh,tc_done,{cfg_error_14_SUITE,end_per_suite, {comment, @@ -729,7 +753,7 @@ test_events(timetrap_normal) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - {?eh,start_info,{1,1,3}}, + {?eh,start_info,{1,1,4}}, {?eh,tc_start,{timetrap_2_SUITE,init_per_suite}}, {?eh,tc_done,{timetrap_2_SUITE,init_per_suite,ok}}, {?eh,tc_start,{timetrap_2_SUITE,tc0}}, @@ -744,6 +768,9 @@ test_events(timetrap_normal) -> {?eh,tc_done, {timetrap_2_SUITE,tc2,{failed,{timetrap_timeout,500}}}}, {?eh,test_stats,{0,3,{0,0}}}, + {?eh,tc_start,{timetrap_2_SUITE,tc3}}, + {?eh,tc_done,{timetrap_2_SUITE,tc3,ok}}, + {?eh,test_stats,{1,3,{0,0}}}, {?eh,tc_start,{timetrap_2_SUITE,end_per_suite}}, {?eh,tc_done,{timetrap_2_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, @@ -754,7 +781,7 @@ test_events(timetrap_extended) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - {?eh,start_info,{1,1,3}}, + {?eh,start_info,{1,1,4}}, {?eh,tc_start,{timetrap_2_SUITE,init_per_suite}}, {?eh,tc_done,{timetrap_2_SUITE,init_per_suite,ok}}, {?eh,tc_start,{timetrap_2_SUITE,tc0}}, @@ -769,8 +796,52 @@ test_events(timetrap_extended) -> {?eh,tc_done, {timetrap_2_SUITE,tc2,{failed,{timetrap_timeout,1000}}}}, {?eh,test_stats,{0,3,{0,0}}}, + {?eh,tc_start,{timetrap_2_SUITE,tc3}}, + {?eh,tc_done,{timetrap_2_SUITE,tc3,ok}}, + {?eh,test_stats,{1,3,{0,0}}}, {?eh,tc_start,{timetrap_2_SUITE,end_per_suite}}, {?eh,tc_done,{timetrap_2_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} - ]. + ]; + +test_events(timetrap_parallel) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,7}}, + {?eh,tc_done,{timetrap_3_SUITE,init_per_suite,ok}}, + {parallel, + [{?eh,tc_start, + {timetrap_3_SUITE,{init_per_group,g1,[parallel]}}}, + {?eh,tc_done, + {timetrap_3_SUITE,{init_per_group,g1,[parallel]},ok}}, + {?eh,tc_start,{timetrap_3_SUITE,tc0}}, + {?eh,tc_start,{timetrap_3_SUITE,tc1}}, + {?eh,tc_start,{timetrap_3_SUITE,tc2}}, + {?eh,tc_start,{timetrap_3_SUITE,tc3}}, + {?eh,tc_start,{timetrap_3_SUITE,tc4}}, + {?eh,tc_start,{timetrap_3_SUITE,tc6}}, + {?eh,tc_start,{timetrap_3_SUITE,tc7}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc1,{failed,{timetrap_timeout,500}}}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc2,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc6,{failed,{timetrap_timeout,1000}}}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc7,{failed,{timetrap_timeout,1500}}}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc0,{failed,{timetrap_timeout,2000}}}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc4,{failed,{timetrap_timeout,2000}}}}, + {?eh,tc_done, + {timetrap_3_SUITE,tc3,{failed,{timetrap_timeout,3000}}}}, + {?eh,test_stats,{0,7,{0,0}}}, + {?eh,tc_start, + {timetrap_3_SUITE,{end_per_group,g1,[parallel]}}}, + {?eh,tc_done, + {timetrap_3_SUITE,{end_per_group,g1,[parallel]},ok}}]}, + {?eh,tc_done,{timetrap_3_SUITE,end_per_suite,ok}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]}]. diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_9_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_9_SUITE.erl index d73287ad62..40b7d2da47 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_9_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/cfg_error_9_SUITE.erl @@ -83,6 +83,8 @@ init_per_testcase(tc3, Config) -> Config; init_per_testcase(tc4, _) -> ok; +init_per_testcase(tc7, _) -> + {fail,tc7_should_be_failed}; init_per_testcase(_, Config) -> Config. @@ -136,7 +138,7 @@ groups() -> %% Reason = term() %%-------------------------------------------------------------------- all() -> - [tc1,tc2,tc3,tc4,tc5,tc6, + [tc1,tc2,tc3,tc4,tc5,tc6,tc7, tc11,tc12,tc13,tc14]. tc1(_) -> @@ -171,6 +173,11 @@ tc6(_) -> ct:comment("This one should succeed but then get failed by end_tc!"), fini. +tc7(_) -> + ct:comment("This one should get failed by iptc!"), + fini. + + tc11(_) -> fini. tc12(_) -> diff --git a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl index 99bb400137..7fcb631d06 100644 --- a/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl +++ b/lib/common_test/test/ct_error_SUITE_data/error/test/timetrap_2_SUITE.erl @@ -77,8 +77,8 @@ init_per_testcase(tc1, Config) -> ct:timetrap({seconds,1}), Config; -init_per_testcase(tc3, Config) -> - ct:timetrap({seconds,1}), +init_per_testcase(tc2, Config) -> + ct:timetrap(250), Config; init_per_testcase(_TestCase, Config) -> @@ -90,7 +90,7 @@ init_per_testcase(_TestCase, Config) -> %% TestCase = atom() %% Config0 = Config1 = [tuple()] %%-------------------------------------------------------------------- -end_per_testcase(_, Config) -> +end_per_testcase(_, _Config) -> ok. %%-------------------------------------------------------------------- @@ -116,7 +116,7 @@ groups() -> %% Reason = term() %%-------------------------------------------------------------------- all() -> - [tc0,tc1,tc2]. + [tc0,tc1,tc2,tc3]. tc0(_) -> N = list_to_integer(ct:get_config(multiply)), @@ -131,8 +131,24 @@ tc1(_) -> ok. tc2(_) -> + ct:timetrap(500), N = list_to_integer(ct:get_config(multiply)), ct:comment(io_lib:format("TO after ~w sec", [0.5*N])), - ct:timetrap(500), ct:sleep(2000), ok. + +tc3() -> + [{timetrap,{seconds,2}}]. + +tc3(_) -> + T0 = now(), + ct:timetrap(infinity), + N = list_to_integer(ct:get_config(multiply)), + ct:comment(io_lib:format("Sleeping for ~w sec...", [4*N])), + ct:sleep(4000), + Diff = timer:now_diff(now(), T0), + if ((Diff < (N*4000000)) or (Diff > (N*4500000))) -> + exit(not_expected); + true -> + ok + end. diff --git a/lib/common_test/test/ct_event_handler_SUITE.erl b/lib/common_test/test/ct_event_handler_SUITE.erl index 5ef04c0e75..b534a7141d 100644 --- a/lib/common_test/test/ct_event_handler_SUITE.erl +++ b/lib/common_test/test/ct_event_handler_SUITE.erl @@ -102,8 +102,9 @@ start_stop(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(start_stop, - ct_test_support:reformat(Events, eh_A), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, eh_A), + ?config(priv_dir, Config), + Opts), TestEvents = [{eh_A,start_logging,{'DEF','RUNDIR'}}, @@ -148,8 +149,9 @@ results(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(results, - ct_test_support:reformat(Events, eh_A), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, eh_A), + ?config(priv_dir, Config), + Opts), TestEvents = [{eh_A,start_logging,{'DEF','RUNDIR'}}, diff --git a/lib/common_test/test/ct_groups_test_1_SUITE.erl b/lib/common_test/test/ct_groups_test_1_SUITE.erl index 7775d8a55d..e520a72227 100644 --- a/lib/common_test/test/ct_groups_test_1_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_1_SUITE.erl @@ -89,8 +89,9 @@ groups_suite_1(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(groups_suite_1, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(groups_suite_1), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -109,8 +110,9 @@ groups_suite_2(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(groups_suite_2, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(groups_suite_2), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -130,8 +132,9 @@ groups_suites_1(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(groups_suites_1, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(groups_suites_1), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -150,8 +153,9 @@ groups_dir_1(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(groups_dir_1, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(groups_dir_1), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -170,8 +174,9 @@ groups_dirs_1(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(groups_dirs_1, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(groups_dirs_1), ok = ct_test_support:verify_events(TestEvents, Events, Config). diff --git a/lib/common_test/test/ct_groups_test_2_SUITE.erl b/lib/common_test/test/ct_groups_test_2_SUITE.erl index 2ae63f4f99..f33be8a9d4 100644 --- a/lib/common_test/test/ct_groups_test_2_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_2_SUITE.erl @@ -59,7 +59,7 @@ end_per_testcase(TestCase, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [missing_conf, repeat_1]. + [missing_conf, repeat_1, empty_group]. groups() -> []. @@ -83,13 +83,14 @@ missing_conf(Config) when is_list(Config) -> Suite = filename:join(DataDir, "groups_1/missing_conf_SUITE"), - {Opts,ERPid} = setup({suite,Suite}, Config), + {Opts,ERPid} = setup([{suite,Suite}], Config), ok = ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(missing_conf_SUITE, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(missing_conf), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -102,18 +103,41 @@ repeat_1(Config) when is_list(Config) -> Suite = filename:join(DataDir, "groups_1/repeat_1_SUITE"), - {Opts,ERPid} = setup({suite,Suite}, Config), + {Opts,ERPid} = setup([{suite,Suite}], Config), ok = ct_test_support:run(Opts, Config), Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(repeat_1, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(repeat_1), ok = ct_test_support:verify_events(TestEvents, Events, Config). %%%----------------------------------------------------------------- +%%% + +empty_group(Config) when is_list(Config) -> + DataDir = ?config(data_dir, Config), + + Suite = filename:join(DataDir, "groups_2/groups_22_SUITE"), + + {Opts,ERPid} = setup([{suite,Suite}, + {group,[test_group_8,test_group_9,test_group_10]}], + Config), + ok = ct_test_support:run(Opts, Config), + Events = ct_test_support:get_events(ERPid, Config), + + ct_test_support:log_events(empty_group, + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), + + TestEvents = events_to_check(empty_group), + ok = ct_test_support:verify_events(TestEvents, Events, Config). + +%%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -121,7 +145,7 @@ setup(Test, Config) -> Opts0 = ct_test_support:get_opts(Config), Level = ?config(trace_level, Config), EvHArgs = [{cbm,ct_test_support},{trace_level,Level}], - Opts = Opts0 ++ [Test,{event_handler,{?eh,EvHArgs}}], + Opts = Opts0 ++ [{event_handler,{?eh,EvHArgs}} | Test], ERPid = ct_test_support:start_event_receiver(Config), {Opts,ERPid}. @@ -256,4 +280,27 @@ test_events(repeat_1) -> {?eh,tc_done,{repeat_1_SUITE,end_per_suite,ok}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]} + ]; + +test_events(empty_group) -> + [{?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,start_info,{1,1,1}}, + {?eh,tc_start,{groups_22_SUITE,init_per_suite}}, + {?eh,tc_done,{groups_22_SUITE,init_per_suite,ok}}, + [{?eh,tc_start, + {groups_22_SUITE,{init_per_group,test_group_8,[]}}}, + {?eh,tc_done, + {groups_22_SUITE,{init_per_group,test_group_8,[]},ok}}, + {?eh,tc_start,{groups_22_SUITE,testcase_8}}, + {?eh,tc_done,{groups_22_SUITE,testcase_8,ok}}, + {?eh,test_stats,{1,0,{0,0}}}, + {?eh,tc_start, + {groups_22_SUITE,{end_per_group,test_group_8,[]}}}, + {?eh,tc_done, + {groups_22_SUITE,{end_per_group,test_group_8,[]},ok}}], + {?eh,tc_start,{groups_22_SUITE,end_per_suite}}, + {?eh,tc_done,{groups_22_SUITE,end_per_suite,init}}, + {?eh,test_done,{'DEF','STOP_TIME'}}, + {?eh,stop_logging,[]} ]. diff --git a/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl b/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl index cd517876df..14eb8769ad 100644 --- a/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl +++ b/lib/common_test/test/ct_groups_test_2_SUITE_data/groups_2/groups_22_SUITE.erl @@ -31,27 +31,33 @@ suite() -> groups() -> [ - {test_group_1a, [shuffle], [testcase_1a,testcase_1b,testcase_1c]}, + {test_group_1a, [shuffle], [testcase_1a,testcase_1b,testcase_1c]}, - {test_group_1b, [parallel], [testcase_1a,testcase_1b]}, + {test_group_1b, [parallel], [testcase_1a,testcase_1b]}, - {test_group_2, [parallel], [testcase_2a, + {test_group_2, [parallel], [testcase_2a, - {test_group_3, [{repeat,1}], - [testcase_3a, testcase_3b]}, + {test_group_3, [{repeat,1}], + [testcase_3a, testcase_3b]}, - testcase_2b]}, + testcase_2b]}, - {test_group_4, [{test_group_5, [parallel], [testcase_5a, + {test_group_4, [{test_group_5, [parallel], [testcase_5a, - {group, test_group_6}, + {group, test_group_6}, - testcase_5b]}]}, + testcase_5b]}]}, - {test_group_6, [parallel], [{group, test_group_7}]}, + {test_group_6, [parallel], [{group, test_group_7}]}, - {test_group_7, [sequence], [testcase_7a,testcase_7b]} - ]. + {test_group_7, [sequence], [testcase_7a,testcase_7b]}, + + {test_group_8, [], [{group, test_group_9}, testcase_8]}, + + {test_group_9, [], []}, + + {test_group_10, [], [{group, test_group_9}]} + ]. all() -> [{group, test_group_1a}, @@ -60,7 +66,10 @@ all() -> testcase_2, {group, test_group_2}, testcase_3, - {group, test_group_4}]. + {group, test_group_4}, + {group, test_group_8}, + {group, test_group_9}, + {group, test_group_10}]. %% this func only for internal test purposes grs_and_tcs() -> @@ -68,7 +77,9 @@ grs_and_tcs() -> test_group_1a, test_group_1b, test_group_2, test_group_3, test_group_4, test_group_5, - test_group_6, test_group_7 + test_group_6, test_group_7, + test_group_8, test_group_9, + test_group_10 ], [ testcase_1a, testcase_1b, testcase_1c, @@ -78,7 +89,8 @@ grs_and_tcs() -> testcase_3a, testcase_3b, testcase_3, testcase_5a, testcase_5b, - testcase_7a, testcase_7b + testcase_7a, testcase_7b, + testcase_8 ]}. %%-------------------------------------------------------------------- @@ -107,7 +119,10 @@ init_per_group(Group, Config) -> {test_group_4,[{name,test_group_4}]} -> ok; {test_group_5,[{name,test_group_5},parallel]} -> "parallel"; {test_group_6,[{name,test_group_6},parallel]} -> "parallel"; - {test_group_7,[{name,test_group_7},sequence]} -> "sequence" + {test_group_7,[{name,test_group_7},sequence]} -> "sequence"; + {test_group_8,[{name,test_group_8}]} -> ok; + {test_group_9,[{name,test_group_9}]} -> ok; + {test_group_10,[{name,test_group_10}]} -> ok end, {Grs,_} = grs_and_tcs(), case lists:member(Group, Grs) of @@ -312,3 +327,7 @@ testcase_7b(Config) -> undefined = ?config(testcase_7a,Config), testcase_7b = ?config(testcase_7b,Config), ok. +testcase_8() -> + []. +testcase_8(_Config) -> + ok. diff --git a/lib/common_test/test/ct_hooks_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE.erl index 64f4e277ff..8574d7aabc 100644 --- a/lib/common_test/test/ct_hooks_SUITE.erl +++ b/lib/common_test/test/ct_hooks_SUITE.erl @@ -79,7 +79,8 @@ all(suite) -> scope_per_suite_cth, scope_per_group_cth, scope_suite_cth, scope_per_suite_state_cth, scope_per_group_state_cth, scope_suite_state_cth, - fail_pre_suite_cth, fail_post_suite_cth, skip_pre_suite_cth, + fail_pre_suite_cth, double_fail_pre_suite_cth, + fail_post_suite_cth, skip_pre_suite_cth, skip_post_suite_cth, recover_post_suite_cth, update_config_cth, state_update_cth, options_cth, same_id_cth, fail_n_skip_with_minimal_cth @@ -167,6 +168,11 @@ fail_pre_suite_cth(Config) when is_list(Config) -> do_test(fail_pre_suite_cth, "ct_cth_empty_SUITE.erl", [fail_pre_suite_cth],Config). +double_fail_pre_suite_cth(Config) when is_list(Config) -> + do_test(double_fail_pre_suite_cth, "{ct_scope_suite_crash_in_cth_SUITE.erl," + "ct_scope_suite_cth_SUITE.erl}", + [],Config). + fail_post_suite_cth(Config) when is_list(Config) -> do_test(fail_post_suite_cth, "ct_cth_empty_SUITE.erl", [fail_post_suite_cth],Config). @@ -225,8 +231,9 @@ do_test(Tag, SuiteWildCard, CTHs, Config, Res, EC) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(Tag, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(Tag, EC), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -259,9 +266,9 @@ events_to_check(Test, N) -> test_events(one_empty_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{empty_cth,id,[[]]}}, {?eh,cth,{empty_cth,init,[{'_','_','_'},[]]}}, - {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{empty_cth,pre_init_per_suite, [ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -287,11 +294,11 @@ test_events(one_empty_cth) -> test_events(two_empty_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, - {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -329,8 +336,8 @@ test_events(faulty_cth_no_init) -> test_events(faulty_cth_id_no_init) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',id,[[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',id,[[]]}}, {negative,{?eh,tc_start,'_'}, {?eh,test_done,{'DEF','STOP_TIME'}}}, {?eh,stop_logging,[]} @@ -339,9 +346,9 @@ test_events(faulty_cth_id_no_init) -> test_events(minimal_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {negative,{?eh,cth,{'_',id,['_',[]]}}, {?eh,cth,{'_',init,['_',[]]}}}, - {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite,ok}}, @@ -357,11 +364,11 @@ test_events(minimal_cth) -> test_events(minimal_and_maximal_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {negative,{?eh,cth,{'_',id,['_',[]]}}, {?eh,cth,{'_',init,['_',[]]}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,['_',[]]}}, - {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, @@ -387,8 +394,8 @@ test_events(faulty_cth_undef) -> {failed,FailReasonStr}}, [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,tc_done,{ct_cth_empty_SUITE,init_per_suite, {failed, {error,FailReasonStr}}}}, @@ -433,15 +440,15 @@ test_events(faulty_cth_exit_in_init_scope_suite) -> test_events(faulty_cth_exit_in_init) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{empty_cth,init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,init,['_',[]]}}, {?eh,test_done,{'DEF','STOP_TIME'}}, {?eh,stop_logging,[]}]; test_events(faulty_cth_exit_in_id) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{empty_cth,id,[[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,id,[[]]}}, {negative, {?eh,tc_start,'_'}, {?eh,test_done,{'DEF','STOP_TIME'}}}, {?eh,stop_logging,[]}]; @@ -609,9 +616,8 @@ test_events(scope_per_group_state_cth) -> test_events(fail_pre_suite_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, - + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -646,11 +652,28 @@ test_events(fail_pre_suite_cth) -> {?eh,stop_logging,[]} ]; -test_events(fail_post_suite_cth) -> +test_events(double_fail_pre_suite_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,tc_start,{'_',init_per_suite}}, {?eh,cth,{'_',init,['_',[]]}}, + {?eh,cth,{'_',pre_init_per_suite,['_','$proplist',[]]}}, + {?eh,cth,{'_',post_init_per_suite,['_','$proplist', + {fail,"Test failure"},[]]}}, + {?eh,cth, {empty_cth,terminate,[[]]}}, + + {?eh,tc_start,{'_',init_per_suite}}, + {?eh,cth,{'_',init,['_',[]]}}, + {?eh,cth, {empty_cth,terminate,[[]]}}, + {?eh,stop_logging,[]} + ]; + +test_events(fail_post_suite_cth) -> + [ + {?eh,start_logging,{'DEF','RUNDIR'}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist','$proplist',[]]}}, @@ -676,8 +699,8 @@ test_events(fail_post_suite_cth) -> test_events(skip_pre_suite_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {?eh,cth,{'_',post_init_per_suite,[ct_cth_empty_SUITE,'$proplist',{skip,"Test skip"},[]]}}, @@ -699,8 +722,8 @@ test_events(skip_pre_suite_cth) -> test_events(skip_post_suite_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, @@ -724,8 +747,8 @@ test_events(recover_post_suite_cth) -> Suite = ct_cth_fail_per_suite_SUITE, [ {?eh,start_logging,'_'}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{Suite,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[Suite,'$proplist','$proplist']}}, {?eh,cth,{'_',post_init_per_suite,[Suite,contains([tc_status]), @@ -753,8 +776,8 @@ test_events(recover_post_suite_cth) -> test_events(update_config_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{ct_update_config_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite, @@ -864,9 +887,9 @@ test_events(update_config_cth) -> test_events(state_update_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',init,['_',[]]}}, {?eh,cth,{'_',init,['_',[]]}}, - {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{'_',init_per_suite}}, {?eh,tc_done,{'_',end_per_suite,ok}}, @@ -902,8 +925,8 @@ test_events(state_update_cth) -> test_events(options_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{empty_cth,init,['_',[test]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{empty_cth,init,['_',[test]]}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{empty_cth,pre_init_per_suite, [ct_cth_empty_SUITE,'$proplist',[test]]}}, @@ -929,10 +952,10 @@ test_events(options_cth) -> test_events(same_id_cth) -> [ {?eh,start_logging,{'DEF','RUNDIR'}}, + {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,cth,{'_',id,[[]]}}, {?eh,cth,{'_',init,[same_id_cth,[]]}}, {?eh,cth,{'_',id,[[]]}}, - {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, {?eh,tc_start,{ct_cth_empty_SUITE,init_per_suite}}, {?eh,cth,{'_',pre_init_per_suite,[ct_cth_empty_SUITE,'$proplist',[]]}}, {negative, @@ -969,8 +992,8 @@ test_events(same_id_cth) -> test_events(fail_n_skip_with_minimal_cth) -> [{?eh,start_logging,{'DEF','RUNDIR'}}, - {?eh,cth,{'_',init,['_',[]]}}, {?eh,test_start,{'DEF',{'START_TIME','LOGDIR'}}}, + {?eh,cth,{'_',init,['_',[]]}}, {?eh,tc_start,{'_',init_per_suite}}, {?eh,tc_done,{'_',end_per_suite,ok}}, diff --git a/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_scope_suite_crash_in_cth_SUITE.erl b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_scope_suite_crash_in_cth_SUITE.erl new file mode 100644 index 0000000000..5aa6b0132d --- /dev/null +++ b/lib/common_test/test/ct_hooks_SUITE_data/cth/tests/ct_scope_suite_crash_in_cth_SUITE.erl @@ -0,0 +1,50 @@ +%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010-2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% 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(ct_scope_suite_crash_in_cth_SUITE).
+
+-suite_defaults([{timetrap, {minutes, 10}}]).
+
+%% Note: This directive should only be used in test suites.
+-compile(export_all).
+
+-include("ct.hrl").
+
+%% Test server callback functions
+suite() ->
+ [{ct_hooks,[fail_pre_suite_cth]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_testcase(_TestCase, Config) ->
+ Config.
+
+end_per_testcase(_TestCase, _Config) ->
+ ok.
+
+all() ->
+ [test_case].
+
+%% Test cases starts here.
+test_case(Config) when is_list(Config) ->
+ ok.
diff --git a/lib/common_test/test/ct_master_SUITE.erl b/lib/common_test/test/ct_master_SUITE.erl index e89b6f7de6..1471cc1e0c 100644 --- a/lib/common_test/test/ct_master_SUITE.erl +++ b/lib/common_test/test/ct_master_SUITE.erl @@ -119,8 +119,9 @@ ct_master_test(Config) when is_list(Config)-> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(groups_suite_1, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + PrivDir, []), + find_events(NodeNames, [{tc_start,{master_SUITE,init_per_suite}}, {tc_start,{master_SUITE,first_testcase}}, {tc_start,{master_SUITE,second_testcase}}, @@ -174,7 +175,7 @@ make_spec(DataDir, FileName, NodeNames, Suites, Config)-> ct_test_support:write_testspec(N++Include++EH++C++S++LD++NS, FileName). -get_log_dir({win32,_},PrivDir, NodeName)-> +get_log_dir({win32,_}, _PrivDir, NodeName)-> case filelib:is_dir(?TEMP_DIR) of false -> file:make_dir(?TEMP_DIR); diff --git a/lib/common_test/test/ct_misc_1_SUITE.erl b/lib/common_test/test/ct_misc_1_SUITE.erl index a8bd2c2189..cb17af9ab5 100644 --- a/lib/common_test/test/ct_misc_1_SUITE.erl +++ b/lib/common_test/test/ct_misc_1_SUITE.erl @@ -111,7 +111,8 @@ beam_me_up(Config) when is_list(Config) -> ct_test_support:log_events(beam_me_up, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(beam_me_up, 1), ok = ct_test_support:verify_events(TestEvents, Events, Config). diff --git a/lib/common_test/test/ct_repeat_1_SUITE.erl b/lib/common_test/test/ct_repeat_1_SUITE.erl index e674315526..4e842bd6d6 100644 --- a/lib/common_test/test/ct_repeat_1_SUITE.erl +++ b/lib/common_test/test/ct_repeat_1_SUITE.erl @@ -159,7 +159,8 @@ execute(TestCase, SuiteName, Group, Config) -> ct_test_support:log_events(TestCase, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(TestCase), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -561,7 +562,6 @@ test_events(repeat_cs_until_any_fail) -> {error, {{badmatch,2}, [{repeat_1_SUITE,tc_fail_1,1}, - {repeat_1_SUITE,tc_fail_1,1}, {test_server,my_apply,3}, {test_server,ts_tc,3}, {test_server,run_test_case_eval1,6}, diff --git a/lib/common_test/test/ct_sequence_1_SUITE.erl b/lib/common_test/test/ct_sequence_1_SUITE.erl index c7650b169c..5facf90656 100644 --- a/lib/common_test/test/ct_sequence_1_SUITE.erl +++ b/lib/common_test/test/ct_sequence_1_SUITE.erl @@ -132,7 +132,8 @@ execute(TestCase, SuiteName, Group, Config) -> ct_test_support:log_events(TestCase, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(TestCase), ok = ct_test_support:verify_events(TestEvents, Events, Config). diff --git a/lib/common_test/test/ct_skip_SUITE.erl b/lib/common_test/test/ct_skip_SUITE.erl index 62c5f10b7c..4ba4479208 100644 --- a/lib/common_test/test/ct_skip_SUITE.erl +++ b/lib/common_test/test/ct_skip_SUITE.erl @@ -99,8 +99,9 @@ auto_skip(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(auto_skip, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(auto_skip), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -122,8 +123,9 @@ user_skip(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(user_skip, - reformat(Events, ?eh), - ?config(priv_dir, Config)), + reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(user_skip), ok = ct_test_support:verify_events(TestEvents, Events, Config). diff --git a/lib/common_test/test/ct_smoke_test_SUITE.erl b/lib/common_test/test/ct_smoke_test_SUITE.erl index c3d49a5afa..49b38361e2 100644 --- a/lib/common_test/test/ct_smoke_test_SUITE.erl +++ b/lib/common_test/test/ct_smoke_test_SUITE.erl @@ -175,8 +175,9 @@ dir1(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(dir1, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(dir1), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -204,8 +205,9 @@ dir2(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(dir2, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(dir2), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -234,8 +236,9 @@ dir1_2(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(dir1_2, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(dir1_2), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -264,8 +267,8 @@ suite11(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(suite11, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), Opts), TestEvents = events_to_check(suite11), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -293,8 +296,8 @@ suite21(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(suite21, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), Opts), TestEvents = events_to_check(suite21), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -324,8 +327,8 @@ suite11_21(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(suite11_21, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), Opts), TestEvents = events_to_check(suite11_21), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -355,8 +358,8 @@ tc111(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(tc111, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), Opts), TestEvents = events_to_check(tc111), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -385,8 +388,8 @@ tc211(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(tc211, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), Opts), TestEvents = events_to_check(tc211), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -416,8 +419,8 @@ tc111_112(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(tc111_112, - ct_test_support:reformat(Events, ?eh), - ?config(priv_dir, Config)), + ct_test_support:reformat(Events, ?eh), + ?config(priv_dir, Config), Opts), TestEvents = events_to_check(tc111_112), ok = ct_test_support:verify_events(TestEvents, Events, Config). diff --git a/lib/common_test/test/ct_test_server_if_1_SUITE.erl b/lib/common_test/test/ct_test_server_if_1_SUITE.erl index 9d3e6a9e59..4471915e69 100644 --- a/lib/common_test/test/ct_test_server_if_1_SUITE.erl +++ b/lib/common_test/test/ct_test_server_if_1_SUITE.erl @@ -98,8 +98,9 @@ ts_if_1(Config) when is_list(Config) -> Events = ct_test_support:get_events(ERPid, Config), ct_test_support:log_events(ts_if_1, - reformat(Events, ?eh), - PrivDir), + reformat(Events, ?eh), + PrivDir, + Opts), TestEvents = events_to_check(ts_if_1), ok = ct_test_support:verify_events(TestEvents, Events, Config). diff --git a/lib/common_test/test/ct_test_support.erl b/lib/common_test/test/ct_test_support.erl index b4f1a0e71f..601d5315ce 100644 --- a/lib/common_test/test/ct_test_support.erl +++ b/lib/common_test/test/ct_test_support.erl @@ -32,7 +32,8 @@ run/2, run/4, get_opts/1, wait_for_ct_stop/1]). -export([handle_event/2, start_event_receiver/1, get_events/2, - verify_events/3, reformat/2, log_events/3]). + verify_events/3, reformat/2, log_events/4, + join_abs_dirs/2]). -include_lib("kernel/include/file.hrl"). @@ -63,7 +64,6 @@ init_per_suite(Config, Level) -> start_slave(Config,Level) -> [_,Host] = string:tokens(atom_to_list(node()), "@"), - test_server:format(0, "Trying to start ~s~n", ["ct@"++Host]), case slave:start(Host, ct, []) of {error,Reason} -> @@ -72,18 +72,19 @@ start_slave(Config,Level) -> test_server:format(0, "Node ~p started~n", [CTNode]), IsCover = test_server:is_cover(), if IsCover -> - cover:start(CTNode); - true-> - ok + cover:start(CTNode); + true-> + ok end, - DataDir = ?config(data_dir, Config), - PrivDir = ?config(priv_dir, Config), + + DataDir = proplists:get_value(data_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), %% PrivDir as well as directory of Test Server suites %% have to be in code path on Common Test node. [_ | Parts] = lists:reverse(filename:split(DataDir)), TSDir = filename:join(lists:reverse(Parts)), - AddPathDirs = case ?config(path_dirs, Config) of + AddPathDirs = case proplists:get_value(path_dirs, Config) of undefined -> []; Ds -> Ds end, @@ -110,8 +111,8 @@ start_slave(Config,Level) -> %%% end_per_suite/1 end_per_suite(Config) -> - CTNode = ?config(ct_node, Config), - PrivDir = ?config(priv_dir, Config), + CTNode = proplists:get_value(ct_node, Config), + PrivDir = proplists:get_value(priv_dir, Config), true = rpc:call(CTNode, code, del_path, [filename:join(PrivDir,"")]), cover:stop(CTNode), slave:stop(CTNode), @@ -121,7 +122,9 @@ end_per_suite(Config) -> %%% init_per_testcase/2 init_per_testcase(_TestCase, Config) -> - {_,{_,LogDir}} = lists:keysearch(logdir, 1, get_opts(Config)), + Opts = get_opts(Config), + NetDir = proplists:get_value(net_dir, Opts), + LogDir = join_abs_dirs(NetDir, proplists:get_value(logdir, Opts)), case lists:keysearch(master, 1, Config) of false-> test_server:format("See Common Test logs here:\n\n" @@ -139,7 +142,7 @@ init_per_testcase(_TestCase, Config) -> %%% end_per_testcase/2 end_per_testcase(_TestCase, Config) -> - CTNode = ?config(ct_node, Config), + CTNode = proplists:get_value(ct_node, Config), case wait_for_ct_stop(CTNode) of %% Common test was not stopped to we restart node. false -> @@ -169,7 +172,7 @@ write_testspec(TestSpec, TSFile) -> %%% get_opts(Config) -> - PrivDir = ?config(priv_dir, Config), + PrivDir = proplists:get_value(priv_dir, Config), TempDir = case os:getenv("TMP") of false -> case os:getenv("TEMP") of @@ -195,20 +198,48 @@ get_opts(Config) -> _ -> TempDir end, - InitOpts = ?config(ct_opts, Config), - [{logdir,LogDir} | InitOpts]. + + %% Copy test variables to app environment on new node + CtTestVars = + case init:get_argument(ct_test_vars) of + {ok,[Vars]} -> + [begin {ok,Ts,_} = erl_scan:string(Str++"."), + {ok,Expr} = erl_parse:parse_term(Ts), + Expr + end || Str <- Vars]; + _ -> + [] + end, + %% test_server:format("Test variables added to Config: ~p\n\n", + %% [CtTestVars]), + InitOpts = + case proplists:get_value(ct_opts, Config) of + undefined -> []; + CtOpts -> CtOpts + end, + [{logdir,LogDir} | InitOpts ++ CtTestVars]. %%%----------------------------------------------------------------- %%% run(Opts, Config) -> - CTNode = ?config(ct_node, Config), - Level = ?config(trace_level, Config), + CTNode = proplists:get_value(ct_node, Config), + Level = proplists:get_value(trace_level, Config), %% use ct interface test_server:format(Level, "~n[RUN #1] Calling ct:run_test(~p) on ~p~n", [Opts, CTNode]), Result1 = rpc:call(CTNode, ct, run_test, [Opts]), + case rpc:call(CTNode, erlang, whereis, [ct_util_server]) of + undefined -> + ok; + _ -> + test_server:format(Level, + "ct_util_server not stopped on ~p yet, waiting 5 s...~n", + [CTNode]), + timer:sleep(5000), + undefined = rpc:call(CTNode, erlang, whereis, [ct_util_server]) + end, %% use run_test interface (simulated) test_server:format(Level, "Saving start opts on ~p: ~p~n", [CTNode,Opts]), rpc:call(CTNode, application, set_env, [common_test, run_test_start_opts, Opts]), @@ -224,8 +255,8 @@ run(Opts, Config) -> end. run(M, F, A, Config) -> - CTNode = ?config(ct_node, Config), - Level = ?config(trace_level, Config), + CTNode = proplists:get_value(ct_node, Config), + Level = proplists:get_value(trace_level, Config), test_server:format(Level, "~nCalling ~w:~w(~p) on ~p~n", [M, F, A, CTNode]), rpc:call(CTNode, M, F, A). @@ -261,11 +292,11 @@ handle_event(EH, Event) -> ok. start_event_receiver(Config) -> - CTNode = ?config(ct_node, Config), + CTNode = proplists:get_value(ct_node, Config), spawn_link(CTNode, fun() -> er() end). get_events(_, Config) -> - CTNode = ?config(ct_node, Config), + CTNode = proplists:get_value(ct_node, Config), {event_receiver,CTNode} ! {self(),get_events}, Events = receive {event_receiver,Evs} -> Evs end, {event_receiver,CTNode} ! stop, @@ -288,7 +319,7 @@ er_loop(Evs) -> end. verify_events(TEvs, Evs, Config) -> - Node = ?config(ct_node, Config), + Node = proplists:get_value(ct_node, Config), case catch verify_events1(TEvs, Evs, Node, Config) of {'EXIT',Reason} -> Reason; @@ -349,10 +380,15 @@ locate(TEvs, Node, Evs, Config) when is_list(TEvs) -> data={M,{init_per_group,GroupName,Props}}}}, {TEH,#event{name=tc_done, node=Node, - data={M,{init_per_group,GroupName,Props},R}}} | Evs1] -> - test_server:format("Found ~p!", [InitStart]), - test_server:format("Found ~p!", [InitDone]), - verify_events1(TEvs1, Evs1, Node, Config); + data={M,{init_per_group,GroupName,Props},Res}}} | Evs1] -> + case result_match(R, Res) of + false -> + nomatch; + true -> + test_server:format("Found ~p!", [InitStart]), + test_server:format("Found ~p!", [InitDone]), + verify_events1(TEvs1, Evs1, Node, Config) + end; _ -> nomatch end; @@ -384,9 +420,11 @@ locate({parallel,TEvs}, Node, Evs, Config) -> EvProps},EvR}}}) when TEH == EH, EvNode == Node, EvM == M, EvGroupName == GroupName, - EvProps == Props, - EvR == R -> - false; + EvProps == Props -> + case result_match(R, EvR) of + true -> false; + false -> true + end; ({EH,#event{name=stop_logging, node=EvNode,data=_}}) when EH == TEH, EvNode == Node -> @@ -466,7 +504,7 @@ locate({parallel,TEvs}, Node, Evs, Config) -> node=EvNode, data={Mod,Func,Result}}} <- Done, EH == TEH, EvNode == Node, Mod == M, - Func == F, Result == R] of + Func == F, result_match(R, Result)] of [TcDone|_] -> test_server:format("Found ~p!", [TEv]), {lists:delete(TcDone, Done),RemEvs,RemSize}; @@ -509,8 +547,13 @@ locate({parallel,TEvs}, Node, Evs, Config) -> data={Mod,{end_per_group, EvGName,EvProps},Res}}}) when EH == TEH, EvNode == Node, Mod == M, - EvGName == GroupName, EvProps == Props, Res == R -> - false; + EvGName == GroupName, EvProps == Props -> + case result_match(R, Res) of + true -> + false; + false -> + true + end; ({EH,#event{name=stop_logging, node=EvNode,data=_}}) when EH == TEH, EvNode == Node -> @@ -603,23 +646,29 @@ locate({shuffle,TEvs}, Node, Evs, Config) -> data={M,{init_per_group,GroupName,EvProps}}}}, {TEH,#event{name=tc_done, node=Node, - data={M,{init_per_group,GroupName,EvProps},R}}} | Es] -> - case proplists:get_value(shuffle, Props) of - '_' -> - case proplists:get_value(shuffle, EvProps) of - false -> - exit({no_shuffle_prop_found,{M,init_per_group, - GroupName,EvProps}}); + data={M,{init_per_group,GroupName,EvProps},Res}}} | Es] -> + case result_match(R, Res) of + true -> + case proplists:get_value(shuffle, Props) of + '_' -> + case proplists:get_value(shuffle, EvProps) of + false -> + exit({no_shuffle_prop_found, + {M,init_per_group, + GroupName,EvProps}}); + _ -> + PropsCmp = proplists:delete(shuffle, EvProps), + PropsCmp = proplists:delete(shuffle, Props) + end; _ -> - PropsCmp = proplists:delete(shuffle, EvProps), - PropsCmp = proplists:delete(shuffle, Props) - end; - _ -> - Props = EvProps - end, - test_server:format("Found ~p!", [InitStart]), - test_server:format("Found ~p!", [InitDone]), - {TEs,Es}; + Props = EvProps + end, + test_server:format("Found ~p!", [InitStart]), + test_server:format("Found ~p!", [InitDone]), + {TEs,Es}; + false -> + nomatch + end; _ -> nomatch end; @@ -670,7 +719,7 @@ locate({shuffle,TEvs}, Node, Evs, Config) -> node=EvNode, data={Mod,Func,Result}}} <- Done, EH == TEH, EvNode == Node, Mod == M, - Func == F, Result == R] of + Func == F, result_match(R, Result)] of [TcDone|_] -> test_server:format("Found ~p!", [TEv]), {lists:delete(TcDone, Done),RemEvs,RemSize}; @@ -726,8 +775,13 @@ locate({shuffle,TEvs}, Node, Evs, Config) -> data={Mod,{end_per_group, EvGName,_},Res}}}) when EH == TEH, EvNode == Node, Mod == M, - EvGName == GroupName, Res == R -> - false; + EvGName == GroupName -> + case result_match(R, Res) of + true -> + false; + false -> + true + end; ({EH,#event{name=stop_logging, node=EvNode,data=_}}) when EH == TEH, EvNode == Node -> @@ -864,25 +918,34 @@ locate({TEH,Name,{'DEF','STOP_TIME'}}, Node, [Ev|Evs], Config) -> nomatch end; -%% to match variable data as a result of a failed test case -locate({TEH,tc_done,{Mod,Func,{failed,{error,{Slogan,'_'}}}}}, Node, [Ev|Evs], Config) -> +%% to match variable data as a result of an aborted test case +locate({TEH,tc_done,{undefined,undefined,{testcase_aborted, + {abort_current_testcase,Func},'_'}}}, + Node, [Ev|Evs], Config) -> case Ev of - {TEH,#event{name=tc_done, node=Node, - data={Mod,Func,{failed,{error,{Slogan,_}}}}}} -> + {TEH,#event{name=tc_done, node=Node, + data={undefined,undefined, + {testcase_aborted,{abort_current_testcase,Func},_}}}} -> {Config,Evs}; _ -> nomatch end; -%% to match variable data as a result of an aborted test case -locate({TEH,tc_done,{undefined,undefined,{testcase_aborted, - {abort_current_testcase,Func},'_'}}}, - Node, [Ev|Evs], Config) -> +%% to match variable data as a result of a failed test case +locate({TEH,tc_done,{Mod,Func,R={SkipOrFail,{_ErrInd,ErrInfo}}}}, + Node, [Ev|Evs], Config) when ((SkipOrFail == skipped) or + (SkipOrFail == failed)) and + ((size(ErrInfo) == 2) or + (size(ErrInfo) == 3)) -> case Ev of {TEH,#event{name=tc_done, node=Node, - data={undefined,undefined, - {testcase_aborted,{abort_current_testcase,Func},_}}}} -> - {Config,Evs}; + data={Mod,Func,Result}}} -> + case result_match(R, Result) of + true -> + {Config,Evs}; + false -> + nomatch + end; _ -> nomatch end; @@ -931,14 +994,27 @@ match_data(Tuple1,Tuple2) when is_tuple(Tuple1),is_tuple(Tuple2) -> match_data([],[]) -> match. -log_events(TC, Events, PrivDir) -> - LogFile = filename:join(PrivDir, atom_to_list(TC)++".events"), +result_match({SkipOrFail,{ErrorInd,{Why,'_'}}}, + {SkipOrFail,{ErrorInd,{Why,_Stack}}}) -> + true; +result_match({SkipOrFail,{ErrorInd,{EMod,EFunc,{Why,'_'}}}}, + {SkipOrFail,{ErrorInd,{EMod,EFunc,{Why,_Stack}}}}) -> + true; +result_match(Result, Result) -> + true; +result_match(_, _) -> + false. + +log_events(TC, Events, EvLogDir, Opts) -> + LogFile = filename:join(EvLogDir, atom_to_list(TC)++".events"), {ok,Dev} = file:open(LogFile, [write]), io:format(Dev, "[~n", []), log_events1(Events, Dev, " "), file:close(Dev), + FullLogFile = join_abs_dirs(proplists:get_value(net_dir, Opts), + LogFile), io:format("Events written to logfile: <a href=\"file://~s\">~s</a>~n", - [LogFile,LogFile]), + [FullLogFile,FullLogFile]), io:format(user, "Events written to logfile: ~p~n", [LogFile]). log_events1(Evs, Dev, "") -> @@ -1024,13 +1100,25 @@ reformat([], _EH) -> %%%----------------------------------------------------------------- %%% MISC HELP FUNCTIONS +join_abs_dirs(undefined, Dir2) -> + Dir2; +join_abs_dirs(Dir1, Dir2) -> + case filename:pathtype(Dir2) of + relative -> + filename:join(Dir1, Dir2); + _ -> + [_Abs|Parts] = filename:split(Dir2), + filename:join(Dir1, filename:join(Parts)) + end. + create_tmp_logdir(Tmp) -> LogDir = filename:join(Tmp,"ct"), file:make_dir(LogDir), LogDir. delete_old_logs({win32,_}, Config) -> - case {?config(priv_dir, Config),?config(logdir, get_opts(Config))} of + case {proplists:get_value(priv_dir, Config), + proplists:get_value(logdir, get_opts(Config))} of {LogDir,LogDir} -> ignore; {_,LogDir} -> % using tmp for logs @@ -1042,7 +1130,8 @@ delete_old_logs(_, Config) -> false -> ignore; _ -> - catch delete_dirs(?config(logdir, get_opts(Config))) + catch delete_dirs(proplists:get_value(logdir, + get_opts(Config))) end. delete_dirs(LogDir) -> diff --git a/lib/common_test/test/ct_testspec_1_SUITE.erl b/lib/common_test/test/ct_testspec_1_SUITE.erl index 616c2db869..b6dcf63fdf 100644 --- a/lib/common_test/test/ct_testspec_1_SUITE.erl +++ b/lib/common_test/test/ct_testspec_1_SUITE.erl @@ -612,6 +612,12 @@ setup_and_execute(TCName, TestSpec, Config) -> false -> [{spec,SpecFile},{label,TCName}] end, {Opts,ERPid} = setup(TestTerms, Config), + + FullSpecFile = ct_test_support:join_abs_dirs(?config(net_dir, Opts), + SpecFile), + io:format("~nTest spec created here~n~n<a href=\"file://~s\">~s</a>~n", + [FullSpecFile,FullSpecFile]), + ok = ct_test_support:run(Opts, Config), TestSpec1 = [{logdir,proplists:get_value(logdir,Opts)}, {label,proplists:get_value(label,TestTerms)} | TestSpec], @@ -620,7 +626,8 @@ setup_and_execute(TCName, TestSpec, Config) -> ct_test_support:log_events(TCName, reformat(Events, ?eh), - ?config(priv_dir, Config)), + ?config(priv_dir, Config), + Opts), TestEvents = events_to_check(TCName), ok = ct_test_support:verify_events(TestEvents, Events, Config). @@ -631,8 +638,6 @@ create_spec_file(SpecDir, TCName, TestSpec) -> {ok,Dev} = file:open(FileName, [write]), [io:format(Dev, "~p.~n", [Term]) || Term <- TestSpec], file:close(Dev), - io:format("~nTest spec created here~n~n<a href=\"file://~s\">~s</a>~n", - [FileName,FileName]), FileName. setup(Test, Config) when is_tuple(Test) -> @@ -791,7 +796,9 @@ test_events(skip_group) -> {?eh,tc_done,{groups_11_SUITE,{end_per_group,test_group_1a,[]},'_'}}, {?eh,tc_user_skip, {groups_11_SUITE,{group,test_group_1b},"SKIPPED!"}}, - {?eh,test_stats,{2,0,{1,0}}}, + {?eh,tc_user_skip, {groups_11_SUITE,{group,test_group_2},"SKIPPED!"}}, + %%! But not test_group_7 since it's a sub-group! + {?eh,test_stats,{2,0,{2,0}}}, {negative,{?eh,tc_user_skip,'_'},{?eh,stop_logging,'_'}} ]; @@ -1188,10 +1195,9 @@ test_events(sub_skipped_by_top) -> {?eh,tc_start,{groups_12_SUITE,init_per_suite}}, {?eh,tc_user_skip,{groups_12_SUITE,{group,test_group_4},"SKIPPED!"}}, + {?eh,tc_user_skip,{groups_12_SUITE,{group,test_group_4},"SKIPPED!"}}, - {negative, - {?eh,tc_user_skip,{groups_12_SUITE,{group,test_group_4},"SKIPPED!"}}, - {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}}, + {?eh,tc_done,{groups_12_SUITE,end_per_suite,'_'}}, {negative,{?eh,tc_start,'_'},{?eh,stop_logging,'_'}} ]; diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl index 2a36fda1ea..5cc8252b99 100644 --- a/lib/compiler/src/beam_bsm.erl +++ b/lib/compiler/src/beam_bsm.erl @@ -651,10 +651,8 @@ add_warning(Term, Anno, Ws) -> warning_translate_label(Term, D) when is_tuple(Term) -> case element(1, Term) of {label,F} -> - case gb_trees:lookup(F, D) of - none -> Term; - {value,FA} -> setelement(1, Term, FA) - end; + FA = gb_trees:get(F, D), + setelement(1, Term, FA); _ -> Term end; warning_translate_label(Term, _) -> Term. diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index bb93110176..8e96569414 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -162,14 +162,11 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) -> %% We must split the basic block when we encounter instructions with labels, %% such as catches and BIFs. All labels must be visible outside the blocks. -%% Also remove empty blocks. split_blocks({function,Name,Arity,CLabel,Is0}) -> Is = split_blocks(Is0, []), {function,Name,Arity,CLabel,Is}. -split_blocks([{block,[]}|Is], Acc) -> - split_blocks(Is, Acc); split_blocks([{block,Bl}|Is], Acc0) -> Acc = split_block(Bl, [], Acc0), split_blocks(Is, Acc); @@ -246,30 +243,24 @@ forward([{select_val,Reg,_,{list,List}}=I|Is], D0, Lc, Acc) -> D = update_value_dict(List, Reg, D0), forward(Is, D, Lc, [I|Acc]); forward([{label,Lbl}=LblI,{block,[{set,[Dst],[Lit],move}|BlkIs]}=Blk|Is], D, Lc, Acc) -> + %% Assumption: The target labels in a select_val/3 instruction + %% cannot be reached in any other way than through the select_val/3 + %% instruction (i.e. there can be no fallthrough to such label and + %% it cannot be referenced by, for example, a jump/1 instruction). Block = case gb_trees:lookup({Lbl,Dst}, D) of - {value,Lit} -> - %% The move instruction seems to be redundant, but also make - %% sure that the instruction preceeding the label - %% cannot fall through to the move instruction. - case is_unreachable_after(Acc) of - false -> Blk; %Must keep move instruction. - true -> {block,BlkIs} %Safe to remove move instruction. - end; - _ -> Blk %Keep move instruction. + {value,Lit} -> {block,BlkIs}; %Safe to remove move instruction. + _ -> Blk %Must keep move instruction. end, forward([Block|Is], D, Lc, [LblI|Acc]); forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) -> + %% Assumption: The target labels in a select_val/3 instruction + %% cannot be reached in any other way than through the select_val/3 + %% instruction (i.e. there can be no fallthrough to such label and + %% it cannot be referenced by, for example, a jump/1 instruction). Is = case gb_trees:lookup({Lbl,Dst}, D) of - {value,Lit} -> - %% The move instruction seems to be redundant, but also make - %% sure that the instruction preceeding the label - %% cannot fall through to the move instruction. - case is_unreachable_after(Acc) of - false -> Is0; %Must keep move instruction. - true -> Is1 %Safe to remove move instruction. - end; - _ -> Is0 %Keep move instruction. - end, + {value,Lit} -> Is1; %Safe to remove move instruction. + _ -> Is0 %Keep move instruction. + end, forward(Is, D, Lc, [LblI|Acc]); forward([{test,is_eq_exact,_,[Dst,Src]}=I, {block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) -> @@ -299,16 +290,12 @@ update_value_dict([Lit,{f,Lbl}|T], Reg, D0) -> Key = {Lbl,Reg}, D = case gb_trees:lookup(Key, D0) of none -> gb_trees:insert(Key, Lit, D0); %New. - {value,Lit} -> D0; %Already correct. {value,inconsistent} -> D0; %Inconsistent. {value,_} -> gb_trees:update(Key, inconsistent, D0) end, update_value_dict(T, Reg, D); update_value_dict([], _, D) -> D. -is_unreachable_after([I|_]) -> - beam_jump:is_unreachable_after(I). - %%% %%% Scan instructions in reverse execution order and remove dead code. %%% @@ -602,16 +589,11 @@ count_bits_matched([{test,_,_,_}|Is], SavePoint, Bits) -> count_bits_matched([{bs_save2,Reg,SavePoint}|_], {Reg,SavePoint}, Bits) -> %% The save point we are looking for - we are done. Bits; -count_bits_matched([{bs_save2,_,_}|Is], SavePoint, Bits) -> - %% Another save point - keep counting. - count_bits_matched(Is, SavePoint, Bits); count_bits_matched([_|_], _, Bits) -> Bits. shortcut_bs_pos_used(To, Reg, D) -> shortcut_bs_pos_used_1(beam_utils:code_at(To, D), Reg, D). -shortcut_bs_pos_used_1([{bs_restore2,Reg,_}|_], Reg, _) -> - false; shortcut_bs_pos_used_1([{bs_context_to_binary,Reg}|_], Reg, _) -> false; shortcut_bs_pos_used_1(Is, Reg, D) -> diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 934bf39393..fe713fd019 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -157,7 +157,7 @@ release_tests_spec: make_emakefile $(EMAKEFILE) $(ERL_FILES) $(CORE_FILES) $(RELSYSDIR) $(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \ $(INLINE_ERL_FILES) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index cab22e03d0..f7388f1614 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -28,7 +28,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(andor_SUITE), + test_lib:recompile(?MODULE), [t_case, t_and_or, t_andalso, t_orelse, inside, overlap, combined, in_case, before_and_inside_if]. diff --git a/lib/compiler/test/apply_SUITE.erl b/lib/compiler/test/apply_SUITE.erl index c517c4465e..25f8a8dfb5 100644 --- a/lib/compiler/test/apply_SUITE.erl +++ b/lib/compiler/test/apply_SUITE.erl @@ -28,7 +28,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(apply_SUITE), + test_lib:recompile(?MODULE), [mfa, fun_apply]. groups() -> diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index fc88ebeb41..556dc54a8f 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -46,7 +46,7 @@ end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(beam_validator_SUITE), + test_lib:recompile(?MODULE), [beam_files, compiler_bug, stupid_but_valid, xrange, yrange, stack, call_last, merge_undefined, uninit, unsafe_catch, dead_code, mult_labels, diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl index 30c04f80cf..d39e340429 100644 --- a/lib/compiler/test/bs_bincomp_SUITE.erl +++ b/lib/compiler/test/bs_bincomp_SUITE.erl @@ -32,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_bincomp_SUITE), + test_lib:recompile(?MODULE), [byte_aligned, bit_aligned, extended_byte_aligned, extended_bit_aligned, mixed, filters, trim_coverage, nomatch, sizes, tail]. diff --git a/lib/compiler/test/bs_bit_binaries_SUITE.erl b/lib/compiler/test/bs_bit_binaries_SUITE.erl index 8be0c4196a..30276f1259 100644 --- a/lib/compiler/test/bs_bit_binaries_SUITE.erl +++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl @@ -33,7 +33,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_bit_binaries_SUITE), + test_lib:recompile(?MODULE), [misc, horrid_match, test_bitstr, test_bit_size, asymmetric_tests, big_asymmetric_tests, binary_to_and_from_list, big_binary_to_and_from_list, diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index c430b12b70..31c7890f26 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -35,7 +35,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_construct_SUITE), + test_lib:recompile(?MODULE), [two, test1, fail, float_bin, in_guard, in_catch, nasty_literals, side_effect, opt, otp_7556, float_arith, otp_8054]. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 9184e14cb2..6a795f6634 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -35,7 +35,7 @@ match_string/1,zero_width/1,bad_size/1,haystack/1, cover_beam_bool/1]). --export([coverage_id/1]). +-export([coverage_id/1,coverage_external_ignore/2]). -include_lib("test_server/include/test_server.hrl"). @@ -43,7 +43,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_match_SUITE), + test_lib:recompile(?MODULE), [fun_shadow, int_float, otp_5269, null_fields, wiger, bin_tail, save_restore, shadowed_size_var, partitioned_bs_match, function_clause, unit, @@ -585,13 +585,17 @@ coverage(Config) when is_list(Config) -> A+B end, 0, [a,b,c])), + ?line {<<42.0:64/float>>,float} = coverage_build(<<>>, <<42>>, float), ?line {<<>>,not_a_tuple} = coverage_build(<<>>, <<>>, not_a_tuple), ?line {<<16#76,"abc",16#A9,"abc">>,{x,42,43}} = coverage_build(<<>>, <<16#7,16#A>>, {x,y,z}), + ?line [<<2>>,<<1>>] = coverage_bc(<<1,2>>, []), + ?line {x,<<"abc">>,z} = coverage_setelement(<<2,"abc">>, {x,y,z}), ?line [42] = coverage_apply(<<42>>, [coverage_id]), + ?line 42 = coverage_external(<<42>>), ?line do_coverage_bin_to_term_list([]), ?line do_coverage_bin_to_term_list([lists:seq(0, 10),{a,b,c},<<23:42>>]), @@ -608,6 +612,10 @@ coverage_fold(Fun, Acc, <<H,T/binary>>) -> coverage_fold(Fun, Fun(IdFun(H), IdFun(Acc)), T); coverage_fold(Fun, Acc, <<>>) when is_function(Fun, 2) -> Acc. +coverage_build(Acc0, <<H,T/binary>>, float) -> + Float = id(<<H:64/float>>), + Acc = <<Acc0/binary,Float/binary>>, + coverage_build(Acc, T, float); coverage_build(Acc0, <<H,T/binary>>, Tuple0) -> Str = id(<<H:(id(4)),(H-1):4,"abc">>), Acc = id(<<Acc0/bitstring,Str/bitstring>>), @@ -618,6 +626,11 @@ coverage_build(Acc0, <<H,T/binary>>, Tuple0) -> end; coverage_build(Acc, <<>>, Tuple) -> {Acc,Tuple}. +coverage_bc(<<H,T/binary>>, Acc) -> + B = << <<C:8>> || C <- [H] >>, + coverage_bc(T, [B|Acc]); +coverage_bc(<<>>, Acc) -> Acc. + coverage_setelement(<<H,T1/binary>>, Tuple) when element(1, Tuple) =:= x -> setelement(H, Tuple, T1). @@ -625,6 +638,13 @@ coverage_apply(<<H,T/binary>>, [F|Fs]) -> [?MODULE:F(H)|coverage_apply(T, Fs)]; coverage_apply(<<>>, []) -> []. +coverage_external(<<H,T/binary>>) -> + ?MODULE:coverage_external_ignore(T, T), + H. + +coverage_external_ignore(_, _) -> + ok. + coverage_id(I) -> id(I). do_coverage_bin_to_term_list(L) -> diff --git a/lib/compiler/test/bs_utf_SUITE.erl b/lib/compiler/test/bs_utf_SUITE.erl index d37943ce3a..f30a4d3fef 100644 --- a/lib/compiler/test/bs_utf_SUITE.erl +++ b/lib/compiler/test/bs_utf_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(bs_utf_SUITE), + test_lib:recompile(?MODULE), [utf8_roundtrip, unused_utf_char, utf16_roundtrip, utf32_roundtrip, guard, extreme_tripping, literals, coverage]. diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index ba225b66d0..1343fbd1c9 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -27,7 +27,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(compilation_SUITE), + test_lib:recompile(?MODULE), [self_compile_old_inliner, self_compile, compiler_1, compiler_3, compiler_5, beam_compiler_1, beam_compiler_2, beam_compiler_3, beam_compiler_4, diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 037c078fd0..b3e5376ffd 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -40,7 +40,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. -spec all() -> all_return_type(). all() -> - test_lib:recompile(compile_SUITE), + test_lib:recompile(?MODULE), [app_test, file_1, module_mismatch, big_file, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, other_output, package_forms, encrypted_abstr, diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index 21a5f65dee..26173c62b8 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -40,7 +40,7 @@ end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(core_SUITE), + test_lib:recompile(?MODULE), [dehydrated_itracer, nested_tries]. groups() -> diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 710751b09d..ac14d36e82 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(core_fold_SUITE), + test_lib:recompile(?MODULE), [t_element, setelement, t_length, append, t_apply, bifs, eq, nested_call_in_case, coverage]. diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index c9823665b4..6e0aadf007 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -27,7 +27,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(error_SUITE), + test_lib:recompile(?MODULE), [head_mismatch_line, warnings_as_errors, bif_clashes]. groups() -> diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl index 6738265776..afc04fd440 100644 --- a/lib/compiler/test/float_SUITE.erl +++ b/lib/compiler/test/float_SUITE.erl @@ -26,7 +26,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(float_SUITE), + test_lib:recompile(?MODULE), [pending, bif_calls, math_functions, mixed_float_and_int]. diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl index aa9be83c82..368a5815bf 100644 --- a/lib/compiler/test/fun_SUITE.erl +++ b/lib/compiler/test/fun_SUITE.erl @@ -27,7 +27,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(fun_SUITE), + test_lib:recompile(?MODULE), [test1, overwritten_fun, otp_7202, bif_fun]. groups() -> diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index 482564a32b..0e69efba6b 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -37,7 +37,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(guard_SUITE), + test_lib:recompile(?MODULE), [misc, const_cond, basic_not, complex_not, nested_nots, semicolon, complex_semicolon, comma, or_guard, more_or_guards, complex_or_guards, and_guard, xor_guard, diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl index 7b9600c2f6..af2b8ec92a 100644 --- a/lib/compiler/test/inline_SUITE.erl +++ b/lib/compiler/test/inline_SUITE.erl @@ -31,7 +31,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(inline_SUITE), + test_lib:recompile(?MODULE), [attribute, bsdecode, bsdes, barnes2, decode1, smith, itracer, pseudoknot, lists, really_inlined, otp_7223, coverage]. diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl index bcdcf2fd9f..c8908858ba 100644 --- a/lib/compiler/test/lc_SUITE.erl +++ b/lib/compiler/test/lc_SUITE.erl @@ -30,7 +30,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(lc_SUITE), + test_lib:recompile(?MODULE), [basic, deeply_nested, no_generator, empty_generator]. groups() -> diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 04879300d1..9406d7de8f 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -22,16 +22,16 @@ init_per_group/2,end_per_group/2, pmatch/1,mixed/1,aliases/1,match_in_call/1, untuplify/1,shortcut_boolean/1,letify_guard/1, - selectify/1,underscore/1]). + selectify/1,underscore/1,coverage/1]). -include_lib("test_server/include/test_server.hrl"). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(match_SUITE), + test_lib:recompile(?MODULE), [pmatch, mixed, aliases, match_in_call, untuplify, - shortcut_boolean, letify_guard, selectify, underscore]. + shortcut_boolean, letify_guard, selectify, underscore, coverage]. groups() -> []. @@ -398,4 +398,18 @@ underscore(Config) when is_list(Config) -> _ = is_list(Config), ok. +coverage(Config) when is_list(Config) -> + %% Cover beam_dead. + ok = coverage_1(x, a), + ok = coverage_1(x, b). + +coverage_1(B, Tag) -> + case Tag of + a -> coverage_2(1, a, B); + b -> coverage_2(2, b, B) + end. + +coverage_2(1, a, x) -> ok; +coverage_2(2, b, x) -> ok. + id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index f1f9b17084..c941a80e61 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -56,7 +56,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. -spec all() -> misc_SUITE_test_cases(). all() -> - test_lib:recompile(misc_SUITE), + test_lib:recompile(?MODULE), [tobias, empty_string, md5, silly_coverage, confused_literals, integer_encoding, override_bif]. diff --git a/lib/compiler/test/num_bif_SUITE.erl b/lib/compiler/test/num_bif_SUITE.erl index 0a4750dc08..3479cf5425 100644 --- a/lib/compiler/test/num_bif_SUITE.erl +++ b/lib/compiler/test/num_bif_SUITE.erl @@ -40,7 +40,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(num_bif_SUITE), + test_lib:recompile(?MODULE), [t_abs, t_float, t_float_to_list, t_integer_to_list, {group, t_list_to_float}, t_list_to_integer, t_round, t_trunc]. diff --git a/lib/compiler/test/pmod_SUITE.erl b/lib/compiler/test/pmod_SUITE.erl index 4c68d777ca..9a317b5762 100644 --- a/lib/compiler/test/pmod_SUITE.erl +++ b/lib/compiler/test/pmod_SUITE.erl @@ -28,7 +28,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(pmod_SUITE), + test_lib:recompile(?MODULE), [basic, otp_8447]. groups() -> diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 75e8045693..2a67615e5e 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -39,7 +39,7 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(receive_SUITE), + test_lib:recompile(?MODULE), [recv, coverage, otp_7980, ref_opt, export]. groups() -> diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl index 65b96590ed..363422ec7e 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -26,7 +26,8 @@ init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, errors/1,record_test_2/1,record_test_3/1,record_access_in_guards/1, - guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1, nested_access/1]). + guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1, + nested_access/1,coverage/1]). init_per_testcase(_Case, Config) -> ?line Dog = test_server:timetrap(test_server:minutes(2)), @@ -40,10 +41,10 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(record_SUITE), + test_lib:recompile(?MODULE), [errors, record_test_2, record_test_3, record_access_in_guards, guard_opt, eval_once, foobar, - missing_test_heap, nested_access]. + missing_test_heap, nested_access, coverage]. groups() -> []. @@ -568,4 +569,18 @@ nested_access(Config) when is_list(Config) -> ?line N2a = N2b, ok. +-record(rr, {a,b,c}). + +coverage(Config) when is_list(Config) -> + %% There should only remain one record test in the code below. + R0 = id(#rr{a=1,b=2,c=3}), + B = R0#rr.b, %Test the record here. + R = R0#rr{c=42}, %No need to test here. + if + B > R#rr.a -> %No need to test here. + ok + end, + #rr{a=1,b=2,c=42} = id(R), %Test for correctness. + ok. + id(I) -> I. diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 92a79d3cba..c6e0f8d85d 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -31,7 +31,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(trycatch_SUITE), + test_lib:recompile(?MODULE), [basic, lean_throw, try_of, try_after, catch_oops, after_oops, eclectic, rethrow, nested_of, nested_catch, nested_after, nested_horrid, last_call_optimization, diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl index dd18a6e1a3..f6a572abfa 100644 --- a/lib/compiler/test/warnings_SUITE.erl +++ b/lib/compiler/test/warnings_SUITE.erl @@ -54,7 +54,7 @@ end_per_testcase(_Case, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - test_lib:recompile(warnings_SUITE), + test_lib:recompile(?MODULE), [pattern, pattern2, pattern3, pattern4, guard, bad_arith, bool_cases, bad_apply, files, effect, bin_opt_info, bin_construction]. diff --git a/lib/cosFileTransfer/test/Makefile b/lib/cosFileTransfer/test/Makefile index ec7ebcafca..b46fb35356 100644 --- a/lib/cosFileTransfer/test/Makefile +++ b/lib/cosFileTransfer/test/Makefile @@ -130,4 +130,4 @@ release_tests_spec: tests $(INSTALL_DATA) $(IDL_FILES) $(TEST_SPEC_FILE) \ $(COVER_FILE) $(ERL_FILES) $(RELSYSDIR) $(INSTALL_DATA) $(SUITE_TARGET_FILES) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index b8786f6f94..3ebf62d87c 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -134,7 +134,9 @@ static ERL_NIF_TERM des_ede3_cbc_crypt(ErlNifEnv* env, int argc, const ERL_NIF_T static ERL_NIF_TERM aes_cfb_128_crypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM aes_ctr_encrypt(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); +static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM rand_uniform_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM mod_exp_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); static ERL_NIF_TERM dss_verify(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]); @@ -204,7 +206,9 @@ static ErlNifFunc nif_funcs[] = { {"aes_ctr_encrypt", 3, aes_ctr_encrypt}, {"aes_ctr_decrypt", 3, aes_ctr_encrypt}, {"rand_bytes", 1, rand_bytes_1}, + {"strong_rand_bytes_nif", 1, strong_rand_bytes_nif}, {"rand_bytes", 3, rand_bytes_3}, + {"strong_rand_mpint_nif", 3, strong_rand_mpint_nif}, {"rand_uniform_nif", 2, rand_uniform_nif}, {"mod_exp_nif", 3, mod_exp_nif}, {"dss_verify", 4, dss_verify}, @@ -704,6 +708,22 @@ static ERL_NIF_TERM rand_bytes_1(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes); return ret; } +static ERL_NIF_TERM strong_rand_bytes_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Bytes) */ + unsigned bytes; + unsigned char* data; + ERL_NIF_TERM ret; + if (!enif_get_uint(env, argv[0], &bytes)) { + return enif_make_badarg(env); + } + data = enif_make_new_binary(env, bytes, &ret); + if ( RAND_bytes(data, bytes) != 1) { + return atom_false; + } + ERL_VALGRIND_MAKE_MEM_DEFINED(data, bytes); + return ret; +} + static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Bytes, TopMask, BottomMask) */ unsigned bytes; @@ -724,6 +744,47 @@ static ERL_NIF_TERM rand_bytes_3(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar } return ret; } +static ERL_NIF_TERM strong_rand_mpint_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) +{/* (Bytes, TopMask, BottomMask) */ + unsigned bits; + BIGNUM *bn_rand; + int top, bottom; + unsigned char* data; + unsigned dlen; + ERL_NIF_TERM ret; + if (!enif_get_uint(env, argv[0], &bits) + || !enif_get_int(env, argv[1], &top) + || !enif_get_int(env, argv[2], &bottom)) { + return enif_make_badarg(env); + } + if (! (top == -1 || top == 0 || top == 1) ) { + return enif_make_badarg(env); + } + if (! (bottom == 0 || bottom == 1) ) { + return enif_make_badarg(env); + } + + bn_rand = BN_new(); + if (! bn_rand ) { + return enif_make_badarg(env); + } + + /* Get a (bits) bit random number */ + if (!BN_rand(bn_rand, bits, top, bottom)) { + ret = atom_false; + } + else { + /* Copy the bignum into an erlang mpint binary. */ + dlen = BN_num_bytes(bn_rand); + data = enif_make_new_binary(env, dlen+4, &ret); + put_int32(data, dlen); + BN_bn2bin(bn_rand, data+4); + ERL_VALGRIND_MAKE_MEM_DEFINED(data+4, dlen); + } + BN_free(bn_rand); + + return ret; +} static int get_bn_from_mpint(ErlNifEnv* env, ERL_NIF_TERM term, BIGNUM** bnp) { diff --git a/lib/crypto/doc/src/crypto.xml b/lib/crypto/doc/src/crypto.xml index c407350c47..1ccea6df79 100644 --- a/lib/crypto/doc/src/crypto.xml +++ b/lib/crypto/doc/src/crypto.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1999</year><year>2010</year> + <year>1999</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -419,16 +419,18 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> <fsummary>Encrypt the first 64 bits of <c>Text</c> using Blowfish in ECB mode</fsummary> <type> <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> + <v>Cipher = binary()</v> </type> <desc> <p>Encrypts the first 64 bits of <c>Text</c> using Blowfish in ECB mode. <c>Key</c> is the Blowfish key. The length of <c>Text</c> must be at least 64 bits (8 bytes).</p> </desc> + </func> + <func> <name>blowfish_ecb_decrypt(Key, Text) -> Cipher</name> <fsummary>Decrypt the first 64 bits of <c>Text</c> using Blowfish in ECB mode</fsummary> <type> <v>Key = Text = iolist() | binary()</v> - <v>IVec = Cipher = binary()</v> + <v>Cipher = binary()</v> </type> <desc> <p>Decrypts the first 64 bits of <c>Text</c> using Blowfish in ECB mode. <c>Key</c> is the Blowfish key. The length of <c>Text</c> must be at least 64 bits (8 bytes).</p> @@ -436,7 +438,7 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </func> <func> - <name>blowfish_cbc_encrypt(Key, Text) -> Cipher</name> + <name>blowfish_cbc_encrypt(Key, IVec, Text) -> Cipher</name> <fsummary>Encrypt <c>Text</c> using Blowfish in CBC mode</fsummary> <type> <v>Key = Text = iolist() | binary()</v> @@ -447,7 +449,9 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> arbitrary initializing vector. The length of <c>IVec</c> must be 64 bits (8 bytes). The length of <c>Text</c> must be a multiple of 64 bits (8 bytes).</p> </desc> - <name>blowfish_cbc_decrypt(Key, Text) -> Cipher</name> + </func> + <func> + <name>blowfish_cbc_decrypt(Key, IVec, Text) -> Cipher</name> <fsummary>Decrypt <c>Text</c> using Blowfish in CBC mode</fsummary> <type> <v>Key = Text = iolist() | binary()</v> @@ -615,6 +619,21 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </desc> </func> <func> + <name>strong_rand_bytes(N) -> binary()</name> + <fsummary>Generate a binary of random bytes</fsummary> + <type> + <v>N = integer()</v> + </type> + <desc> + <p>Generates N bytes randomly uniform 0..255, and returns the + result in a binary. Uses a cryptographically secure prng seeded and + periodically mixed with operating system provided entropy. By default + this is the <c>RAND_bytes</c> method from OpenSSL.</p> + <p>May throw exception <c>low_entropy</c> in case the random generator + failed due to lack of secure "randomness".</p> + </desc> + </func> + <func> <name>rand_uniform(Lo, Hi) -> N</name> <fsummary>Generate a random number</fsummary> <type> @@ -629,6 +648,31 @@ Mpint() = <![CDATA[<<ByteLen:32/integer-big, Bytes:ByteLen/binary>>]]> </desc> </func> <func> + <name>strong_rand_mpint(N, Top, Bottom) -> Mpint</name> + <fsummary>Generate an N bit random number</fsummary> + <type> + <v>N = non_neg_integer()</v> + <v>Top = -1 | 0 | 1</v> + <v>Bottom = 0 | 1</v> + <v>Mpint = binary()</v> + </type> + <desc> + <p>Generate an N bit random number using OpenSSL's + cryptographically strong pseudo random number generator + <c>BN_rand</c>.</p> + <p>The parameter <c>Top</c> places constraints on the most + significant bits of the generated number. If <c>Top</c> is 1, then the + two most significant bits will be set to 1, if <c>Top</c> is 0, the + most significant bit will be 1, and if <c>Top</c> is -1 then no + constraints are applied and thus the generated number may be less than + N bits long.</p> + <p>If <c>Bottom</c> is 1, then the generated number is + constrained to be odd.</p> + <p>May throw exception <c>low_entropy</c> in case the random generator + failed due to lack of secure "randomness".</p> + </desc> + </func> + <func> <name>mod_exp(N, P, M) -> Result</name> <fsummary>Perform N ^ P mod M</fsummary> <type> diff --git a/lib/crypto/doc/src/notes.xml b/lib/crypto/doc/src/notes.xml index 5e9bda3920..ab1ffa9e5c 100644 --- a/lib/crypto/doc/src/notes.xml +++ b/lib/crypto/doc/src/notes.xml @@ -4,7 +4,7 @@ <chapter> <header> <copyright> - <year>1999</year><year>2010</year> + <year>1999</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -30,6 +30,21 @@ </header> <p>This document describes the changes made to the Crypto application.</p> +<section><title>Crypto 2.0.2.2</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Strengthened random number generation. (Thanks to Geoff Cant)</p> + <p> + Own Id: OTP-9225</p> + </item> + </list> + </section> + +</section> + <section><title>Crypto 2.0.2.1</title> <section><title>Improvements and New Features</title> diff --git a/lib/crypto/src/crypto.erl b/lib/crypto/src/crypto.erl index d6e2e033c0..cc7b3acc9c 100644 --- a/lib/crypto/src/crypto.erl +++ b/lib/crypto/src/crypto.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2010. All Rights Reserved. +%% Copyright Ericsson AB 1999-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -46,6 +46,7 @@ -export([rsa_private_encrypt/3, rsa_public_decrypt/3]). -export([dh_generate_key/1, dh_generate_key/2, dh_compute_key/3]). -export([rand_bytes/1, rand_bytes/3, rand_uniform/2]). +-export([strong_rand_bytes/1, strong_rand_mpint/3]). -export([mod_exp/3, mpint/1, erlint/1]). %% -export([idea_cbc_encrypt/3, idea_cbc_decrypt/3]). -export([aes_cbc_128_encrypt/3, aes_cbc_128_decrypt/3]). @@ -68,6 +69,8 @@ des_ede3_cbc_encrypt, des_ede3_cbc_decrypt, aes_cfb_128_encrypt, aes_cfb_128_decrypt, rand_bytes, + strong_rand_bytes, + strong_rand_mpint, rand_uniform, mod_exp, dss_verify,dss_sign, @@ -361,12 +364,32 @@ aes_cfb_128_crypt(_Key, _IVec, _Data, _IsEncrypt) -> ?nif_stub. %% RAND - pseudo random numbers using RN_ functions in crypto lib %% -spec rand_bytes(non_neg_integer()) -> binary(). +-spec strong_rand_bytes(non_neg_integer()) -> binary(). -spec rand_uniform(crypto_integer(), crypto_integer()) -> crypto_integer(). +-spec strong_rand_mpint(Bits::non_neg_integer(), + Top::-1..1, + Bottom::0..1) -> binary(). rand_bytes(_Bytes) -> ?nif_stub. + +strong_rand_bytes(Bytes) -> + case strong_rand_bytes_nif(Bytes) of + false -> erlang:error(low_entropy); + Bin -> Bin + end. +strong_rand_bytes_nif(_Bytes) -> ?nif_stub. + rand_bytes(_Bytes, _Topmask, _Bottommask) -> ?nif_stub. +strong_rand_mpint(Bits, Top, Bottom) -> + case strong_rand_mpint_nif(Bits,Top,Bottom) of + false -> erlang:error(low_entropy); + Bin -> Bin + end. +strong_rand_mpint_nif(_Bits, _Top, _Bottom) -> ?nif_stub. + + rand_uniform(From,To) when is_binary(From), is_binary(To) -> case rand_uniform_nif(From,To) of <<Len:32/integer, MSB, Rest/binary>> when MSB > 127 -> diff --git a/lib/crypto/test/Makefile b/lib/crypto/test/Makefile index f4689a23df..3150bd472d 100644 --- a/lib/crypto/test/Makefile +++ b/lib/crypto/test/Makefile @@ -77,7 +77,7 @@ release_spec: release_tests_spec: $(TEST_TARGET) $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) crypto.spec crypto.cover $(RELTEST_FILES) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) release_docs_spec: diff --git a/lib/crypto/test/crypto_SUITE.erl b/lib/crypto/test/crypto_SUITE.erl index fe8f8e69a0..854a8b4485 100644 --- a/lib/crypto/test/crypto_SUITE.erl +++ b/lib/crypto/test/crypto_SUITE.erl @@ -46,6 +46,7 @@ aes_ctr/1, mod_exp_test/1, rand_uniform_test/1, + strong_rand_test/1, rsa_verify_test/1, dsa_verify_test/1, rsa_sign_test/1, @@ -68,7 +69,8 @@ all() -> md5_mac_io, sha, sha_update, %% sha256, sha256_update, sha512,sha512_update, des_cbc, aes_cfb, aes_cbc, - aes_cbc_iter, aes_ctr, des_cbc_iter, des_ecb, rand_uniform_test, + aes_cbc_iter, aes_ctr, des_cbc_iter, des_ecb, + rand_uniform_test, strong_rand_test, rsa_verify_test, dsa_verify_test, rsa_sign_test, dsa_sign_test, rsa_encrypt_decrypt, dh, exor_test, rc4_test, rc4_stream_test, mod_exp_test, blowfish_cfb64, @@ -710,6 +712,33 @@ rand_uniform_aux_test(N) -> %% %% +strong_rand_test(doc) -> + "strong_rand_mpint and strong_random_bytes testing"; +strong_rand_test(suite) -> + []; +strong_rand_test(Config) when is_list(Config) -> + strong_rand_aux_test(180), + ?line 10 = byte_size(crypto:strong_rand_bytes(10)). + +strong_rand_aux_test(0) -> + ?line t(crypto:strong_rand_mpint(0,0,0) =:= <<0,0,0,0>>), + ok; +strong_rand_aux_test(1) -> + ?line t(crypto:erlint(crypto:strong_rand_mpint(1,0,1)) =:= 1), + ?line strong_rand_aux_test(0); +strong_rand_aux_test(N) -> + ?line t(sru_length(crypto:strong_rand_mpint(N,-1,0)) =< N), + ?line t(sru_length(crypto:strong_rand_mpint(N,0,0)) =:= N), + ?line t(crypto:erlint(crypto:strong_rand_mpint(N,0,1)) band 1 =:= 1), + ?line t(crypto:erlint(crypto:strong_rand_mpint(N,1,0)) bsr (N - 2) =:= 2#11), + ?line strong_rand_aux_test(N-1). + +sru_length(Mpint) -> + I = crypto:erlint(Mpint), + length(erlang:integer_to_list(I, 2)). + +%% +%% %% %% rsa_verify_test(doc) -> @@ -1097,7 +1126,7 @@ worker_loop(0, _) -> ok; worker_loop(N, Config) -> Funcs = { md5, md5_update, md5_mac, md5_mac_io, sha, sha_update, des_cbc, - aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test, + aes_cfb, aes_cbc, des_cbc_iter, rand_uniform_test, strong_rand_test, rsa_verify_test, exor_test, rc4_test, rc4_stream_test, mod_exp_test }, F = element(random:uniform(size(Funcs)),Funcs), diff --git a/lib/crypto/vsn.mk b/lib/crypto/vsn.mk index e2d6fd0b37..740c68d8fa 100644 --- a/lib/crypto/vsn.mk +++ b/lib/crypto/vsn.mk @@ -1 +1 @@ -CRYPTO_VSN = 2.0.2.1 +CRYPTO_VSN = 2.0.2.2 diff --git a/lib/debugger/test/Makefile b/lib/debugger/test/Makefile index 4409cd2b38..2296bd0ae6 100644 --- a/lib/debugger/test/Makefile +++ b/lib/debugger/test/Makefile @@ -100,7 +100,7 @@ release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(RELSYSDIR) $(INSTALL_DATA) debugger.spec debugger.cover $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/dialyzer/doc/manual.txt b/lib/dialyzer/doc/manual.txt index 1d7a1a6222..d519ac960b 100644 --- a/lib/dialyzer/doc/manual.txt +++ b/lib/dialyzer/doc/manual.txt @@ -37,7 +37,7 @@ The parameters are: The analysis starts from .beam bytecode files. The files must be compiled with +debug_info. - Source code: - The analysis starts from .erl files. + The analysis starts from .erl files. Controlling the discrepancies reported by the Dialyzer ====================================================== @@ -131,7 +131,7 @@ Usage: dialyzer [--help] [--version] [--shell] [--quiet] [--verbose] [--check_plt] [--no_check_plt] [--plt_info] [--get_warnings] [--no_native] [--fullpath] -Options: +Options: files_or_dirs (for backwards compatibility also as: -c files_or_dirs) Use Dialyzer from the command line to detect defects in the specified files or directories containing .erl or .beam files, @@ -169,7 +169,7 @@ Options: --output_plt file Store the plt at the specified file after building it. --plt plt - Use the specified plt as the initial plt (if the plt was built + Use the specified plt as the initial plt (if the plt was built during setup the files will be checked for consistency). --plts plt* Merge the specified plts to create the initial plt -- requires @@ -204,8 +204,8 @@ Options: --add_to_plt The plt is extended to also include the files specified with -c and -r. Use --plt to specify which plt to start from, and --output_plt to - specify where to put the plt. Note that the analysis might include - files from the plt if they depend on the new files. + specify where to put the plt. Note that the analysis might include + files from the plt if they depend on the new files. This option only works with beam files. --remove_from_plt The information from the files specified with -c and -r is removed @@ -269,13 +269,13 @@ Warning options: Include warnings about behaviour callbacks which drift from the published recommended interfaces. -Wunderspecs *** - Warn about underspecified functions + Warn about underspecified functions (those whose -spec is strictly more allowing than the success typing). The following options are also available but their use is not recommended: (they are mostly for Dialyzer developers and internal debugging) -Woverspecs *** - Warn about overspecified functions + Warn about overspecified functions (those whose -spec is strictly less allowing than the success typing). -Wspecdiffs *** Warn when the -spec is different than the success typing. @@ -306,8 +306,8 @@ dialyzer:run(OptList) -> Warnings Warnings :: [{tag(), id(), msg()}] tag() :: 'warn_return_no_exit' | 'warn_return_only_exit' | 'warn_not_called' | 'warn_non_proper_list' | 'warn_fun_app' | 'warn_matching' - | 'warn_failing_call' | 'warn_contract_types' - | 'warn_contract_syntax' | 'warn_contract_not_equal' + | 'warn_failing_call' | 'warn_contract_types' + | 'warn_contract_syntax' | 'warn_contract_not_equal' | 'warn_contract_subtype' | 'warn_contract_supertype' id() :: {File :: string(), Line :: integer()} msg() :: Undefined @@ -319,24 +319,31 @@ Option :: {files, [Filename :: string()]} | {from, src_code | byte_code} %% Defaults to byte_code | {init_plt, FileName :: string()} %% If changed from default | {plts, [FileName :: string()]} %% If changed from default - | {include_dirs, [DirName :: string()]} + | {include_dirs, [DirName :: string()]} | {output_file, FileName :: string()} | {output_plt, FileName :: string()} | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'} | {warnings, [WarnOpts]} + | {get_warnings, bool()} WarnOpts :: no_return | no_unused | no_improper_lists | no_fun_app | no_match + | no_opaque | no_fail_call - | unmatched_returns | error_handling + | race_conditions + | behaviours + | unmatched_returns + | overspecs + | underspecs + | specdiffs dialyzer:format_warning({tag(), id(), msg()}) -> string() - + Returns a string representation of the warnings as returned by dialyzer:run/1. dialyzer:plt_info(string()) -> {'ok', [{atom(), any()}]} | {'error', atom()} @@ -392,7 +399,7 @@ files that depend on these files. Note that this consistency check will be performed automatically the next time you run Dialyzer with this plt. The --check_plt option is merely for doing so without doing any other analysis. - + ----------------------------------------------- -- -- Feedback & bug reports diff --git a/lib/dialyzer/doc/src/dialyzer.xml b/lib/dialyzer/doc/src/dialyzer.xml index b6547b11e1..4080dfdf77 100644 --- a/lib/dialyzer/doc/src/dialyzer.xml +++ b/lib/dialyzer/doc/src/dialyzer.xml @@ -241,7 +241,7 @@ <item>Include warnings about behaviour callbacks which drift from the published recommended interfaces.</item> <tag><c><![CDATA[-Wunderspecs]]></c>***</tag> - <item>Warn about underspecified functions + <item>Warn about underspecified functions (the -spec is strictly more allowing than the success typing).</item> </taglist> <p>The following options are also available but their use is not @@ -249,7 +249,7 @@ debugging)</p> <taglist> <tag><c><![CDATA[-Woverspecs]]></c>***</tag> - <item>Warn about overspecified functions + <item>Warn about overspecified functions (the -spec is strictly less allowing than the success typing).</item> <tag><c><![CDATA[-Wspecdiffs]]></c>***</tag> <item>Warn when the -spec is different than the success typing.</item> @@ -278,34 +278,34 @@ <desc> <p>Dialyzer GUI version.</p> <code type="none"><![CDATA[ -OptList : [Option] -Option : {files, [Filename : string()]} - | {files_rec, [DirName : string()]} - | {defines, [{Macro: atom(), Value : term()}]} - | {from, src_code | byte_code} %% Defaults to byte_code - | {init_plt, FileName : string()} %% If changed from default - | {plts, [FileName :: string()]} %% If changed from default - | {include_dirs, [DirName : string()]} - | {output_file, FileName : string()} - | {output_plt, FileName :: string()} - | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'} - | {warnings, [WarnOpts]} - | {get_warnings, bool()} +OptList :: [Option] +Option :: {files, [Filename :: string()]} + | {files_rec, [DirName :: string()]} + | {defines, [{Macro: atom(), Value : term()}]} + | {from, src_code | byte_code} %% Defaults to byte_code + | {init_plt, FileName :: string()} %% If changed from default + | {plts, [FileName :: string()]} %% If changed from default + | {include_dirs, [DirName :: string()]} + | {output_file, FileName :: string()} + | {output_plt, FileName :: string()} + | {analysis_type, 'succ_typings' | 'plt_add' | 'plt_build' | 'plt_check' | 'plt_remove'} + | {warnings, [WarnOpts]} + | {get_warnings, bool()} -WarnOpts : no_return - | no_unused - | no_improper_lists - | no_fun_app - | no_match - | no_opaque - | no_fail_call - | error_handling - | race_conditions - | behaviours - | unmatched_returns - | overspecs - | underspecs - | specdiffs +WarnOpts :: no_return + | no_unused + | no_improper_lists + | no_fun_app + | no_match + | no_opaque + | no_fail_call + | error_handling + | race_conditions + | behaviours + | unmatched_returns + | overspecs + | underspecs + | specdiffs ]]></code> </desc> </func> @@ -320,12 +320,12 @@ WarnOpts : no_return <p>Dialyzer command line version.</p> <code type="none"><![CDATA[ Warnings :: [{Tag, Id, Msg}] -Tag : 'warn_return_no_exit' | 'warn_return_only_exit' - | 'warn_not_called' | 'warn_non_proper_list' - | 'warn_fun_app' | 'warn_matching' - | 'warn_failing_call' | 'warn_contract_types' - | 'warn_contract_syntax' | 'warn_contract_not_equal' - | 'warn_contract_subtype' | 'warn_contract_supertype' +Tag :: 'warn_return_no_exit' | 'warn_return_only_exit' + | 'warn_not_called' | 'warn_non_proper_list' + | 'warn_fun_app' | 'warn_matching' + | 'warn_failing_call' | 'warn_contract_types' + | 'warn_contract_syntax' | 'warn_contract_not_equal' + | 'warn_contract_subtype' | 'warn_contract_supertype' Id = {File :: string(), Line :: integer()} Msg = msg() -- Undefined ]]></code> diff --git a/lib/dialyzer/src/dialyzer_plt.erl b/lib/dialyzer/src/dialyzer_plt.erl index 8d62f2c529..6033d7f17c 100644 --- a/lib/dialyzer/src/dialyzer_plt.erl +++ b/lib/dialyzer/src/dialyzer_plt.erl @@ -317,7 +317,7 @@ merge_plts_or_report_conflicts(PltFiles, Plts) -> Msg = io_lib:format("Could not merge PLTs since they are not disjoint\n" "The following files are included in more than one " "PLTs:\n~p\n", [ConfFiles]), - error(Msg) + plt_error(Msg) end. find_duplicates(List) -> diff --git a/lib/dialyzer/src/dialyzer_succ_typings.erl b/lib/dialyzer/src/dialyzer_succ_typings.erl index 24d6013692..b8da57d3f9 100644 --- a/lib/dialyzer/src/dialyzer_succ_typings.erl +++ b/lib/dialyzer/src/dialyzer_succ_typings.erl @@ -155,19 +155,24 @@ postprocess_dataflow_warns(RawWarnings, State, WarnAcc) -> postprocess_dataflow_warns([], _State, WAcc, Acc) -> {WAcc, lists:reverse(Acc)}; -postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {File, CallL}, Msg}|Rest], +postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {CallF, CallL}, Msg}|Rest], #st{codeserver = Codeserver} = State, WAcc, Acc) -> {contract_range, [Contract, M, F, A, ArgStrings, CRet]} = Msg, - {ok, {{File, _ContrL} = FileLine, _C}} = + {ok, {{ContrF, _ContrL} = FileLine, _C}} = dialyzer_codeserver:lookup_mfa_contract({M,F,A}, Codeserver), - NewMsg = - {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]}, - W = {?WARN_CONTRACT_RANGE, FileLine, NewMsg}, - Filter = - fun({?WARN_CONTRACT_TYPES, FL, _}) when FL =:= FileLine -> false; - (_) -> true - end, - postprocess_dataflow_warns(Rest, State, lists:filter(Filter, WAcc), [W|Acc]); + case CallF =:= ContrF of + true -> + NewMsg = {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]}, + W = {?WARN_CONTRACT_RANGE, FileLine, NewMsg}, + Filter = + fun({?WARN_CONTRACT_TYPES, FL, _}) when FL =:= FileLine -> false; + (_) -> true + end, + FilterWAcc = lists:filter(Filter, WAcc), + postprocess_dataflow_warns(Rest, State, FilterWAcc, [W|Acc]); + false -> + postprocess_dataflow_warns(Rest, State, WAcc, Acc) + end; postprocess_dataflow_warns([W|Rest], State, Wacc, Acc) -> postprocess_dataflow_warns(Rest, State, Wacc, [W|Acc]). diff --git a/lib/dialyzer/test/small_tests_SUITE.erl b/lib/dialyzer/test/small_tests_SUITE.erl index 21a2c76160..dbcc044eea 100644 --- a/lib/dialyzer/test/small_tests_SUITE.erl +++ b/lib/dialyzer/test/small_tests_SUITE.erl @@ -18,18 +18,18 @@ contract5/1, disj_norm_form/1, eqeq/1, ets_select/1, exhaust_case/1, failing_guard1/1, flatten/1, fun_app/1, fun_ref_match/1, fun_ref_record/1, gencall/1, gs_make/1, - inf_loop2/1, letrec1/1, list_match/1, lzip/1, make_tuple/1, - minus_minus/1, mod_info/1, my_filter/1, my_sofs/1, no_match/1, - no_unused_fun/1, no_unused_fun2/1, non_existing/1, - not_guard_crash/1, or_bug/1, orelsebug/1, orelsebug2/1, - overloaded1/1, port_info_test/1, process_info_test/1, pubsub/1, - receive1/1, record_construct/1, record_pat/1, - record_send_test/1, record_test/1, recursive_types1/1, - recursive_types2/1, recursive_types3/1, recursive_types4/1, - recursive_types5/1, recursive_types6/1, recursive_types7/1, - refine_bug1/1, toth/1, trec/1, try1/1, tuple1/1, - unsafe_beamcode_bug/1, unused_cases/1, unused_clauses/1, - zero_tuple/1]). + inf_loop2/1, invalid_specs/1, letrec1/1, list_match/1, lzip/1, + make_tuple/1, minus_minus/1, mod_info/1, my_filter/1, + my_sofs/1, no_match/1, no_unused_fun/1, no_unused_fun2/1, + non_existing/1, not_guard_crash/1, or_bug/1, orelsebug/1, + orelsebug2/1, overloaded1/1, port_info_test/1, + process_info_test/1, pubsub/1, receive1/1, record_construct/1, + record_pat/1, record_send_test/1, record_test/1, + recursive_types1/1, recursive_types2/1, recursive_types3/1, + recursive_types4/1, recursive_types5/1, recursive_types6/1, + recursive_types7/1, refine_bug1/1, toth/1, trec/1, try1/1, + tuple1/1, unsafe_beamcode_bug/1, unused_cases/1, + unused_clauses/1, zero_tuple/1]). suite() -> [{timetrap, {minutes, 1}}]. @@ -51,10 +51,10 @@ all() -> atom_guard,atom_widen,bs_fail_constr,bs_utf8,cerl_hipeify,comm_layer, compare1,confusing_warning,contract2,contract3,contract5,disj_norm_form, eqeq,ets_select,exhaust_case,failing_guard1,flatten,fun_app,fun_ref_match, - fun_ref_record,gencall,gs_make,inf_loop2,letrec1,list_match,lzip, - make_tuple,minus_minus,mod_info,my_filter,my_sofs,no_match,no_unused_fun, - no_unused_fun2,non_existing,not_guard_crash,or_bug,orelsebug,orelsebug2, - overloaded1,port_info_test,process_info_test,pubsub,receive1, + fun_ref_record,gencall,gs_make,inf_loop2,invalid_specs,letrec1,list_match, + lzip,make_tuple,minus_minus,mod_info,my_filter,my_sofs,no_match, + no_unused_fun,no_unused_fun2,non_existing,not_guard_crash,or_bug,orelsebug, + orelsebug2,overloaded1,port_info_test,process_info_test,pubsub,receive1, record_construct,record_pat,record_send_test,record_test,recursive_types1, recursive_types2,recursive_types3,recursive_types4,recursive_types5, recursive_types6,recursive_types7,refine_bug1,toth,trec,try1,tuple1, @@ -235,6 +235,12 @@ inf_loop2(Config) -> Error -> ct:fail(Error) end. +invalid_specs(Config) -> + case dialyze(Config, invalid_specs) of + 'same' -> 'same'; + Error -> ct:fail(Error) + end. + letrec1(Config) -> case dialyze(Config, letrec1) of 'same' -> 'same'; diff --git a/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs b/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs new file mode 100644 index 0000000000..c95c0ff1f8 --- /dev/null +++ b/lib/dialyzer/test/small_tests_SUITE_data/results/invalid_specs @@ -0,0 +1,3 @@ + +invalid_spec1.erl:5: Invalid type specification for function invalid_spec1:get_plan_dirty/1. The success typing is ([string()]) -> {maybe_improper_list(),[atom()]} +invalid_spec2.erl:5: Function foo/0 has no local return diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl new file mode 100644 index 0000000000..06ab2f9a22 --- /dev/null +++ b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec1.erl @@ -0,0 +1,28 @@ +-module(invalid_spec1). + +-export([get_plan_dirty/1]). + +-spec get_plan_dirty([string()]) -> {{atom(), any()}, [atom()]}. + +get_plan_dirty(ClassL) -> + get_plan_dirty(ClassL, [], []). + +get_plan_dirty([], Res, FoundClassList) -> + {Res,FoundClassList}; +get_plan_dirty([Class|ClassL], Res, FoundClassList) -> + ClassPlan = list_to_atom(Class ++ "_plan"), + case catch mnesia:dirty_all_keys(ClassPlan) of + {'EXIT',_} -> + get_plan_dirty(ClassL, Res, FoundClassList); + [] -> + get_plan_dirty(ClassL, Res, FoundClassList); + KeyL -> + ClassAtom = list_to_atom(Class), + Res2 = + lists:foldl(fun(Key, Acc) -> + [{ClassAtom,Key}|Acc] + end, + Res, + KeyL), + get_plan_dirty(ClassL, Res2, [ClassAtom|FoundClassList]) + end. diff --git a/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl new file mode 100644 index 0000000000..e49f73d014 --- /dev/null +++ b/lib/dialyzer/test/small_tests_SUITE_data/src/invalid_specs/invalid_spec2.erl @@ -0,0 +1,11 @@ +-module(invalid_spec2). + +-export([foo/0]). + +foo() -> + case + invalid_spec1:get_plan_dirty(mnesia:dirty_all_keys(cmClassInfo)) + of + {[],[]} -> foo; + { _, _} -> bar + end. diff --git a/lib/docbuilder/test/Makefile b/lib/docbuilder/test/Makefile index 96b940033e..53dff193dc 100644 --- a/lib/docbuilder/test/Makefile +++ b/lib/docbuilder/test/Makefile @@ -72,7 +72,7 @@ release_spec: opt release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(SPEC_FILES) docb.cover $(EMAKEFILE) $(ERL_FILES) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/edoc/test/Makefile b/lib/edoc/test/Makefile index f77bbaa09b..2dbdb77eff 100644 --- a/lib/edoc/test/Makefile +++ b/lib/edoc/test/Makefile @@ -60,7 +60,7 @@ release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(RELSYSDIR) $(INSTALL_DATA) edoc.spec edoc.cover $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/erl_interface/src/legacy/erl_timeout.c b/lib/erl_interface/src/legacy/erl_timeout.c index d9560eebc8..146a106e7c 100644 --- a/lib/erl_interface/src/legacy/erl_timeout.c +++ b/lib/erl_interface/src/legacy/erl_timeout.c @@ -43,6 +43,7 @@ # endif #endif +#include "erl_interface.h" #include "erl_timeout.h" typedef struct jmp_s { diff --git a/lib/erl_interface/test/Makefile b/lib/erl_interface/test/Makefile index 8ed6834443..4faf89c0d6 100644 --- a/lib/erl_interface/test/Makefile +++ b/lib/erl_interface/test/Makefile @@ -73,7 +73,7 @@ release_spec: release_tests_spec: opt $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(SPEC_FILES) $(COVER_FILE) $(ERL_FILES) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/et/test/Makefile b/lib/et/test/Makefile index 9a24e3281b..e10a2a1587 100644 --- a/lib/et/test/Makefile +++ b/lib/et/test/Makefile @@ -74,7 +74,7 @@ release_tests_spec: opt $(INSTALL_DATA) et.spec et.cover $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR) $(INSTALL_SCRIPT) ett $(RELSYSDIR) $(INSTALL_DATA) $(INSTALL_PROGS) $(RELSYSDIR) -# chmod -f -R u+w $(RELSYSDIR) +# chmod -R u+w $(RELSYSDIR) # @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/eunit/src/eunit.erl b/lib/eunit/src/eunit.erl index 4a86a108cf..da35c5c2ec 100644 --- a/lib/eunit/src/eunit.erl +++ b/lib/eunit/src/eunit.erl @@ -157,6 +157,7 @@ test_run(Reference, Listeners) -> receive {done, Reference} -> cast(Listeners, {stop, Reference, self()}), + wait_until_listeners_have_terminated(Listeners), receive {result, Reference, Result} -> Result @@ -169,6 +170,15 @@ cast([P | Ps], Msg) -> cast([], _Msg) -> ok. +wait_until_listeners_have_terminated([P | Ps]) -> + MRef = erlang:monitor(process, P), + receive + {'DOWN', MRef, process, P, _} -> + wait_until_listeners_have_terminated(Ps) + end; +wait_until_listeners_have_terminated([]) -> + ok. + %% TODO: functions that run tests on a given node, not a given server %% TODO: maybe some functions could check for a globally registered server? %% TODO: some synchronous but completely quiet interface function diff --git a/lib/eunit/src/eunit_lib.erl b/lib/eunit/src/eunit_lib.erl index 4751f1094a..45d2387e7b 100644 --- a/lib/eunit/src/eunit_lib.erl +++ b/lib/eunit/src/eunit_lib.erl @@ -33,7 +33,7 @@ -export([dlist_next/1, uniq/1, fun_parent/1, is_string/1, command/1, command/2, command/3, trie_new/0, trie_store/2, trie_match/2, split_node/1, consult_file/1, list_dir/1, format_exit_term/1, - format_exception/1, format_error/1]). + format_exception/1, format_exception/2, format_error/1]). %% Type definitions for describing exceptions @@ -55,21 +55,23 @@ %% --------------------------------------------------------------------- %% Formatting of error descriptors +format_exception(Exception) -> + format_exception(Exception, 20). -format_exception({Class,Term,Trace}) +format_exception({Class,Term,Trace}, Depth) when is_atom(Class), is_list(Trace) -> case is_stacktrace(Trace) of true -> io_lib:format("~w:~P\n~s", - [Class, Term, 20, format_stacktrace(Trace)]); + [Class, Term, Depth, format_stacktrace(Trace)]); false -> - format_term(Term) + format_term(Term, Depth) end; -format_exception(Term) -> - format_term(Term). +format_exception(Term, Depth) -> + format_term(Term, Depth). -format_term(Term) -> - io_lib:format("~P\n", [Term, 15]). +format_term(Term, Depth) -> + io_lib:format("~P\n", [Term, Depth]). format_exit_term(Term) -> {Reason, Trace} = analyze_exit_term(Term), diff --git a/lib/eunit/src/eunit_surefire.erl b/lib/eunit/src/eunit_surefire.erl index eb994a990a..dfb08c90b2 100644 --- a/lib/eunit/src/eunit_surefire.erl +++ b/lib/eunit/src/eunit_surefire.erl @@ -100,16 +100,10 @@ terminate({ok, _Data}, St) -> XmlDir = St#state.xmldir, write_report(TestSuite, XmlDir), ok; -terminate({error, Reason}, _St) -> - io:fwrite("Internal error: ~P.\n", [Reason, 25]), - sync_end(error). - -sync_end(Result) -> - receive - {stop, Reference, ReplyTo} -> - ReplyTo ! {result, Reference, Result}, - ok - end. +terminate({error, _Reason}, _St) -> + %% Don't report any errors here, since eunit_tty takes care of that. + %% Just terminate. + ok. handle_begin(group, Data, St) -> NewId = proplists:get_value(id, Data), @@ -323,7 +317,7 @@ write_testcase( format_testcase_result(ok) -> [<<>>]; format_testcase_result({failed, {error, {Type, _}, _} = Exception}) when is_atom(Type) -> [?INDENT, ?INDENT, <<"<failure type=\"">>, escape_attr(atom_to_list(Type)), <<"\">">>, ?NEWLINE, - <<"::">>, escape_text(eunit_lib:format_exception(Exception)), + <<"::">>, escape_text(eunit_lib:format_exception(Exception, 100)), ?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE]; format_testcase_result({failed, Term}) -> [?INDENT, ?INDENT, <<"<failure type=\"unknown\">">>, ?NEWLINE, @@ -331,7 +325,7 @@ format_testcase_result({failed, Term}) -> ?INDENT, ?INDENT, <<"</failure>">>, ?NEWLINE]; format_testcase_result({aborted, {Class, _Term, _Trace} = Exception}) when is_atom(Class) -> [?INDENT, ?INDENT, <<"<error type=\"">>, escape_attr(atom_to_list(Class)), <<"\">">>, ?NEWLINE, - <<"::">>, escape_text(eunit_lib:format_exception(Exception)), + <<"::">>, escape_text(eunit_lib:format_exception(Exception, 100)), ?INDENT, ?INDENT, <<"</error>">>, ?NEWLINE]; format_testcase_result({aborted, Term}) -> [?INDENT, ?INDENT, <<"<error type=\"unknown\">">>, ?NEWLINE, diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl index e81642fb33..99028cc3c1 100644 --- a/lib/hipe/main/hipe_main.erl +++ b/lib/hipe/main/hipe_main.erl @@ -2,7 +2,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -313,7 +313,7 @@ icode_ssa_struct_reuse(IcodeSSA, Options) -> icode_ssa_type_info(IcodeSSA, MFA, Options, Servers) -> ?option_time(hipe_icode_type:cfg(IcodeSSA, MFA, Options, Servers), - "Icode SSA type info", Options). + io_lib:format("Icode SSA type info for ~p", [MFA]), Options). icode_range_analysis(IcodeSSA, MFA, Options, Servers) -> case proplists:get_bool(icode_range, Options) of @@ -527,6 +527,8 @@ rtl_to_native(MFA, LinearRTL, Options, DebugState) -> hipe_sparc_main:rtl_to_sparc(MFA, LinearRTL, Options); powerpc -> hipe_ppc_main:rtl_to_ppc(MFA, LinearRTL, Options); + ppc64 -> + hipe_ppc_main:rtl_to_ppc(MFA, LinearRTL, Options); arm -> hipe_arm_main:rtl_to_arm(MFA, LinearRTL, Options); x86 -> diff --git a/lib/hipe/ppc/hipe_ppc.erl b/lib/hipe/ppc/hipe_ppc.erl index 047e86c45b..4014fc1561 100644 --- a/lib/hipe/ppc/hipe_ppc.erl +++ b/lib/hipe/ppc/hipe_ppc.erl @@ -1,20 +1,20 @@ %% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% @@ -58,6 +58,10 @@ mk_blr/0, mk_cmp/3, + cmpop_word/0, + cmpiop_word/0, + cmplop_word/0, + cmpliop_word/0, mk_comment/1, @@ -73,6 +77,8 @@ mk_loadx/4, mk_load/6, ldop_to_ldxop/1, + ldop_word/0, + ldop_wordx/0, mk_mfspr/2, @@ -110,6 +116,8 @@ mk_storex/4, mk_store/6, stop_to_stxop/1, + stop_word/0, + stop_wordx/0, mk_unary/3, @@ -189,6 +197,31 @@ mk_blr() -> #blr{}. mk_cmp(CmpOp, Src1, Src2) -> #cmp{cmpop=CmpOp, src1=Src1, src2=Src2}. +cmpop_word() -> + case get(hipe_target_arch) of + powerpc -> 'cmp'; + ppc64 -> 'cmpd' + end. + +cmpiop_word() -> + case get(hipe_target_arch) of + powerpc -> 'cmpi'; + ppc64 -> 'cmpdi' + end. + +cmplop_word() -> + case get(hipe_target_arch) of + powerpc -> 'cmpl'; + ppc64 -> 'cmpld' + end. + +cmpliop_word() -> + case get(hipe_target_arch) of + powerpc -> 'cmpli'; + ppc64 -> 'cmpldi' + end. + + mk_comment(Term) -> #comment{term=Term}. mk_label(Label) -> #label{label=Label}. @@ -198,9 +231,50 @@ label_label(#label{label=Label}) -> Label. %%% Load an integer constant into a register. mk_li(Dst, Value) -> mk_li(Dst, Value, []). -mk_li(Dst, Value, Tail) -> +mk_li(Dst, Value, Tail) -> % Dst can be R0 R0 = mk_temp(0, 'untagged'), - mk_addi(Dst, R0, Value, Tail). + %% Check if immediate can fit in the 32 bits, this is obviously a + %% sufficient check for PPC32 + if Value >= -16#80000000, + Value =< 16#7FFFFFFF -> + mk_li32(Dst, R0, Value, Tail); + true -> + Highest = (Value bsr 48), % Value@highest + Higher = (Value bsr 32) band 16#FFFF, % Value@higher + High = (Value bsr 16) band 16#FFFF, % Value@h + Low = Value band 16#FFFF, % Value@l + LdLo = + case Low of + 0 -> Tail; + _ -> [mk_alu('ori', Dst, Dst, mk_uimm16(Low)) | Tail] + end, + Ld32bits = + case High of + 0 -> LdLo; + _ -> [mk_alu('oris', Dst, Dst, mk_uimm16(High)) | LdLo] + end, + [mk_alu('addis', Dst, R0, mk_simm16(Highest)), + mk_alu('ori', Dst, Dst, mk_uimm16(Higher)), + mk_alu('sldi', Dst, Dst, mk_uimm16(32)) | + Ld32bits] + end. + +mk_li32(Dst, R0, Value, Tail) -> + case at_ha(Value) of + 0 -> + %% Value[31:16] are the sign-extension of Value[15]. + %% Use a single addi to load and sign-extend 16 bits. + [mk_alu('addi', Dst, R0, mk_simm16(at_l(Value))) | Tail]; + _ -> + %% Use addis to load the high 16 bits, followed by an + %% optional ori to load non sign-extended low 16 bits. + High = simm16sext((Value bsr 16) band 16#FFFF), + [mk_alu('addis', Dst, R0, mk_simm16(High)) | + case (Value band 16#FFFF) of + 0 -> Tail; + Low -> [mk_alu('ori', Dst, Dst, mk_uimm16(Low)) | Tail] + end] + end. mk_addi(Dst, R0, Value, Tail) -> Low = at_l(Value), @@ -232,27 +306,6 @@ simm16sext(Value) -> true -> Value end. -mk_li_new(Dst, Value, Tail) -> % Dst may be R0 - R0 = mk_temp(0, 'untagged'), - case at_ha(Value) of - 0 -> - %% Value[31:16] are the sign-extension of Value[15]. - %% Use a single addi to load and sign-extend 16 bits. - [mk_alu('addi', Dst, R0, mk_simm16(at_l(Value))) | - Tail]; - _ -> - %% Use addis to load the high 16 bits, followed by an - %% optional ori to load non sign-extended low 16 bits. - High = simm16sext((Value bsr 16) band 16#FFFF), - [mk_alu('addis', Dst, R0, mk_simm16(High)) | - case (Value band 16#FFFF) of - 0 -> Tail; - Low -> - [mk_alu('ori', Dst, Dst, mk_uimm16(Low)) | - Tail] - end] - end. - mk_load(LDop, Dst, Disp, Base) -> #load{ldop=LDop, dst=Dst, disp=Disp, base=Base}. @@ -260,8 +313,15 @@ mk_loadx(LdxOp, Dst, Base1, Base2) -> #loadx{ldxop=LdxOp, dst=Dst, base1=Base1, base2=Base2}. mk_load(LdOp, Dst, Offset, Base, Scratch, Rest) when is_integer(Offset) -> - if Offset >= -32768, Offset =< 32767 -> - [mk_load(LdOp, Dst, Offset, Base) | Rest]; + RequireAlignment = + case LdOp of + 'ld' -> true; + 'ldx' -> true; + _ -> false + end, + if Offset >= -32768, Offset =< 32767, + not RequireAlignment orelse Offset band 3 =:= 0 -> + [mk_load(LdOp, Dst, Offset, Base) | Rest]; true -> LdxOp = ldop_to_ldxop(LdOp), Index = @@ -272,8 +332,8 @@ mk_load(LdOp, Dst, Offset, Base, Scratch, Rest) when is_integer(Offset) -> true -> mk_scratch(Scratch) end end, - mk_li_new(Index, Offset, - [mk_loadx(LdxOp, Dst, Base, Index) | Rest]) + mk_li(Index, Offset, + [mk_loadx(LdxOp, Dst, Base, Index) | Rest]) end. ldop_to_ldxop(LdOp) -> @@ -281,7 +341,21 @@ ldop_to_ldxop(LdOp) -> 'lbz' -> 'lbzx'; 'lha' -> 'lhax'; 'lhz' -> 'lhzx'; - 'lwz' -> 'lwzx' + 'lwa' -> 'lwax'; + 'lwz' -> 'lwzx'; + 'ld' -> 'ldx' + end. + +ldop_word() -> + case get(hipe_target_arch) of + powerpc -> 'lwz'; + ppc64 -> 'ld' + end. + +ldop_wordx() -> + case get(hipe_target_arch) of + powerpc -> 'lwzx'; + ppc64 -> 'ldx' end. mk_scratch(Scratch) -> @@ -354,20 +428,40 @@ mk_storex(StxOp, Src, Base1, Base2) -> #storex{stxop=StxOp, src=Src, base1=Base1, base2=Base2}. mk_store(StOp, Src, Offset, Base, Scratch, Rest)when is_integer(Offset) -> - if Offset >= -32768, Offset =< 32767 -> + RequireAlignment = + case StOp of + 'std' -> true; + 'stdx' -> true; + _ -> false + end, + if Offset >= -32768, Offset =< 32767, + not RequireAlignment orelse Offset band 3 =:= 0 -> [mk_store(StOp, Src, Offset, Base) | Rest]; true -> StxOp = stop_to_stxop(StOp), Index = mk_scratch(Scratch), - mk_li_new(Index, Offset, - [mk_storex(StxOp, Src, Base, Index) | Rest]) + mk_li(Index, Offset, + [mk_storex(StxOp, Src, Base, Index) | Rest]) end. stop_to_stxop(StOp) -> case StOp of 'stb' -> 'stbx'; 'sth' -> 'sthx'; - 'stw' -> 'stwx' + 'stw' -> 'stwx'; + 'std' -> 'stdx' + end. + +stop_word() -> + case get(hipe_target_arch) of + powerpc -> 'stw'; + ppc64 -> 'std' + end. + +stop_wordx() -> + case get(hipe_target_arch) of + powerpc -> 'stwx'; + ppc64 -> 'stdx' end. mk_unary(UnOp, Dst, Src) -> #unary{unop=UnOp, dst=Dst, src=Src}. @@ -379,7 +473,7 @@ mk_fload(Dst, Offset, Base, Scratch) when is_integer(Offset) -> [mk_lfd(Dst, Offset, Base)]; true -> Index = mk_scratch(Scratch), - mk_li_new(Index, Offset, [mk_lfdx(Dst, Base, Index)]) + mk_li(Index, Offset, [mk_lfdx(Dst, Base, Index)]) end. mk_stfd(Src, Disp, Base) -> #stfd{src=Src, disp=Disp, base=Base}. @@ -389,7 +483,7 @@ mk_fstore(Src, Offset, Base, Scratch) when is_integer(Offset) -> [mk_stfd(Src, Offset, Base)]; true -> Index = mk_scratch(Scratch), - mk_li_new(Index, Offset, [mk_stfdx(Src, Base, Index)]) + mk_li(Index, Offset, [mk_stfdx(Src, Base, Index)]) end. mk_fp_binary(FpBinOp, Dst, Src1, Src2) -> diff --git a/lib/hipe/ppc/hipe_ppc_assemble.erl b/lib/hipe/ppc/hipe_ppc_assemble.erl index 6f06f8b841..b2fd50517b 100644 --- a/lib/hipe/ppc/hipe_ppc_assemble.erl +++ b/lib/hipe/ppc/hipe_ppc_assemble.erl @@ -1,20 +1,20 @@ %% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% @@ -39,7 +39,7 @@ assemble(CompiledCode, Closures, Exports, Options) -> || {MFA, Defun} <- CompiledCode], %% {ConstAlign,ConstSize,ConstMap,RefsFromConsts} = - hipe_pack_constants:pack_constants(Code, 4), + hipe_pack_constants:pack_constants(Code, hipe_rtl_arch:word_size()), %% {CodeSize,CodeBinary,AccRefs,LabelMap,ExportMap} = encode(translate(Code, ConstMap), Options), @@ -159,6 +159,13 @@ do_alu(I) -> 'srwi.' -> {'rlwinm.', do_srwi_opnds(NewDst, NewSrc1, NewSrc2)}; 'srawi' -> {'srawi', {NewDst,NewSrc1,do_srawi_src2(NewSrc2)}}; 'srawi.' -> {'srawi.', {NewDst,NewSrc1,do_srawi_src2(NewSrc2)}}; + %ppc64 extension + 'sldi' -> {'rldicr', do_sldi_opnds(NewDst, NewSrc1, NewSrc2)}; + 'sldi.' -> {'rldicr.', do_sldi_opnds(NewDst, NewSrc1, NewSrc2)}; + 'srdi' -> {'rldicl', do_srdi_opnds(NewDst, NewSrc1, NewSrc2)}; + 'srdi.' -> {'rldicl.', do_srdi_opnds(NewDst, NewSrc1, NewSrc2)}; + 'sradi' -> {'sradi', {NewDst,NewSrc1,do_sradi_src2(NewSrc2)}}; + 'sradi.' -> {'sradi.', {NewDst,NewSrc1,do_sradi_src2(NewSrc2)}}; _ -> {AluOp, {NewDst,NewSrc1,NewSrc2}} end, [{NewI, NewOpnds, I}]. @@ -171,6 +178,15 @@ do_srwi_opnds(Dst, Src1, {uimm,N}) when is_integer(N), 0 =< N, N < 32 -> do_srawi_src2({uimm,N}) when is_integer(N), 0 =< N, N < 32 -> {sh,N}. +%% ppc64 extension +do_sldi_opnds(Dst, Src1, {uimm,N}) when is_integer(N), 0 =< N, N < 64 -> + {Dst, Src1, {sh6,N}, {me6,63-N}}. + +do_srdi_opnds(Dst, Src1, {uimm,N}) when is_integer(N), 0 =< N, N < 64 -> + {Dst, Src1, {sh6,64-N}, {mb6,N}}. + +do_sradi_src2({uimm,N}) when is_integer(N), 0 =< N, N < 64 -> {sh6,N}. + do_b_fun(I) -> #b_fun{'fun'=Fun,linkage=Linkage} = I, [{'.reloc', {b_fun,Fun,Linkage}, #comment{term='fun'}}, @@ -205,7 +221,18 @@ do_cmp(I) -> #cmp{cmpop=CmpOp,src1=Src1,src2=Src2} = I, NewSrc1 = do_reg(Src1), NewSrc2 = do_reg_or_imm(Src2), - [{CmpOp, {{crf,0},0,NewSrc1,NewSrc2}, I}]. + {RealOp,L} = + case CmpOp of + 'cmpd' -> {'cmp',1}; + 'cmpdi' -> {'cmpi',1}; + 'cmpld' -> {'cmpl',1}; + 'cmpldi' -> {'cmpli',1}; + 'cmp' -> {CmpOp,0}; + 'cmpi' -> {CmpOp,0}; + 'cmpl' -> {CmpOp,0}; + 'cmpli' -> {CmpOp,0} + end, + [{RealOp, {{crf,0},L,NewSrc1,NewSrc2}, I}]. do_label(I) -> #label{label=Label} = I, @@ -214,7 +241,12 @@ do_label(I) -> do_load(I) -> #load{ldop=LdOp,dst=Dst,disp=Disp,base=Base} = I, NewDst = do_reg(Dst), - NewDisp = do_disp(Disp), + NewDisp = + case LdOp of + 'ld' -> do_disp_ds(Disp); + 'ldu' -> do_disp_ds(Disp); + _ -> do_disp(Disp) + end, NewBase = do_reg(Base), [{LdOp, {NewDst,NewDisp,NewBase}, I}]. @@ -265,14 +297,30 @@ do_pseudo_li(I, MFA, ConstMap) -> end, NewDst = do_reg(Dst), Simm0 = {simm,0}, - [{'.reloc', RelocData, #comment{term=reloc}}, - {addi, {NewDst,{r,0},Simm0}, I}, - {addis, {NewDst,NewDst,Simm0}, I}]. + Uimm0 = {uimm,0}, + case get(hipe_target_arch) of + powerpc -> + [{'.reloc', RelocData, #comment{term=reloc}}, + {addi, {NewDst,{r,0},Simm0}, I}, + {addis, {NewDst,NewDst,Simm0}, I}]; + ppc64 -> + [{'.reloc', RelocData, #comment{term=reloc}}, + {addis, {NewDst,{r,0},Simm0}, I}, % @highest + {ori, {NewDst,NewDst,Uimm0}, I}, % @higher + {rldicr, {NewDst,NewDst,{sh6,32},{me6,31}}, I}, + {oris, {NewDst,NewDst,Uimm0}, I}, % @h + {ori, {NewDst,NewDst,Uimm0}, I}] % @l + end. do_store(I) -> #store{stop=StOp,src=Src,disp=Disp,base=Base} = I, NewSrc = do_reg(Src), - NewDisp = do_disp(Disp), + NewDisp = + case StOp of + 'std' -> do_disp_ds(Disp); + 'stdu' -> do_disp_ds(Disp); + _ -> do_disp(Disp) + end, NewBase = do_reg(Base), [{StOp, {NewSrc,NewDisp,NewBase}, I}]. @@ -344,6 +392,10 @@ do_reg_or_imm(Src) -> do_disp(Disp) when is_integer(Disp), -32768 =< Disp, Disp =< 32767 -> {d, Disp band 16#ffff}. +do_disp_ds(Disp) when is_integer(Disp), + -32768 =< Disp, Disp =< 32767, Disp band 3 =:= 0 -> + {ds, (Disp band 16#ffff) bsr 2}. + do_spr(SPR) -> SPR_NR = case SPR of diff --git a/lib/hipe/ppc/hipe_ppc_frame.erl b/lib/hipe/ppc/hipe_ppc_frame.erl index 158009872f..8a4d1906c0 100644 --- a/lib/hipe/ppc/hipe_ppc_frame.erl +++ b/lib/hipe/ppc/hipe_ppc_frame.erl @@ -1,20 +1,20 @@ %% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% @@ -103,12 +103,12 @@ do_pseudo_move(I, Context, FPoff) -> case temp_is_pseudo(Dst) of true -> Offset = pseudo_offset(Dst, FPoff, Context), - mk_store('stw', Src, Offset, mk_sp(), []); + mk_store(hipe_ppc:stop_word(), Src, Offset, mk_sp(), []); _ -> case temp_is_pseudo(Src) of true -> Offset = pseudo_offset(Src, FPoff, Context), - mk_load('lwz', Dst, Offset, mk_sp(), []); + mk_load(hipe_ppc:ldop_word(), Dst, Offset, mk_sp(), []); _ -> [hipe_ppc:mk_alu('or', Dst, Src, Src)] end @@ -152,7 +152,7 @@ restore_lr(FPoff, Context, Rest) -> false -> Rest; true -> Temp = mk_temp1(), - mk_load('lwz', Temp, FPoff - word_size(), mk_sp(), + mk_load(hipe_ppc:ldop_word(), Temp, FPoff - word_size(), mk_sp(), [hipe_ppc:mk_mtspr('lr', Temp) | Rest]) end. @@ -324,8 +324,8 @@ simple_moves([{SrcOff,DstOff,Type}|Moves], FPoff, TempReg, Rest) -> LoadOff = FPoff+SrcOff, StoreOff = FPoff+DstOff, simple_moves(Moves, FPoff, TempReg, - mk_load('lwz', Temp, LoadOff, SP, - mk_store('stw', Temp, StoreOff, SP, + mk_load(hipe_ppc:ldop_word(), Temp, LoadOff, SP, + mk_store(hipe_ppc:stop_word(), Temp, StoreOff, SP, Rest))); simple_moves([], _, _, Rest) -> Rest. @@ -343,7 +343,8 @@ store_moves([{Src,DstOff}|Moves], FPoff, TempReg, Rest) -> {Temp, hipe_ppc:mk_li(Temp, Src)} end, store_moves(Moves, FPoff, TempReg, - FixSrc ++ mk_store('stw', NewSrc, StoreOff, SP, Rest)); + FixSrc ++ mk_store(hipe_ppc:stop_word(), NewSrc, + StoreOff, SP, Rest)); store_moves([], _, _, Rest) -> Rest. @@ -400,7 +401,7 @@ mk_temp_map(Formals, ClobbersLR, Temps) -> enter_vars([V|Vs], PrevOff, Map) -> Off = case hipe_ppc:temp_type(V) of - 'double' -> PrevOff - 2*word_size(); + 'double' -> PrevOff - 8; _ -> PrevOff - word_size() end, enter_vars(Vs, Off, tmap_bind(Map, V, Off)); @@ -454,7 +455,8 @@ do_prologue(CFG, Context) -> AllocFrameCodeTail = case ClobbersLR of false -> GotoOldStartCode; - true -> mk_store('stw', Temp1, FrameSize-word_size(), SP, GotoOldStartCode) + true -> mk_store(hipe_ppc:stop_word(), Temp1, + FrameSize-word_size(), SP, GotoOldStartCode) end, %% Arity = context_arity(Context), @@ -484,7 +486,7 @@ do_prologue(CFG, Context) -> true -> [hipe_ppc:mk_mfspr(Temp1, 'lr') | NewStartCodeTail2] end, NewStartCode0 = - [hipe_ppc:mk_load('lwz', Temp1, ?P_NSP_LIMIT, P) | + [hipe_ppc:mk_load(hipe_ppc:ldop_word(), Temp1, ?P_NSP_LIMIT, P) | hipe_ppc:mk_addi(Temp2, SP, -MaxStack, [hipe_ppc:mk_cmp('cmpl', Temp2, Temp1) | NewStartCodeTail1])], diff --git a/lib/hipe/ppc/hipe_rtl_to_ppc.erl b/lib/hipe/ppc/hipe_rtl_to_ppc.erl index 458af250de..7dfa56df29 100644 --- a/lib/hipe/ppc/hipe_rtl_to_ppc.erl +++ b/lib/hipe/ppc/hipe_rtl_to_ppc.erl @@ -1,20 +1,20 @@ %%% -*- erlang-indent-level: 2 -*- %%% %%% %CopyrightBegin% -%%% -%%% Copyright Ericsson AB 2004-2009. All Rights Reserved. -%%% +%%% +%%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%%% %%% The contents of this file are subject to the Erlang Public License, %%% Version 1.1, (the "License"); you may not use this file except in %%% 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% %%% %%% The PowerPC instruction set is quite irregular. @@ -110,20 +110,27 @@ conv_fconv(I, Map, Data) -> mk_fconv(Dst, Src) -> CSP = hipe_ppc:mk_temp(1, 'untagged'), - R0 = hipe_ppc:mk_temp(0, 'untagged'), - RTmp1 = hipe_ppc:mk_new_temp('untagged'), - RTmp2 = hipe_ppc:mk_new_temp('untagged'), - RTmp3 = hipe_ppc:mk_new_temp('untagged'), - FTmp1 = hipe_ppc:mk_new_temp('double'), - FTmp2 = hipe_ppc:mk_new_temp('double'), - [hipe_ppc:mk_pseudo_li(RTmp1, {fconv_constant,c_const}), - hipe_ppc:mk_lfd(FTmp1, 0, RTmp1), - hipe_ppc:mk_alu('xoris', RTmp2, Src, hipe_ppc:mk_uimm16(16#8000)), - hipe_ppc:mk_store('stw', RTmp2, 28, CSP), - hipe_ppc:mk_alu('addis', RTmp3, R0, hipe_ppc:mk_simm16(16#4330)), - hipe_ppc:mk_store('stw', RTmp3, 24, CSP), - hipe_ppc:mk_lfd(FTmp2, 24, CSP), - hipe_ppc:mk_fp_binary('fsub', Dst, FTmp2, FTmp1)]. + case get(hipe_target_arch) of + powerpc -> + R0 = hipe_ppc:mk_temp(0, 'untagged'), + RTmp1 = hipe_ppc:mk_new_temp('untagged'), + RTmp2 = hipe_ppc:mk_new_temp('untagged'), + RTmp3 = hipe_ppc:mk_new_temp('untagged'), + FTmp1 = hipe_ppc:mk_new_temp('double'), + FTmp2 = hipe_ppc:mk_new_temp('double'), + [hipe_ppc:mk_pseudo_li(RTmp1, {fconv_constant,c_const}), + hipe_ppc:mk_lfd(FTmp1, 0, RTmp1), + hipe_ppc:mk_alu('xoris', RTmp2, Src, hipe_ppc:mk_uimm16(16#8000)), + hipe_ppc:mk_store('stw', RTmp2, 28, CSP), + hipe_ppc:mk_alu('addis', RTmp3, R0, hipe_ppc:mk_simm16(16#4330)), + hipe_ppc:mk_store('stw', RTmp3, 24, CSP), + hipe_ppc:mk_lfd(FTmp2, 24, CSP), + hipe_ppc:mk_fp_binary('fsub', Dst, FTmp2, FTmp1)]; + ppc64 -> + [hipe_ppc:mk_store('std', Src, 24, CSP), + hipe_ppc:mk_lfd(Dst, 24, CSP), + hipe_ppc:mk_fp_unary('fcfid', Dst, Dst)] + end. conv_fmove(I, Map, Data) -> %% Dst := Src, where both Dst and Src are FP regs @@ -280,10 +287,14 @@ mk_alu_ri(Dst, Src1, RtlAluOp, Src2) -> 'mul' -> % 'mulli' has a 16-bit simm operand mk_alu_ri_simm16(Dst, Src1, RtlAluOp, 'mulli', Src2); 'and' -> % 'andi.' has a 16-bit uimm operand - case rlwinm_mask(Src2) of - {MB,ME} -> - [hipe_ppc:mk_unary({'rlwinm',0,MB,ME}, Dst, Src1)]; - _ -> + if Src2 band (bnot 16#ffffffff) =:= 0 -> + case rlwinm_mask(Src2) of + {MB,ME} -> + [hipe_ppc:mk_unary({'rlwinm',0,MB,ME}, Dst, Src1)]; + _ -> + mk_alu_ri_bitop(Dst, Src1, RtlAluOp, 'andi.', Src2) + end; + true -> mk_alu_ri_bitop(Dst, Src1, RtlAluOp, 'andi.', Src2) end; 'or' -> % 'ori' has a 16-bit uimm operand @@ -360,17 +371,33 @@ mk_alu_ri_bitop(Dst, Src1, RtlAluOp, AluOp, Src2) -> end. mk_alu_ri_shift(Dst, Src1, RtlAluOp, Src2) -> - if Src2 < 32, Src2 >= 0 -> - AluOp = - case RtlAluOp of - 'sll' -> 'slwi'; % alias for rlwinm - 'srl' -> 'srwi'; % alias for rlwinm - 'sra' -> 'srawi' - end, - [hipe_ppc:mk_alu(AluOp, Dst, Src1, - hipe_ppc:mk_uimm16(Src2))]; - true -> - mk_alu_ri_rr(Dst, Src1, RtlAluOp, Src2) + case get(hipe_target_arch) of + ppc64 -> + if Src2 < 64, Src2 >= 0 -> + AluOp = + case RtlAluOp of + 'sll' -> 'sldi'; % alias for rldimi %%% buggy + 'srl' -> 'srdi'; % alias for rldimi %%% buggy + 'sra' -> 'sradi' %%% buggy + end, + [hipe_ppc:mk_alu(AluOp, Dst, Src1, + hipe_ppc:mk_uimm16(Src2))]; + true -> + mk_alu_ri_rr(Dst, Src1, RtlAluOp, Src2) + end; + powerpc -> + if Src2 < 32, Src2 >= 0 -> + AluOp = + case RtlAluOp of + 'sll' -> 'slwi'; % alias for rlwinm + 'srl' -> 'srwi'; % alias for rlwinm + 'sra' -> 'srawi' + end, + [hipe_ppc:mk_alu(AluOp, Dst, Src1, + hipe_ppc:mk_uimm16(Src2))]; + true -> + mk_alu_ri_rr(Dst, Src1, RtlAluOp, Src2) + end end. mk_alu_ri_rr(Dst, Src1, RtlAluOp, Src2) -> @@ -384,15 +411,21 @@ mk_alu_rr(Dst, Src1, RtlAluOp, Src2) -> [hipe_ppc:mk_alu('subf', Dst, Src2, Src1)]; _ -> AluOp = - case RtlAluOp of - 'add' -> 'add'; - 'mul' -> 'mullw'; - 'or' -> 'or'; - 'and' -> 'and'; - 'xor' -> 'xor'; - 'sll' -> 'slw'; - 'srl' -> 'srw'; - 'sra' -> 'sraw' + case {get(hipe_target_arch), RtlAluOp} of + {_, 'add'} -> 'add'; + {_, 'or'} -> 'or'; + {_, 'and'} -> 'and'; + {_, 'xor'} -> 'xor'; + + {powerpc, 'mul'} -> 'mullw'; + {powerpc, 'sll'} -> 'slw'; + {powerpc, 'srl'} -> 'srw'; + {powerpc, 'sra'} -> 'sraw'; + + {ppc64, 'mul'} -> 'mulld'; + {ppc64, 'sll'} -> 'sld'; + {ppc64, 'srl'} -> 'srd'; + {ppc64, 'sra'} -> 'srad' end, [hipe_ppc:mk_alu(AluOp, Dst, Src1, Src2)] end. @@ -431,16 +464,22 @@ conv_alub(I, Map, Data) -> {I1 ++ I2, Map2, Data}. conv_alub_op(RtlAluOp) -> - case RtlAluOp of - 'add' -> 'add'; - 'sub' -> 'subf'; % XXX: must swap operands - 'mul' -> 'mullw'; - 'or' -> 'or'; - 'and' -> 'and'; - 'xor' -> 'xor'; - 'sll' -> 'slw'; - 'srl' -> 'srw'; - 'sra' -> 'sraw' + case {get(hipe_target_arch), RtlAluOp} of + {_, 'add'} -> 'add'; + {_, 'sub'} -> 'subf'; % XXX: must swap operands + {_, 'or'} -> 'or'; + {_, 'and'} -> 'and'; + {_, 'xor'} -> 'xor'; + + {powerpc, 'mul'} -> 'mullw'; + {powerpc, 'sll'} -> 'slw'; + {powerpc, 'srl'} -> 'srw'; + {powerpc, 'sra'} -> 'sraw'; + + {ppc64, 'mul'} -> 'mulld'; + {ppc64, 'sll'} -> 'sld'; + {ppc64, 'srl'} -> 'srd'; + {ppc64, 'sra'} -> 'srad' end. aluop_commutes(AluOp) -> @@ -454,7 +493,11 @@ aluop_commutes(AluOp) -> 'xor' -> true; 'slw' -> false; 'srw' -> false; - 'sraw' -> false + 'sraw' -> false; + 'mulld' -> true; % ppc64 + 'sld' -> false; % ppc64 + 'srd' -> false; % ppc64 + 'srad' -> false % ppc64 end. conv_alub_cond(Cond) -> % only signed @@ -528,17 +571,24 @@ mk_alub_ri_Rc(Dst, Src1, AluOp, Src2) -> mk_alub_ri_Rc_addi(Dst, Src1, Src2, 'addic.', 'add.'); 'addc' -> % 'addic' has a 16-bit simm operand mk_alub_ri_Rc_addi(Dst, Src1, Src2, 'addic', 'addc'); - 'mullw' -> % there is no 'mulli.' + 'mullw' -> % there is no 'mulli.' mk_alub_ri_Rc_rr(Dst, Src1, 'mullw.', Src2); + 'mulld' -> % there is no 'mulli.' + mk_alub_ri_Rc_rr(Dst, Src1, 'mulld.', Src2); 'or' -> % there is no 'ori.' mk_alub_ri_Rc_rr(Dst, Src1, 'or.', Src2); 'xor' -> % there is no 'xori.' mk_alub_ri_Rc_rr(Dst, Src1, 'xor.', Src2); 'and' -> % 'andi.' has a 16-bit uimm operand - case rlwinm_mask(Src2) of - {MB,ME} -> - [hipe_ppc:mk_unary({'rlwinm.',0,MB,ME}, Dst, Src1)]; - _ -> + if + Src2 band (bnot 16#ffffffff) =:= 0 -> + case rlwinm_mask(Src2) of + {MB,ME} -> + [hipe_ppc:mk_unary({'rlwinm.',0,MB,ME}, Dst, Src1)]; + _ -> + mk_alub_ri_Rc_andi(Dst, Src1, Src2) + end; + true -> mk_alub_ri_Rc_andi(Dst, Src1, Src2) end; _ -> % shift ops have 5-bit uimm operands @@ -562,13 +612,16 @@ mk_alub_ri_Rc_andi(Dst, Src1, Src2) -> end. mk_alub_ri_Rc_shift(Dst, Src1, AluOp, Src2) -> - if Src2 < 32, Src2 >= 0 -> - AluOpIDot = - case AluOp of - 'slw' -> 'slwi.'; % alias for rlwinm. - 'srw' -> 'srwi.'; % alias for rlwinm. - 'sraw' -> 'srawi.' - end, + {AluOpIDot, MaxIShift} = + case AluOp of + 'slw' -> {'slwi.', 32}; % alias for rlwinm. + 'srw' -> {'srwi.', 32}; % alias for rlwinm. + 'sraw' -> {'srawi.', 32}; + 'sld' -> {'sldi.', 64}; + 'srd' -> {'srdi.', 64}; + 'srad' -> {'sradi.', 64} + end, + if Src2 < MaxIShift, Src2 >= 0 -> [hipe_ppc:mk_alu(AluOpIDot, Dst, Src1, hipe_ppc:mk_uimm16(Src2))]; true -> @@ -576,7 +629,10 @@ mk_alub_ri_Rc_shift(Dst, Src1, AluOp, Src2) -> case AluOp of 'slw' -> 'slw.'; 'srw' -> 'srw.'; - 'sraw' -> 'sraw.' + 'sraw' -> 'sraw.'; + 'sld' -> 'sld.'; + 'srd' -> 'srd.'; + 'srad' -> 'srad.' end, mk_alub_ri_Rc_rr(Dst, Src1, AluOpDot, Src2) end. @@ -598,8 +654,9 @@ mk_alub_rr_OE(Dst, Src1, AluOp, Src2) -> case AluOp of 'subf' -> 'subfo.'; 'add' -> 'addo.'; - 'mullw' -> 'mullwo.' - %% fail for addc, or, and, xor, slw, srw, sraw + 'mullw' -> 'mullwo.'; + 'mulld' -> 'mulldo.' + %% fail for addc, or, and, xor, slw, srw, sraw end, [hipe_ppc:mk_alu(AluOpODot, Dst, Src1, Src2)]. @@ -610,12 +667,16 @@ mk_alub_rr_Rc(Dst, Src1, AluOp, Src2) -> 'add' -> 'add.'; 'addc' -> 'addc'; % only interested in CA, no Rc needed 'mullw' -> 'mullw.'; + 'mulld' -> 'mulld.'; 'or' -> 'or.'; 'and' -> 'and.'; 'xor' -> 'xor.'; 'slw' -> 'slw.'; + 'sld' -> 'sld.'; 'srw' -> 'srw.'; - 'sraw' -> 'sraw.' + 'srd' -> 'srd.'; + 'sraw' -> 'sraw.'; + 'srad' -> 'srad.' end, [hipe_ppc:mk_alu(AluOpDot, Dst, Src1, Src2)]. @@ -682,17 +743,17 @@ mk_branch_ri(Src1, BCond, Sign, Src2, TrueLab, FalseLab, Pred) -> case Sign of 'signed' -> if is_integer(Src2), -32768 =< Src2, Src2 < 32768 -> - {[], hipe_ppc:mk_simm16(Src2), 'cmpi'}; + {[], hipe_ppc:mk_simm16(Src2), hipe_ppc:cmpiop_word()}; true -> Tmp = new_untagged_temp(), - {mk_li(Tmp, Src2), Tmp, 'cmp'} + {mk_li(Tmp, Src2), Tmp, hipe_ppc:cmpop_word()} end; 'unsigned' -> if is_integer(Src2), 0 =< Src2, Src2 < 65536 -> - {[], hipe_ppc:mk_uimm16(Src2), 'cmpli'}; + {[], hipe_ppc:mk_uimm16(Src2), hipe_ppc:cmpliop_word()}; true -> Tmp = new_untagged_temp(), - {mk_li(Tmp, Src2), Tmp, 'cmpl'} + {mk_li(Tmp, Src2), Tmp, hipe_ppc:cmplop_word()} end end, FixSrc2 ++ @@ -701,8 +762,8 @@ mk_branch_ri(Src1, BCond, Sign, Src2, TrueLab, FalseLab, Pred) -> mk_branch_rr(Src1, BCond, Sign, Src2, TrueLab, FalseLab, Pred) -> CmpOp = case Sign of - 'signed' -> 'cmp'; - 'unsigned' -> 'cmpl' + 'signed' -> hipe_ppc:cmpop_word(); + 'unsigned' -> hipe_ppc:cmplop_word() end, mk_cmp_bc(CmpOp, Src1, Src2, BCond, TrueLab, FalseLab, Pred). @@ -841,7 +902,7 @@ mk_store_args([Arg|Args], PrevOffset, Tail) -> Tmp = new_tagged_temp(), {Tmp, mk_li(Tmp, Arg)} end, - Store = hipe_ppc:mk_store('stw', Src, Offset, mk_sp()), + Store = hipe_ppc:mk_store(hipe_ppc:stop_word(), Src, Offset, mk_sp()), mk_store_args(Args, Offset, FixSrc ++ [Store | Tail]); mk_store_args([], _, Tail) -> Tail. @@ -883,25 +944,19 @@ conv_load(I, Map, Data) -> {I2, Map2, Data}. mk_load(Dst, Base1, Base2, LoadSize, LoadSign) -> - Rest = - case LoadSize of - byte -> - case LoadSign of - signed -> [hipe_ppc:mk_unary('extsb', Dst, Dst)]; - _ -> [] + {LdOp, Rest} = + case {LoadSize, LoadSign} of + {byte, signed} -> {'lbz', [hipe_ppc:mk_unary('extsb', Dst, Dst)]}; + {byte, unsigned} -> {'lbz', []}; + {int16, signed} -> {'lha', []}; + {int16, unsigned} -> {'lhz', []}; + {int32, signed} -> + case get(hipe_target_arch) of + powerpc -> {'lwz', []}; + ppc64 -> {'lwa', []} end; - _ -> [] - end, - LdOp = - case LoadSize of - byte -> 'lbz'; - int32 -> 'lwz'; - word -> 'lwz'; - int16 -> - case LoadSign of - signed -> 'lha'; - unsigned -> 'lhz' - end + {int32, unsigned} -> {'lwz', []}; + {word, _} -> {hipe_ppc:ldop_word(), []} end, case hipe_ppc:is_temp(Base1) of true -> @@ -980,7 +1035,7 @@ mk_store(Src, Base1, Base2, StoreSize) -> byte -> 'stb'; int16 -> 'sth'; int32 -> 'stw'; - word -> 'stw' + word -> hipe_ppc:stop_word() end, case hipe_ppc:is_temp(Src) of true -> @@ -1022,10 +1077,16 @@ conv_switch(I, Map, Data) -> JTabR = new_untagged_temp(), OffsetR = new_untagged_temp(), DestR = new_untagged_temp(), + ShiftInstruction = + case get(hipe_target_arch) of + powerpc -> 'slwi'; + ppc64 -> 'sldi' + end, I2 = [hipe_ppc:mk_pseudo_li(JTabR, {JTabLab,constant}), - hipe_ppc:mk_alu('slwi', OffsetR, IndexR, hipe_ppc:mk_uimm16(2)), - hipe_ppc:mk_loadx('lwzx', DestR, JTabR, OffsetR), + hipe_ppc:mk_alu(ShiftInstruction, OffsetR, IndexR, + hipe_ppc:mk_uimm16(log2_word_size())), + hipe_ppc:mk_loadx(hipe_ppc:ldop_wordx(), DestR, JTabR, OffsetR), hipe_ppc:mk_mtspr('ctr', DestR), hipe_ppc:mk_bctr(Labels)], {I2, Map1, NewData}. @@ -1247,3 +1308,6 @@ vmap_bind(Map, Key, Val) -> word_size() -> hipe_rtl_arch:word_size(). + +log2_word_size() -> + hipe_rtl_arch:log2_word_size(). diff --git a/lib/hipe/rtl/hipe_rtl_arch.erl b/lib/hipe/rtl/hipe_rtl_arch.erl index 2afdf4eb6b..22cda57a3a 100644 --- a/lib/hipe/rtl/hipe_rtl_arch.erl +++ b/lib/hipe/rtl/hipe_rtl_arch.erl @@ -1,20 +1,20 @@ %% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. -%% +%% +%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in %% 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% %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -86,6 +86,8 @@ first_virtual_reg() -> hipe_sparc_registers:first_virtual(); powerpc -> hipe_ppc_registers:first_virtual(); + ppc64 -> + hipe_ppc_registers:first_virtual(); arm -> hipe_arm_registers:first_virtual(); x86 -> @@ -100,6 +102,8 @@ heap_pointer() -> % {GetHPInsn, HPReg, PutHPInsn} heap_pointer_from_reg(hipe_sparc_registers:heap_pointer()); powerpc -> heap_pointer_from_reg(hipe_ppc_registers:heap_pointer()); + ppc64 -> + heap_pointer_from_reg(hipe_ppc_registers:heap_pointer()); arm -> heap_pointer_from_reg(hipe_arm_registers:heap_pointer()); x86 -> @@ -143,6 +147,8 @@ heap_limit() -> % {GetHLIMITInsn, HLIMITReg} heap_limit_from_pcb(); powerpc -> heap_limit_from_pcb(); + ppc64 -> + heap_limit_from_pcb(); arm -> heap_limit_from_pcb(); x86 -> @@ -165,6 +171,8 @@ fcalls() -> % {GetFCallsInsn, FCallsReg, PutFCallsInsn} fcalls_from_pcb(); powerpc -> fcalls_from_pcb(); + ppc64 -> + fcalls_from_pcb(); arm -> fcalls_from_pcb(); x86 -> @@ -188,6 +196,8 @@ reg_name(Reg) -> hipe_sparc_registers:reg_name_gpr(Reg); powerpc -> hipe_ppc_registers:reg_name_gpr(Reg); + ppc64 -> + hipe_ppc_registers:reg_name_gpr(Reg); arm -> hipe_arm_registers:reg_name_gpr(Reg); x86 -> @@ -215,6 +225,8 @@ is_precolored_regnum(RegNum) -> hipe_sparc_registers:is_precoloured_gpr(RegNum); powerpc -> hipe_ppc_registers:is_precoloured_gpr(RegNum); + ppc64 -> + hipe_ppc_registers:is_precoloured_gpr(RegNum); arm -> hipe_arm_registers:is_precoloured_gpr(RegNum); x86 -> @@ -243,6 +255,9 @@ live_at_return() -> powerpc -> ordsets:from_list([hipe_rtl:mk_reg(R) || {R,_} <- hipe_ppc_registers:live_at_return()]); + ppc64 -> + ordsets:from_list([hipe_rtl:mk_reg(R) + || {R,_} <- hipe_ppc_registers:live_at_return()]); arm -> ordsets:from_list([hipe_rtl:mk_reg(R) || {R,_} <- hipe_arm_registers:live_at_return()]); @@ -262,6 +277,7 @@ word_size() -> case get(hipe_target_arch) of ultrasparc -> 4; powerpc -> 4; + ppc64 -> 8; arm -> 4; x86 -> 4; amd64 -> 8 @@ -284,6 +300,7 @@ log2_word_size() -> case get(hipe_target_arch) of ultrasparc -> 2; powerpc -> 2; + ppc64 -> 3; arm -> 2; x86 -> 2; amd64 -> 3 @@ -297,6 +314,7 @@ endianess() -> case get(hipe_target_arch) of ultrasparc -> big; powerpc -> big; + ppc64 -> big; x86 -> little; amd64 -> little; arm -> ?ARM_ENDIANESS @@ -313,6 +331,8 @@ load_big_2(Dst, Base, Offset, Signedness) -> case get(hipe_target_arch) of powerpc -> load_2_directly(Dst, Base, Offset, Signedness); + ppc64 -> + load_2_directly(Dst, Base, Offset, Signedness); %% Note: x86 could use a "load;xchgb" or "load;rol $8,<16-bit reg>" %% sequence here. This has been implemented, but unfortunately didn't %% make consistent improvements to our benchmarks. @@ -333,6 +353,13 @@ load_little_2(Dst, Base, Offset, Signedness) -> unsigned -> []; signed -> [hipe_rtl:mk_call([Dst], 'extsh', [Dst], [], [], not_remote)] end]; + ppc64 -> + [hipe_rtl:mk_call([Dst], 'lhbrx', [Base,Offset], [], [], not_remote), + hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(2)) | + case Signedness of + unsigned -> []; + signed -> [hipe_rtl:mk_call([Dst], 'extsh', [Dst], [], [], not_remote)] + end]; _ -> load_little_2_in_pieces(Dst, Base, Offset, Signedness) end. @@ -365,6 +392,8 @@ load_big_4(Dst, Base, Offset, Signedness) -> case get(hipe_target_arch) of powerpc -> load_4_directly(Dst, Base, Offset, Signedness); + ppc64 -> + load_4_directly(Dst, Base, Offset, Signedness); %% Note: x86 could use a "load;bswap" sequence here. %% This has been implemented, but unfortunately didn't %% make any noticeable improvements in our benchmarks. @@ -386,6 +415,13 @@ load_little_4(Dst, Base, Offset, Signedness) -> powerpc -> [hipe_rtl:mk_call([Dst], 'lwbrx', [Base,Offset], [], [], not_remote), hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(4))]; + ppc64 -> + [hipe_rtl:mk_call([Dst], 'lwbrx', [Base,Offset], [], [], not_remote), + hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(4)) | + case Signedness of + unsigned -> []; + signed -> [hipe_rtl:mk_call([Dst], 'extsw', [Dst], [], [], not_remote)] + end]; arm -> %% When loading 4 bytes into a 32-bit register, the %% signedness of the high-order byte doesn't matter. @@ -396,7 +432,7 @@ load_little_4(Dst, Base, Offset, Signedness) -> end. load_4_directly(Dst, Base, Offset, Signedness) -> - [hipe_rtl:mk_load(Dst, Base, Offset, word, Signedness), + [hipe_rtl:mk_load(Dst, Base, Offset, int32, Signedness), hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(4))]. load_big_4_in_pieces(Dst, Base, Offset, Signedness) -> @@ -440,6 +476,8 @@ store_4(Base, Offset, Src) -> store_4_directly(Base, Offset, Src); powerpc -> store_4_directly(Base, Offset, Src); + ppc64 -> + store_4_directly(Base, Offset, Src); arm -> store_big_4_in_pieces(Base, Offset, Src); ultrasparc -> @@ -525,6 +563,7 @@ fwait() -> amd64 -> [hipe_rtl:mk_call([], 'fwait', [], [], [], not_remote)]; arm -> []; powerpc -> []; + ppc64 -> []; ultrasparc -> [] end. @@ -549,6 +588,8 @@ handle_fp_exception() -> []; powerpc -> []; + ppc64 -> + []; ultrasparc -> [] end. @@ -577,6 +618,8 @@ proc_pointer() -> % must not be exported hipe_rtl:mk_reg_gcsafe(hipe_sparc_registers:proc_pointer()); powerpc -> hipe_rtl:mk_reg_gcsafe(hipe_ppc_registers:proc_pointer()); + ppc64 -> + hipe_rtl:mk_reg_gcsafe(hipe_ppc_registers:proc_pointer()); arm -> hipe_rtl:mk_reg_gcsafe(hipe_arm_registers:proc_pointer()); x86 -> @@ -601,6 +644,8 @@ nr_of_return_regs() -> %% hipe_sparc_registers:nr_rets(); powerpc -> 1; + ppc64 -> + 1; %% hipe_ppc_registers:nr_rets(); arm -> 1; diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl index 5859c345d0..0cc6c2deec 100644 --- a/lib/hipe/rtl/hipe_tagscheme.erl +++ b/lib/hipe/rtl/hipe_tagscheme.erl @@ -1045,7 +1045,7 @@ convert_matchstate(Ms) -> build_sub_binary(Ms, ByteSize, ByteOffset, BitSize, BitOffset, hipe_rtl:mk_imm(0), Orig), size_from_header(SizeInWords, Header), - hipe_rtl:mk_alu(Hole, SizeInWords, sub, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE-1)), + hipe_rtl:mk_alu(Hole, SizeInWords, sub, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE)), mk_var_header(BigIntHeader, Hole, ?TAG_HEADER_POS_BIG), hipe_rtl:mk_store(Ms, hipe_rtl:mk_imm(?SUB_BIN_WORDSIZE*WordSize-?TAG_PRIMARY_BOXED), BigIntHeader)]. diff --git a/lib/inets/doc/src/http_server.xml b/lib/inets/doc/src/http_server.xml index 47ed9cd229..959386e471 100644 --- a/lib/inets/doc/src/http_server.xml +++ b/lib/inets/doc/src/http_server.xml @@ -63,9 +63,9 @@ technologies such as SOAP.</p> <p>Allmost all server functionality has been implemented using an - especially crafted server API, it is described in the Erlang Web - Server API. This API can be used to advantage by all who wants - to enhance the server core functionality, for example custom + especially crafted server API which is described in the Erlang Web + Server API. This API can be used to advantage by all who wish + to enhance the core server functionality, for example with custom logging and authentication.</p> <marker id="config"></marker> @@ -472,7 +472,7 @@ http://your.server.org/eval?httpd_example:print(atom_to_list(apply(erlang,halt,[ <tag><em>bytes</em></tag> <item>The content-length of the document transferred. </item> </taglist> - <p>Internal server errors are recorde in the error log file. The + <p>Internal server errors are recorded in the error log file. The format of this file is a more ad hoc format than the logs using Common Logfile Format, but conforms to the following syntax: </p> diff --git a/lib/inets/doc/src/httpd.xml b/lib/inets/doc/src/httpd.xml index 62f4e18f82..6470b6fac7 100644 --- a/lib/inets/doc/src/httpd.xml +++ b/lib/inets/doc/src/httpd.xml @@ -525,12 +525,13 @@ bytes scheme scripts. A matching URL is mapped into a specific module and function. For example: - <code>{erl_script_alias, {"/cgi-bin/example" [httpd_example]} + <code>{erl_script_alias, {"/cgi-bin/example", [httpd_example]} </code> and a request to http://your.server.org/cgi-bin/example/httpd_example:yahoo - would refer to httpd_example:yahoo/2 and + would refer to httpd_example:yahoo/3 or, if that did not exist, + httpd_example:yahoo/2 and http://your.server.org/cgi-bin/example/other:yahoo would not be allowed to execute. </item> diff --git a/lib/inets/doc/src/mod_esi.xml b/lib/inets/doc/src/mod_esi.xml index 3c473d3f94..e81308a502 100644 --- a/lib/inets/doc/src/mod_esi.xml +++ b/lib/inets/doc/src/mod_esi.xml @@ -78,24 +78,24 @@ </type> <desc> <p>The <c>Module</c> must be found in the code path and export - <c>Function</c> with an arity of two. An erlScriptAlias must + <c>Function</c> with an arity of three. An erlScriptAlias must also be set up in the configuration file for the Web server.</p> - <p>If the HTTP request is a post request and a body is sent + <p>If the HTTP request is a 'post' request and a body is sent then content_length will be the length of the posted - data. If get is used query_string will be the data after + data. If 'get' is used query_string will be the data after <em>?</em> in the url.</p> <p>ParsedHeader is the HTTP request as a key value tuple list. The keys in parsed header will be the in lower case.</p> <p>SessionID is a identifier - the server use when <c>deliver/2</c> is called, do not - assume any-thing about the datatype.</p> + the server uses when <c>deliver/2</c> is called; do not + assume anything about the datatype.</p> <p>Use this callback function to dynamically generate dynamic web content. when a part of the page is generated send the data back to the client through <c>deliver/2</c>. Note that the first chunk of data sent to the client must at least contain all HTTP header fields that the response - will generate. If the first chunk not contains - <em>End of HTTP header</em> that is <c>"\r\n\r\n"</c> + will generate. If the first chunk does not contain the + <em>End of HTTP the header</em>, that is <c>"\r\n\r\n",</c> the server will assume that no HTTP header fields will be generated.</p> </desc> @@ -106,11 +106,12 @@ <type> <v>Env = [EnvironmentDirectives] ++ ParsedHeader</v> <v>EnvironmentDirectives = {Key,Value}</v> - <v>Key = query_string | content_length | server_software | gateway_interface | server_protocol | server_port | request_method | remote_addr | script_name. <v>Input = string()</v> + <v>Key = query_string | content_length | server_software | gateway_interface | server_protocol | server_port | request_method | remote_addr | script_name.</v> + <v>Input = string()</v> <v>Response = string()</v> </type> <desc> - <p>This callback format consumes quite much memory since the + <p>This callback format consumes a lot of memory since the whole response must be generated before it is sent to the user. This functions is deprecated and only keept for backwards compatibility. diff --git a/lib/inets/test/Makefile b/lib/inets/test/Makefile index 110ad54c3c..87ca60e4b3 100644 --- a/lib/inets/test/Makefile +++ b/lib/inets/test/Makefile @@ -308,11 +308,11 @@ release_spec: opt release_tests_spec: opt $(INSTALL_DIR) $(RELTESTSYSDIR) $(INSTALL_DATA) $(RELTEST_FILES) $(RELTESTSYSDIR) - chmod -f -R u+w $(RELTESTSYSDIR) + chmod -R u+w $(RELTESTSYSDIR) tar chf - $(DATADIRS) | (cd $(RELTESTSYSDIR); tar xf -) $(INSTALL_DIR) $(RELTESTSYSALLDATADIR) $(INSTALL_DIR) $(RELTESTSYSBINDIR) - chmod -f -R +x $(RELTESTSYSBINDIR) + chmod -R +x $(RELTESTSYSBINDIR) $(INSTALL_DIR) $(RELTESTSYSALLDATADIR)/win32/lib release_docs_spec: diff --git a/lib/inviso/test/Makefile b/lib/inviso/test/Makefile index cd372624b5..c1df29d631 100644 --- a/lib/inviso/test/Makefile +++ b/lib/inviso/test/Makefile @@ -53,7 +53,7 @@ release_spec: opt release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) inviso.spec inviso.cover $(ERL_FILES) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/kernel/src/hipe_unified_loader.erl b/lib/kernel/src/hipe_unified_loader.erl index f289b8110d..1d3eb926ca 100644 --- a/lib/kernel/src/hipe_unified_loader.erl +++ b/lib/kernel/src/hipe_unified_loader.erl @@ -258,7 +258,7 @@ find_callee_mfas(Patches) when is_list(Patches) -> amd64 -> []; arm -> find_callee_mfas(Patches, gb_sets:empty(), false); powerpc -> find_callee_mfas(Patches, gb_sets:empty(), true); - %% ppc64 -> find_callee_mfas(Patches, gb_sets:empty(), true); + ppc64 -> find_callee_mfas(Patches, gb_sets:empty(), true); ultrasparc -> []; x86 -> [] end. @@ -301,6 +301,7 @@ mk_trampoline_map(CalleeMFAs, Trampolines) -> SizeofLong = case erlang:system_info(hipe_architecture) of amd64 -> 8; + ppc64 -> 8; _ -> 4 end, mk_trampoline_map(tuple_size(CalleeMFAs), CalleeMFAs, @@ -625,15 +626,15 @@ patch_instr(Address, Value, Type) -> %% %% XXX: It appears this is used for inserting both code addresses %% and other data. In HiPE, code addresses are still 32-bit on -%% 64-bit machines. +%% some 64-bit machines. write_word(DataAddress, DataWord) -> case erlang:system_info(hipe_architecture) of amd64 -> hipe_bifs:write_u64(DataAddress, DataWord), DataAddress+8; - %% ppc64 -> - %% hipe_bifs:write_u64(DataAddress, DataWord), - %% DataAddress+8; + ppc64 -> + hipe_bifs:write_u64(DataAddress, DataWord), + DataAddress+8; _ -> hipe_bifs:write_u32(DataAddress, DataWord), DataAddress+4 diff --git a/lib/kernel/src/inet_res.erl b/lib/kernel/src/inet_res.erl index de0f23bf24..93563c6011 100644 --- a/lib/kernel/src/inet_res.erl +++ b/lib/kernel/src/inet_res.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2010. All Rights Reserved. +%% Copyright Ericsson AB 1997-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -539,27 +539,41 @@ udp_send(#sock{inet=I}, {A,B,C,D}=IP, Port, Buffer) when ?ip(A,B,C,D), ?port(Port) -> gen_udp:send(I, IP, Port, Buffer). -udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout) +udp_recv(#sock{inet6=I}, {A,B,C,D,E,F,G,H}=IP, Port, Timeout, Decode) when ?ip6(A,B,C,D,E,F,G,H), ?port(Port) -> - do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout); -udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout) + do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout); +udp_recv(#sock{inet=I}, {A,B,C,D}=IP, Port, Timeout, Decode) when ?ip(A,B,C,D), ?port(Port) -> - do_udp_recv(fun(T) -> gen_udp:recv(I, 0, T) end, IP, Port, Timeout). - -do_udp_recv(Recv, IP, Port, Timeout) -> - do_udp_recv(Recv, IP, Port, Timeout, - if Timeout =/= 0 -> erlang:now(); true -> undefined end). - -do_udp_recv(Recv, IP, Port, Timeout, Then) -> - case Recv(Timeout) of - {ok,{IP,Port,Answer}} -> - {ok,Answer,erlang:max(0, Timeout - now_ms(erlang:now(), Then))}; - {ok,_} when Timeout =:= 0 -> - {error,timeout}; - {ok,_} -> - Now = erlang:now(), - T = erlang:max(0, Timeout - now_ms(Now, Then)), - do_udp_recv(Recv, IP, Port, T, Now); + do_udp_recv(I, IP, Port, Timeout, Decode, erlang:now(), Timeout). + +do_udp_recv(_I, _IP, _Port, 0, _Decode, _Start, _T) -> + timeout; +do_udp_recv(I, IP, Port, Timeout, Decode, Start, T) -> + case gen_udp:recv(I, 0, T) of + {ok,Reply} -> + case Decode(Reply) of + false when T =:= 0 -> + %% This is a compromize between the hard way i.e + %% in the clause below if NewT becomes 0 bailout + %% immediately and risk that the right reply lies + %% ahead after some bad id replies, and the + %% forgiving way i.e go on with Timeout 0 until + %% the right reply comes or no reply (timeout) + %% which opens for a DOS attack by a malicious + %% DNS server flooding with bad id replies causing + %% an infinite loop here. + %% + %% Timeout is used as a sanity limit counter + %% just to put an end to the loop. + NewTimeout = erlang:max(0, Timeout - 50), + do_udp_recv(I, IP, Port, NewTimeout, Decode, Start, T); + false -> + Now = erlang:now(), + NewT = erlang:max(0, Timeout - now_ms(Now, Start)), + do_udp_recv(I, IP, Port, Timeout, Decode, Start, NewT); + Result -> + Result + end; Error -> Error end. @@ -580,6 +594,17 @@ udp_close(#sock{inet=I,inet6=I6}) -> %% end %% end %% +%% But that man page also says dig always use num_servers = 1. +%% +%% Our man page says: timeout/retry, then double for next retry, i.e +%% for i = 0 to retry - 1 +%% foreach nameserver +%% send query +%% wait((time * (2**i)) / retry) +%% end +%% end +%% +%% And that is what the code seems to do, now fixed, hopefully... do_query(_Q, [], _Timer) -> {error,nxdomain}; @@ -589,19 +614,16 @@ do_query(#q{options=#options{retry=Retry}}=Q, NSs, Timer) -> query_retries(_Q, _NSs, _Timer, Retry, Retry, S) -> udp_close(S), {error,timeout}; +query_retries(_Q, [], _Timer, _Retry, _I, S) -> + udp_close(S), + {error,timeout}; query_retries(Q, NSs, Timer, Retry, I, S0) -> - Num = length(NSs), - if Num =:= 0 -> - udp_close(S0), - {error,timeout}; - true -> - case query_nss(Q, NSs, Timer, Retry, I, S0, []) of - {S,{noanswer,ErrNSs}} -> %% remove unreachable nameservers - query_retries(Q, NSs--ErrNSs, Timer, Retry, I+1, S); - {S,Result} -> - udp_close(S), - Result - end + case query_nss(Q, NSs, Timer, Retry, I, S0, []) of + {S,{noanswer,ErrNSs}} -> %% remove unreachable nameservers + query_retries(Q, NSs--ErrNSs, Timer, Retry, I+1, S); + {S,Result} -> + udp_close(S), + Result end. query_nss(_Q, [], _Timer, _Retry, _I, S, ErrNSs) -> @@ -611,13 +633,13 @@ query_nss(#q{edns=undefined}=Q, NSs, Timer, Retry, I, S, ErrNSs) -> query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs) -> query_nss_edns(Q, NSs, Timer, Retry, I, S, ErrNSs). -query_nss_edns(#q{options=#options{udp_payload_size=PSz}=Options, - edns={Id,Buffer}}=Q, - [{IP,Port}=NS|NSs]=NSs0, Timer, Retry, I, S0, ErrNSs) -> - {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer, - Retry, I, Options, PSz), +query_nss_edns( + #q{options=#options{udp_payload_size=PSz}=Options,edns={Id,Buffer}}=Q, + [{IP,Port}=NS|NSs]=NSs0, Timer, Retry, I, S0, ErrNSs) -> + {S,Res}=Reply = + query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I, Options, PSz), case Res of - timeout -> {S,{error,timeout}}; + timeout -> {S,{error,timeout}}; % Bailout timeout {ok,_} -> Reply; {error,{nxdomain,_}} -> Reply; {error,{E,_}} when E =:= qfmterror; E =:= notimp; E =:= servfail; @@ -629,17 +651,19 @@ query_nss_edns(#q{options=#options{udp_payload_size=PSz}=Options, query_nss(Q, NSs, Timer, Retry, I, S, ErrNSs) end. -query_nss_dns(#q{dns=Qdns}=Q0, [{IP,Port}=NS|NSs], - Timer, Retry, I, S0, ErrNSs) -> +query_nss_dns( + #q{dns=Qdns}=Q0, + [{IP,Port}=NS|NSs], Timer, Retry, I, S0, ErrNSs) -> #q{options=Options,dns={Id,Buffer}}=Q = if is_function(Qdns, 0) -> Q0#q{dns=Qdns()}; true -> Q0 end, - {S,Res}=Reply = query_ns(S0, Id, Buffer, IP, Port, Timer, - Retry, I, Options, ?PACKETSZ), + {S,Res}=Reply = + query_ns( + S0, Id, Buffer, IP, Port, Timer, Retry, I, Options, ?PACKETSZ), case Res of - timeout -> {S,{error,timeout}}; + timeout -> {S,{error,timeout}}; % Bailout timeout {ok,_} -> Reply; {error,{E,_}} when E =:= nxdomain; E =:= qfmterror -> Reply; {error,E} when E =:= fmt; E =:= enetunreach; E =:= econnrefused -> @@ -653,48 +677,66 @@ query_ns(S0, Id, Buffer, IP, Port, Timer, Retry, I, PSz) -> case UseVC orelse iolist_size(Buffer) > PSz of true -> - {S0,query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose)}; + TcpTimeout = inet:timeout(Tm*5, Timer), + {S0,query_tcp(TcpTimeout, Id, Buffer, IP, Port, Verbose)}; false -> case udp_open(S0, IP) of {ok,S} -> - {S,case query_udp(S, Id, Buffer, IP, Port, Timer, - Retry, I, Tm, Verbose) of - {ok,#dns_rec{header=H}} when H#dns_header.tc -> - query_tcp(Tm, Id, Buffer, - IP, Port, Timer, Verbose); - Reply -> Reply - end}; + Timeout = + inet:timeout( (Tm * (1 bsl I)) div Retry, Timer), + {S, + case query_udp( + S, Id, Buffer, IP, Port, Timeout, Verbose) of + {ok,#dns_rec{header=H}} when H#dns_header.tc -> + TcpTimeout = inet:timeout(Tm*5, Timer), + query_tcp( + TcpTimeout, Id, Buffer, IP, Port, Verbose); + Reply -> Reply + end}; Error -> {S0,Error} end end. -query_udp(S, Id, Buffer, IP, Port, Timer, Retry, I, Tm, Verbose) -> - Timeout = inet:timeout( (Tm * (1 bsl I)) div Retry, Timer), +query_udp(_S, _Id, _Buffer, _IP, _Port, 0, Verbose) -> + timeout; +query_udp(S, Id, Buffer, IP, Port, Timeout, Verbose) -> ?verbose(Verbose, "Try UDP server : ~p:~p (timeout=~w)\n", - [IP, Port, Timeout]), - udp_connect(S, IP, Port), - udp_send(S, IP, Port, Buffer), - query_udp_recv(S, IP, Port, Id, Timeout, Verbose). - -query_udp_recv(S, IP, Port, Id, Timeout, Verbose) -> - case udp_recv(S, IP, Port, Timeout) of - {ok,Answer,T} -> - case decode_answer(Answer, Id, Verbose) of - {error, badid} -> - query_udp_recv(S, IP, Port, Id, T, Verbose); - Reply -> Reply + [IP,Port,Timeout]), + case + case udp_connect(S, IP, Port) of + ok -> + udp_send(S, IP, Port, Buffer); + E1 -> + E1 end of + ok -> + Decode = + fun ({RecIP,RecPort,Answer}) + when RecIP =:= IP, RecPort =:= Port -> + case decode_answer(Answer, Id, Verbose) of + {error,badid} -> + false; + Reply -> + Reply + end; + ({_,_,_}) -> + false + end, + case udp_recv(S, IP, Port, Timeout, Decode) of + {ok,_}=Result -> + Result; + E2 -> + ?verbose(Verbose, "UDP server error: ~p\n", [E2]), + E2 end; - {error, timeout} when Timeout =:= 0 -> - ?verbose(Verbose, "UDP server timeout\n", []), - timeout; - Error -> - ?verbose(Verbose, "UDP server error: ~p\n", [Error]), - Error + E3 -> + ?verbose(Verbose, "UDP send failed: ~p\n", [E3]), + {error,econnrefused} end. -query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose) -> - Timeout = inet:timeout(Tm*5, Timer), +query_tcp(0, _Id, _Buffer, _IP, _Port, Verbose) -> + timeout; +query_tcp(Timeout, Id, Buffer, IP, Port, Verbose) -> ?verbose(Verbose, "Try TCP server : ~p:~p (timeout=~w)\n", [IP, Port, Timeout]), Family = case IP of @@ -716,19 +758,10 @@ query_tcp(Tm, Id, Buffer, IP, Port, Timer, Verbose) -> end; Error -> gen_tcp:close(S), - case Error of - {error, timeout} when Timeout =:= 0 -> - ?verbose(Verbose, "TCP server recv timeout\n", []), - timeout; - _ -> - ?verbose(Verbose, "TCP server recv error: ~p\n", - [Error]), - Error - end + ?verbose(Verbose, "TCP server recv error: ~p\n", + [Error]), + Error end; - {error, timeout} when Timeout =:= 0 -> - ?verbose(Verbose, "TCP server connect timeout\n", []), - timeout; Error -> ?verbose(Verbose, "TCP server error: ~p\n", [Error]), Error diff --git a/lib/kernel/src/net_kernel.erl b/lib/kernel/src/net_kernel.erl index 49a02359b0..5228d4fe01 100644 --- a/lib/kernel/src/net_kernel.erl +++ b/lib/kernel/src/net_kernel.erl @@ -1249,7 +1249,7 @@ protocol_childspecs([H|T]) -> epmd_module() -> case init:get_argument(epmd_module) of {ok,[[Module]]} -> - Module; + list_to_atom(Module); _ -> erl_epmd end. diff --git a/lib/kernel/test/Makefile b/lib/kernel/test/Makefile index 5f8f3a6bf6..95517ffd6a 100644 --- a/lib/kernel/test/Makefile +++ b/lib/kernel/test/Makefile @@ -144,7 +144,7 @@ release_tests_spec: make_emakefile $(INSTALL_DATA) $(APP_FILES) $(RELSYSDIR) $(INSTALL_DATA) kernel.spec $(EMAKEFILE)\ $(COVERFILE) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/kernel/test/file_SUITE.erl b/lib/kernel/test/file_SUITE.erl index 8078c7d021..2f73394c4e 100644 --- a/lib/kernel/test/file_SUITE.erl +++ b/lib/kernel/test/file_SUITE.erl @@ -2055,6 +2055,10 @@ try_read_file_list(Fd) -> ?line Title = "Real Programmers Don't Use PASCAL</TITLE>\n", ?line Title = io:get_line(Fd, ''), + %% Seek past the end of the file. + + ?line {ok, _} = ?FILE_MODULE:position(Fd, 25000), + %% Done. ?line ?FILE_MODULE:close(Fd), diff --git a/lib/kernel/test/heart_SUITE.erl b/lib/kernel/test/heart_SUITE.erl index 043c753cf8..233e438dc9 100644 --- a/lib/kernel/test/heart_SUITE.erl +++ b/lib/kernel/test/heart_SUITE.erl @@ -22,7 +22,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, start/1, restart/1, - reboot/1, set_cmd/1, clear_cmd/1, + reboot/1, set_cmd/1, clear_cmd/1, get_cmd/1, dont_drop/1, kill_pid/1]). -export([init_per_testcase/2, end_per_testcase/2]). @@ -58,7 +58,7 @@ end_per_testcase(_Func, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [start, restart, reboot, set_cmd, clear_cmd, kill_pid]. + [start, restart, reboot, set_cmd, clear_cmd, get_cmd, kill_pid]. groups() -> []. @@ -246,6 +246,15 @@ clear_cmd(Config) when is_list(Config) -> end, ok. +get_cmd(suite) -> []; +get_cmd(Config) when is_list(Config) -> + ?line {ok, Node} = start_check(slave, heart_test), + Cmd = "test", + ?line ok = rpc:call(Node, heart, set_cmd, [Cmd]), + ?line {ok, Cmd} = rpc:call(Node, heart, get_cmd, []), + stop_node(Node), + ok. + dont_drop(suite) -> %%% Removed as it may crash epmd/distribution in colourful %%% ways. While we ARE finding out WHY, it would diff --git a/lib/kernel/test/inet_res_SUITE.erl b/lib/kernel/test/inet_res_SUITE.erl index 5fc8df475d..6064a9b2d9 100644 --- a/lib/kernel/test/inet_res_SUITE.erl +++ b/lib/kernel/test/inet_res_SUITE.erl @@ -27,7 +27,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2, end_per_testcase/2]). --export([basic/1, resolve/1, edns0/1, txt_record/1, files_monitor/1]). +-export([basic/1, resolve/1, edns0/1, txt_record/1, files_monitor/1, + last_ms_answer/1]). -export([ gethostbyaddr/0, gethostbyaddr/1, gethostbyaddr_v6/0, gethostbyaddr_v6/1, @@ -45,6 +46,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [basic, resolve, edns0, txt_record, files_monitor, + last_ms_answer, gethostbyaddr, gethostbyaddr_v6, gethostbyname, gethostbyname_v6, getaddr, getaddr_v6, ipv4_to_ipv6, host_and_addr]. @@ -64,16 +66,15 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. -zone_dir(basic) -> - otptest; -zone_dir(resolve) -> - otptest; -zone_dir(edns0) -> - otptest; -zone_dir(files_monitor) -> - otptest; -zone_dir(_) -> - undefined. +zone_dir(TC) -> + case TC of + basic -> otptest; + resolve -> otptest; + edns0 -> otptest; + files_monitor -> otptest; + last_ms_answer -> otptest; + _ -> undefined + end. init_per_testcase(Func, Config) -> PrivDir = ?config(priv_dir, Config), @@ -184,6 +185,88 @@ ns_printlog(Fname) -> ok end. +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% Behaviour modifying nameserver proxy + +proxy_start(TC, {NS,P}) -> + Tag = make_ref(), + Parent = self(), + Pid = + spawn_link( + fun () -> + try proxy_start(TC, NS, P, Parent, Tag) + catch C:X -> + io:format( + "~w: ~w:~p ~p~n", + [self(),C,X,erlang:get_stacktrace()]) + end + end), + receive {started,Tag,Port} -> + ProxyNS = {{127,0,0,1},Port}, + {proxy,Pid,Tag,ProxyNS} + end. + +proxy_start(TC, NS, P, Parent, Tag) -> + {ok,Outbound} = gen_udp:open(0, [binary]), + ok = gen_udp:connect(Outbound, NS, P), + {ok,Inbound} = gen_udp:open(0, [binary]), + {ok,Port} = inet:port(Inbound), + Parent ! {started,Tag,Port}, + proxy(TC, Outbound, NS, P, Inbound). + + +%% To provoke the last_ms_answer bug (OTP-9221) the proxy +%% * Relays the query to the right nameserver +%% * Intercepts the reply but holds it until the timer that +%% was started when receiving the query fires. +%% * Repeats the reply with incorrect query ID a number of +%% times with a short interval. +%% * Sends the correct reply, to give a correct test result +%% after bug correction. +%% +%% The repetition of an incorrect answer with tight interval will keep +%% inet_res in an inner loop in the code that decrements the remaining +%% time until it hits 0 which triggers a crash, if the outer timeout +%% parameter to inet_res:resolve is so short that it runs out during +%% these repetitions. +proxy(last_ms_answer, Outbound, NS, P, Inbound) -> + receive + {udp,Inbound,SrcIP,SrcPort,Data} -> + Time = + inet_db:res_option(timeout) div inet_db:res_option(retry), + Tag = erlang:make_ref(), + erlang:send_after(Time - 10, self(), {time,Tag}), + ok = gen_udp:send(Outbound, NS, P, Data), + receive + {udp,Outbound,NS,P,Reply} -> + {ok,Msg} = inet_dns:decode(Reply), + Hdr = inet_dns:msg(Msg, header), + Id = inet_dns:header(Hdr, id), + BadHdr = + inet_dns:make_header(Hdr, id, (Id+1) band 16#ffff), + BadMsg = inet_dns:make_msg(Msg, header, BadHdr), + BadReply = inet_dns:encode(BadMsg), + receive + {time,Tag} -> + proxy__last_ms_answer( + Inbound, SrcIP, SrcPort, BadReply, Reply, 30) + end + end + end. + +proxy__last_ms_answer(Socket, IP, Port, _, Reply, 0) -> + ok = gen_udp:send(Socket, IP, Port, Reply); +proxy__last_ms_answer(Socket, IP, Port, BadReply, Reply, N) -> + ok = gen_udp:send(Socket, IP, Port, BadReply), + receive after 1 -> ok end, + proxy__last_ms_answer(Socket, IP, Port, BadReply, Reply, N-1). + +proxy_wait({proxy,Pid,_,_}) -> + Mref = erlang:monitor(process, Pid), + receive {'DOWN',Mref,_,_,_} -> ok end. + +proxy_ns({proxy,_,_,ProxyNS}) -> ProxyNS. + %% %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -204,7 +287,7 @@ basic(Config) when is_list(Config) -> {ok,Msg1} = inet_dns:decode(Bin1), %% %% resolve - {ok,Msg2} = inet_res:resolve(Name, in, a, [{nameservers,[NS]}]), + {ok,Msg2} = inet_res:resolve(Name, in, a, [{nameservers,[NS]},verbose]), io:format("~p~n", [Msg2]), [RR2] = inet_dns:msg(Msg2, anlist), IP = inet_dns:rr(RR2, data), @@ -474,6 +557,26 @@ do_files_monitor(Config) -> ok. %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +last_ms_answer(doc) -> + ["Answer just when timeout is triggered (OTP-9221)"]; +last_ms_answer(Config) when is_list(Config) -> + NS = ns(Config), + Name = "ns.otptest", + %%IP = {127,0,0,254}, + Time = inet_db:res_option(timeout) div inet_db:res_option(retry), + PSpec = proxy_start(last_ms_answer, NS), + ProxyNS = proxy_ns(PSpec), + %% + %% resolve; whith short timeout to trigger Timeout =:= 0 in inet_res + {error,timeout} = + inet_res:resolve( + Name, in, a, [{nameservers,[ProxyNS]},verbose], Time + 10), + %% + proxy_wait(PSpec), + ok. + +%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Compatibility tests. Call the inet_SUITE tests, but with %% lookup = [file,dns] instead of [native] diff --git a/lib/megaco/test/Makefile b/lib/megaco/test/Makefile index 682b83d368..88f6f06e73 100644 --- a/lib/megaco/test/Makefile +++ b/lib/megaco/test/Makefile @@ -754,5 +754,5 @@ release_tests_spec: tests # $(HRL_FILES) $(ERL_FILES) \ # $(RELSYSDIR) # - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) diff --git a/lib/mnesia/doc/src/notes.xml b/lib/mnesia/doc/src/notes.xml index ccf70b8373..19574a1434 100644 --- a/lib/mnesia/doc/src/notes.xml +++ b/lib/mnesia/doc/src/notes.xml @@ -38,7 +38,35 @@ thus constitutes one section in this document. The title of each section is the version number of Mnesia.</p> - <section><title>Mnesia 4.4.17</title> + <section><title>Mnesia 4.4.18</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Call chmod without the "-f" flag</p> + <p> + "-f" is a non-standard chmod option which at least SGI + IRIX and HP UX do not support. As the only effect of the + "-f" flag is to suppress warning messages, it can be + safely omitted. (Thanks to Holger Wei�)</p> + <p> + Own Id: OTP-9170</p> + </item> + <item> + <p> + Mnesia sometimes failed to update meta-information in + large systems, which could cause table content to be + inconsistent between nodes.</p> + <p> + Own Id: OTP-9186 Aux Id: seq11728 </p> + </item> + </list> + </section> + +</section> + +<section><title>Mnesia 4.4.17</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/mnesia/src/mnesia.appup.src b/lib/mnesia/src/mnesia.appup.src index 0eff761b61..7bad6c4ea6 100644 --- a/lib/mnesia/src/mnesia.appup.src +++ b/lib/mnesia/src/mnesia.appup.src @@ -1,25 +1,33 @@ %% -*- erlang -*- {"%VSN%", [ - {"4.4.16",[ - {update, mnesia_frag, soft, soft_purge, soft_purge, []}, - {update, mnesia_schema, soft, soft_purge, soft_purge, []} + {"4.4.17",[ + {update, mnesia_controller, soft, soft_purge, soft_purge, []} ]}, - {"4.4.15",[ - {update, mnesia_frag, soft, soft_purge, soft_purge, []}, - {update, mnesia, soft, soft_purge, soft_purge, []}, - {update, mnesia_dumper, soft, soft_purge, soft_purge, []} - ]} - ], - [ {"4.4.16",[ + {update, mnesia_controller, soft, soft_purge, soft_purge, []}, {update, mnesia_frag, soft, soft_purge, soft_purge, []}, {update, mnesia_schema, soft, soft_purge, soft_purge, []} ]}, {"4.4.15",[ + {update, mnesia_controller, soft, soft_purge, soft_purge, []}, {update, mnesia_frag, soft, soft_purge, soft_purge, []}, {update, mnesia, soft, soft_purge, soft_purge, []}, {update, mnesia_dumper, soft, soft_purge, soft_purge, []} ]} - ] + ], + {"4.4.17",[ + {update, mnesia_controller, soft, soft_purge, soft_purge, []} + ]}, + {"4.4.16",[ + {update, mnesia_controller, soft, soft_purge, soft_purge, []}, + {update, mnesia_frag, soft, soft_purge, soft_purge, []}, + {update, mnesia_schema, soft, soft_purge, soft_purge, []} + ]}, + {"4.4.15",[ + {update, mnesia_controller, soft, soft_purge, soft_purge, []}, + {update, mnesia_frag, soft, soft_purge, soft_purge, []}, + {update, mnesia, soft, soft_purge, soft_purge, []}, + {update, mnesia_dumper, soft, soft_purge, soft_purge, []} + ]} }. diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl index 021be8af2a..0254769758 100644 --- a/lib/mnesia/src/mnesia_controller.erl +++ b/lib/mnesia/src/mnesia_controller.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -457,7 +457,7 @@ connect_nodes2(Father, Ns, UserFun) -> New1 = mnesia_lib:intersect(Ns, Connected), New = New1 -- Current, process_flag(trap_exit, true), - Res = try_merge_schema(New, UserFun), + Res = try_merge_schema(New, [], UserFun), Msg = {schema_is_merged, [], late_merge, []}, multicall([node()|Ns], Msg), After = val({current, db_nodes}), @@ -471,7 +471,7 @@ connect_nodes2(Father, Ns, UserFun) -> merge_schema() -> AllNodes = mnesia_lib:all_nodes(), - case try_merge_schema(AllNodes, fun default_merge/1) of + case try_merge_schema(AllNodes, [node()], fun default_merge/1) of ok -> schema_is_merged(); {aborted, {throw, Str}} when is_list(Str) -> @@ -483,11 +483,17 @@ merge_schema() -> default_merge(F) -> F([]). -try_merge_schema(Nodes, UserFun) -> +try_merge_schema(Nodes, Told0, UserFun) -> case mnesia_schema:merge_schema(UserFun) of {atomic, not_merged} -> %% No more nodes that we need to merge the schema with - ok; + %% Ensure we have told everybody that we are running + case val({current,db_nodes}) -- mnesia_lib:uniq(Told0) of + [] -> ok; + Tell -> + im_running(Tell, [node()]), + ok + end; {atomic, {merged, OldFriends, NewFriends}} -> %% Check if new nodes has been added to the schema Diff = mnesia_lib:all_nodes() -- [node() | Nodes], @@ -496,12 +502,18 @@ try_merge_schema(Nodes, UserFun) -> %% Tell everybody to adopt orphan tables im_running(OldFriends, NewFriends), im_running(NewFriends, OldFriends), - - try_merge_schema(Nodes, UserFun); + Told = case lists:member(node(), NewFriends) of + true -> Told0 ++ OldFriends; + false -> Told0 ++ NewFriends + end, + try_merge_schema(Nodes, Told, UserFun); {atomic, {"Cannot get cstructs", Node, Reason}} -> dbg_out("Cannot get cstructs, Node ~p ~p~n", [Node, Reason]), - timer:sleep(1000), % Avoid a endless loop look alike - try_merge_schema(Nodes, UserFun); + timer:sleep(300), % Avoid a endless loop look alike + try_merge_schema(Nodes, Told0, UserFun); + {aborted, {shutdown, _}} -> %% One of the nodes is going down + timer:sleep(300), % Avoid a endless loop look alike + try_merge_schema(Nodes, Told0, UserFun); Other -> Other end. @@ -915,6 +927,7 @@ handle_cast(unblock_controller, State) -> handle_cast({mnesia_down, Node}, State) -> maybe_log_mnesia_down(Node), mnesia_lib:del({current, db_nodes}, Node), + mnesia_lib:unset({node_up, Node}), mnesia_checkpoint:tm_mnesia_down(Node), Alltabs = val({schema, tables}), reconfigure_tables(Node, Alltabs), @@ -977,11 +990,12 @@ handle_cast(Msg, State) when State#state.schema_is_merged /= true -> %% This must be done after schema_is_merged otherwise adopt_orphan %% might trigger a table load from wrong nodes as a result of that we don't %% know which tables we can load safly first. -handle_cast({im_running, _Node, NewFriends}, State) -> +handle_cast({im_running, Node, NewFriends}, State) -> LocalTabs = mnesia_lib:local_active_tables() -- [schema], RemoveLocalOnly = fun(Tab) -> not val({Tab, local_content}) end, Tabs = lists:filter(RemoveLocalOnly, LocalTabs), - Ns = mnesia_lib:intersect(NewFriends, val({current, db_nodes})), + Nodes = mnesia_lib:union([Node],val({current, db_nodes})), + Ns = mnesia_lib:intersect(NewFriends, Nodes), abcast(Ns, {adopt_orphans, node(), Tabs}), noreply(State); @@ -1042,30 +1056,33 @@ handle_cast({master_nodes_updated, Tab, Masters}, State) -> end; handle_cast({adopt_orphans, Node, Tabs}, State) -> - State2 = node_has_tabs(Tabs, Node, State), - %% Register the other node as up and running - mnesia_recover:log_mnesia_up(Node), - verbose("Logging mnesia_up ~w~n",[Node]), - mnesia_lib:report_system_event({mnesia_up, Node}), - - %% Load orphan tables - LocalTabs = val({schema, local_tables}) -- [schema], - Nodes = val({current, db_nodes}), - {LocalOrphans, RemoteMasters} = - orphan_tables(LocalTabs, Node, Nodes, [], []), - Reason = {adopt_orphan, node()}, - mnesia_late_loader:async_late_disc_load(node(), LocalOrphans, Reason), - - Fun = - fun(N) -> - RemoteOrphans = - [Tab || {Tab, Ns} <- RemoteMasters, - lists:member(N, Ns)], - mnesia_late_loader:maybe_async_late_disc_load(N, RemoteOrphans, Reason) - end, - lists:foreach(Fun, Nodes), + case ?catch_val({node_up,Node}) of + true -> ignore; + _ -> + %% Register the other node as up and running + set({node_up, Node}, true), + mnesia_recover:log_mnesia_up(Node), + verbose("Logging mnesia_up ~w~n",[Node]), + mnesia_lib:report_system_event({mnesia_up, Node}), + %% Load orphan tables + LocalTabs = val({schema, local_tables}) -- [schema], + Nodes = val({current, db_nodes}), + {LocalOrphans, RemoteMasters} = + orphan_tables(LocalTabs, Node, Nodes, [], []), + Reason = {adopt_orphan, node()}, + mnesia_late_loader:async_late_disc_load(node(), LocalOrphans, Reason), + + Fun = + fun(N) -> + RemoteOrphans = + [Tab || {Tab, Ns} <- RemoteMasters, + lists:member(N, Ns)], + mnesia_late_loader:maybe_async_late_disc_load(N, RemoteOrphans, Reason) + end, + lists:foreach(Fun, Nodes) + end, noreply(State2); handle_cast(Msg, State) -> diff --git a/lib/mnesia/test/Makefile b/lib/mnesia/test/Makefile index 973ac2900a..b165924ef2 100644 --- a/lib/mnesia/test/Makefile +++ b/lib/mnesia/test/Makefile @@ -110,7 +110,7 @@ release_tests_spec: opt $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) mnesia.spec mnesia.cover $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR) $(INSTALL_SCRIPT) mt $(INSTALL_PROGS) $(RELSYSDIR) -# chmod -f -R u+w $(RELSYSDIR) +# chmod -R u+w $(RELSYSDIR) # @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/mnesia/vsn.mk b/lib/mnesia/vsn.mk index 5247657b68..38e1a94545 100644 --- a/lib/mnesia/vsn.mk +++ b/lib/mnesia/vsn.mk @@ -1 +1 @@ -MNESIA_VSN = 4.4.17 +MNESIA_VSN = 4.4.18 diff --git a/lib/observer/test/crashdump_helper.erl b/lib/observer/test/crashdump_helper.erl index 43b3db738f..6e9d4727ec 100644 --- a/lib/observer/test/crashdump_helper.erl +++ b/lib/observer/test/crashdump_helper.erl @@ -19,7 +19,7 @@ -module(crashdump_helper). -export([n1_proc/2,remote_proc/2]). --compile(r11). +-compile(r12). -include("test_server.hrl"). n1_proc(N2,Creator) -> diff --git a/lib/orber/test/Makefile b/lib/orber/test/Makefile index 88aeacbfe8..b682bcf24b 100644 --- a/lib/orber/test/Makefile +++ b/lib/orber/test/Makefile @@ -226,7 +226,7 @@ release_tests_spec: tests $(INSTALL_DATA) $(IDL_FILES) $(TEST_SPEC_FILE) $(COVER_FILE) \ $(ERL_FILES) $(RELSYSDIR) $(INSTALL_DATA) $(SUITE_TARGET_FILES) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) $(INSTALL_DIR) $(RELSYSDIR)/$(IDLOUTDIR) $(INSTALL_DATA) $(GEN_TARGET_FILES) $(GEN_FILES) \ $(RELSYSDIR)/$(IDLOUTDIR) diff --git a/lib/os_mon/src/disksup.erl b/lib/os_mon/src/disksup.erl index 3340f7ee72..3ee1df759f 100644 --- a/lib/os_mon/src/disksup.erl +++ b/lib/os_mon/src/disksup.erl @@ -103,6 +103,7 @@ init([]) -> Flavor==darwin; Flavor==linux; Flavor==openbsd; + Flavor==netbsd; Flavor==irix64; Flavor==irix -> start_portprogram(); @@ -267,6 +268,9 @@ check_disk_space({unix, freebsd}, Port, Threshold) -> check_disk_space({unix, openbsd}, Port, Threshold) -> Result = my_cmd("/bin/df -k -t ffs", Port), check_disks_solaris(skip_to_eol(Result), Threshold); +check_disk_space({unix, netbsd}, Port, Threshold) -> + Result = my_cmd("/bin/df -k -t ffs", Port), + check_disks_solaris(skip_to_eol(Result), Threshold); check_disk_space({unix, sunos4}, Port, Threshold) -> Result = my_cmd("df", Port), check_disks_solaris(skip_to_eol(Result), Threshold); diff --git a/lib/os_mon/src/memsup.erl b/lib/os_mon/src/memsup.erl index 822e1f939c..cc4941ee7d 100644 --- a/lib/os_mon/src/memsup.erl +++ b/lib/os_mon/src/memsup.erl @@ -176,9 +176,11 @@ init([]) -> PortMode = case OS of {unix, darwin} -> false; {unix, freebsd} -> false; + {unix, dragonfly} -> false; % Linux supports this. {unix, linux} -> true; {unix, openbsd} -> true; + {unix, netbsd} -> true; {unix, irix64} -> true; {unix, irix} -> true; {unix, sunos} -> true; @@ -610,8 +612,10 @@ code_change(Vsn, PrevState, "1.8") -> PortMode = case OS of {unix, darwin} -> false; {unix, freebsd} -> false; + {unix, dragonfly} -> false; {unix, linux} -> false; {unix, openbsd} -> true; + {unix, netbsd} -> true; {unix, sunos} -> true; {win32, _OSname} -> false; vxworks -> true @@ -687,6 +691,7 @@ get_os_wordsize({unix, linux}) -> get_os_wordsize_with_uname(); get_os_wordsize({unix, darwin}) -> get_os_wordsize_with_uname(); get_os_wordsize({unix, netbsd}) -> get_os_wordsize_with_uname(); get_os_wordsize({unix, freebsd}) -> get_os_wordsize_with_uname(); +get_os_wordsize({unix, dragonfly}) -> get_os_wordsize_with_uname(); get_os_wordsize({unix, openbsd}) -> get_os_wordsize_with_uname(); get_os_wordsize(_) -> unsupported_os. @@ -736,7 +741,7 @@ get_memory_usage({unix,darwin}) -> %% FreeBSD: Look in /usr/include/sys/vmmeter.h for the format of struct %% vmmeter -get_memory_usage({unix,freebsd}) -> +get_memory_usage({unix,OSname}) when OSname == freebsd; OSname == dragonfly -> PageSize = freebsd_sysctl("vm.stats.vm.v_page_size"), PageCount = freebsd_sysctl("vm.stats.vm.v_page_count"), FreeCount = freebsd_sysctl("vm.stats.vm.v_free_count"), @@ -779,6 +784,9 @@ get_ext_memory_usage(OS, {Alloc, Total}) -> {unix, freebsd} -> [{total_memory, Total}, {free_memory, Total-Alloc}, {system_total_memory, Total}]; + {unix, dragonfly} -> + [{total_memory, Total}, {free_memory, Total-Alloc}, + {system_total_memory, Total}]; {unix, darwin} -> [{total_memory, Total}, {free_memory, Total-Alloc}, {system_total_memory, Total}]; diff --git a/lib/parsetools/test/Makefile b/lib/parsetools/test/Makefile index dfb686d7ba..624c4e6975 100644 --- a/lib/parsetools/test/Makefile +++ b/lib/parsetools/test/Makefile @@ -72,7 +72,7 @@ release_spec: opt release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) parsetools.spec parsetools.cover $(EMAKEFILE) $(ERL_FILES) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) # @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/percept/test/Makefile b/lib/percept/test/Makefile index 5e8c438c5c..d927386d1c 100644 --- a/lib/percept/test/Makefile +++ b/lib/percept/test/Makefile @@ -83,7 +83,7 @@ release_spec: opt release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) percept.spec percept.cover $(EMAKEFILE) $(SOURCE) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/public_key/src/public_key.appup.src b/lib/public_key/src/public_key.appup.src index c65ac7bc99..4986801dad 100644 --- a/lib/public_key/src/public_key.appup.src +++ b/lib/public_key/src/public_key.appup.src @@ -1,6 +1,16 @@ %% -*- erlang -*- {"%VSN%", [ + {"0.11", + [ + {update, public_key, soft, soft_purge, soft_purge, []}, + {update, pubkey_pem, soft, soft_purge, soft_purge, []}, + {add_module, pubkey_ssh, soft, soft_purge, soft_purge}, + {update, pubkey_cert, soft, soft_purge, soft_purge, []}, + {update, pubkey_cert_records, soft, soft_purge, soft_purge, []} + ] + }, + {"0.10", [ {update, public_key, soft, soft_purge, soft_purge, []}, @@ -25,6 +35,16 @@ } ], [ + {"0.11", + [ + {update, public_key, soft, soft_purge, soft_purge, []}, + {update, pubkey_pem, soft, soft_purge, soft_purge, []}, + {delete_module, pubkey_ssh, soft, soft_purge, soft_purge}, + {update, pubkey_cert, soft, soft_purge, soft_purge, []}, + {update, pubkey_cert_records, soft, soft_purge, soft_purge, []} + ] + }, + {"0.10", [ {update, public_key, soft, soft_purge, soft_purge, []}, diff --git a/lib/public_key/test/Makefile b/lib/public_key/test/Makefile index e20b903942..6889ae9a8a 100644 --- a/lib/public_key/test/Makefile +++ b/lib/public_key/test/Makefile @@ -80,7 +80,7 @@ release_tests_spec: opt $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(SPEC_FILES) $(ERL_FILES) $(COVER_FILE) $(HRL_FILES) $(RELSYSDIR) $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/public_key/test/pkits_SUITE.erl b/lib/public_key/test/pkits_SUITE.erl index 660af4e8ab..a325a975e9 100644 --- a/lib/public_key/test/pkits_SUITE.erl +++ b/lib/public_key/test/pkits_SUITE.erl @@ -26,7 +26,6 @@ -compile(export_all). -include_lib("public_key/include/public_key.hrl"). -%%-include("public_key.hrl"). -define(error(Format,Args), error(Format,Args,?FILE,?LINE)). -define(warning(Format,Args), warning(Format,Args,?FILE,?LINE)). @@ -42,18 +41,65 @@ -define(NIST5, "2.16.840.1.101.3.2.1.48.5"). -define(NIST6, "2.16.840.1.101.3.2.1.48.6"). +-record(verify_state, { + certs_db, + crl_info, + revoke_state}). %% -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}]. all() -> - [signature_verification, validity_periods, - verifying_name_chaining, - verifying_paths_with_self_issued_certificates, - verifying_basic_constraints, key_usage, - name_constraints, private_certificate_extensions]. + [{group, signature_verification}, + {group, validity_periods}, + {group, verifying_name_chaining}, + {group, verifying_paths_with_self_issued_certificates}, + %%{group, basic_certificate_revocation_tests}, + %%{group, delta_crls}, + %%{group, distribution_points}, + {group, verifying_basic_constraints}, + {group, key_usage}, + {group, name_constraints}, + {group, private_certificate_extensions}]. groups() -> - []. + [{signature_verification, [], [valid_rsa_signature, + invalid_rsa_signature, valid_dsa_signature, + invalid_dsa_signature]}, + {validity_periods, [], + [not_before_invalid, not_before_valid, not_after_invalid, not_after_valid]}, + {verifying_name_chaining, [], + [invalid_name_chain, whitespace_name_chain, capitalization_name_chain, + uid_name_chain, attrib_name_chain, string_name_chain]}, + {verifying_paths_with_self_issued_certificates, [], + [basic_valid, basic_invalid, crl_signing_valid, crl_signing_invalid]}, + %% {basic_certificate_revocation_tests, [], + %% [missing_CRL, revoked_CA, revoked_peer, invalid_CRL_signature, + %% invalid_CRL_issuer, invalid_CRL, valid_CRL, + %% unknown_CRL_extension, old_CRL, fresh_CRL, valid_serial, + %% invalid_serial, valid_seperate_keys, invalid_separate_keys]}, + %% {delta_crls, [], [delta_without_crl, valid_delta_crls, invalid_delta_crls]}, + %% {distribution_points, [], [valid_distribution_points, + %% valid_distribution_points_no_issuing_distribution_point, + %% invalid_distribution_points, valid_only_contains, + %% invalid_only_contains, valid_only_some_reasons, + %% invalid_only_some_reasons, valid_indirect_crl, + %% invalid_indirect_crl, valid_crl_issuer, invalid_crl_issuer]}, + {verifying_basic_constraints,[], + [missing_basic_constraints, valid_basic_constraint, invalid_path_constraints, + valid_path_constraints]}, + {key_usage, [], + [invalid_key_usage, valid_key_usage]}, + {name_constraints, [], + [valid_DN_name_constraints, invalid_DN_name_constraints, + valid_rfc822_name_constraints, + invalid_rfc822_name_constraints, valid_DN_and_rfc822_name_constraints, + invalid_DN_and_rfc822_name_constraints, valid_dns_name_constraints, + invalid_dns_name_constraints, valid_uri_name_constraints, + invalid_uri_name_constraints]}, + {private_certificate_extensions, [], + [unknown_critical_extension, unknown_not_critical_extension]} + ]. init_per_group(_GroupName, Config) -> Config. @@ -61,112 +107,706 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +init_per_testcase(_Func, Config) -> + Datadir = proplists:get_value(data_dir, Config), + put(datadir, Datadir), + Config. + +end_per_testcase(_Func, Config) -> + Config. + +init_per_suite(Config) -> + {skip, "PKIX Conformance test certificates expired 14 of April 2011," + " new conformance test suite uses new format so skip until PKCS-12 support is implemented"}. + %% try crypto:start() of + %% ok -> + %% Config + %% catch _:_ -> + %% {skip, "Crypto did not start"} + %% end. + +end_per_suite(_Config) -> + application:stop(crypto). + +%%----------------------------------------------------------------------------- +valid_rsa_signature(doc) -> + ["Test rsa signatur verification"]; +valid_rsa_signature(suite) -> + []; +valid_rsa_signature(Config) when is_list(Config) -> + run([{ "4.1.1", "Valid Signatures Test1", ok}]). + +invalid_rsa_signature(doc) -> + ["Test rsa signatur verification"]; +invalid_rsa_signature(suite) -> + []; +invalid_rsa_signature(Config) when is_list(Config) -> + run([{ "4.1.2", "Invalid CA Signature Test2", {bad_cert,invalid_signature}}, + { "4.1.3", "Invalid EE Signature Test3", {bad_cert,invalid_signature}}]). + +valid_dsa_signature(doc) -> + ["Test dsa signatur verification"]; +valid_dsa_signature(suite) -> + []; +valid_dsa_signature(Config) when is_list(Config) -> + run([{ "4.1.4", "Valid DSA Signatures Test4", ok}, + { "4.1.5", "Valid DSA Parameter Inheritance Test5", ok}]). + +invalid_dsa_signature(doc) -> + ["Test dsa signatur verification"]; +invalid_dsa_signature(suite) -> + []; +invalid_dsa_signature(Config) when is_list(Config) -> + run([{ "4.1.6", "Invalid DSA Signature Test6",{bad_cert,invalid_signature}}]). +%%----------------------------------------------------------------------------- +not_before_invalid(doc) -> + [""]; +not_before_invalid(suite) -> + []; +not_before_invalid(Config) when is_list(Config) -> + run([{ "4.2.1", "Invalid CA notBefore Date Test1",{bad_cert, cert_expired}}, + { "4.2.2", "Invalid EE notBefore Date Test2",{bad_cert, cert_expired}}]). + +not_before_valid(doc) -> + [""]; +not_before_valid(suite) -> + []; +not_before_valid(Config) when is_list(Config) -> + run([{ "4.2.3", "Valid pre2000 UTC notBefore Date Test3", ok}, + { "4.2.4", "Valid GeneralizedTime notBefore Date Test4", ok}]). + +not_after_invalid(doc) -> + [""]; +not_after_invalid(suite) -> + []; +not_after_invalid(Config) when is_list(Config) -> + run([{ "4.2.5", "Invalid CA notAfter Date Test5", {bad_cert, cert_expired}}, + { "4.2.6", "Invalid EE notAfter Date Test6", {bad_cert, cert_expired}}, + { "4.2.7", "Invalid pre2000 UTC EE notAfter Date Test7",{bad_cert, cert_expired}}]). + +not_after_valid(doc) -> + [""]; +not_after_valid(suite) -> + []; +not_after_valid(Config) when is_list(Config) -> + run([{ "4.2.8", "Valid GeneralizedTime notAfter Date Test8", ok}]). +%%----------------------------------------------------------------------------- +invalid_name_chain(doc) -> + [""]; +invalid_name_chain(suite) -> + []; +invalid_name_chain(Config) when is_list(Config) -> + run([{ "4.3.1", "Invalid Name Chaining EE Test1", {bad_cert, invalid_issuer}}, + { "4.3.2", "Invalid Name Chaining Order Test2", {bad_cert, invalid_issuer}}]). + +whitespace_name_chain(doc) -> + [""]; +whitespace_name_chain(suite) -> + []; +whitespace_name_chain(Config) when is_list(Config) -> + run([{ "4.3.3", "Valid Name Chaining Whitespace Test3", ok}, + { "4.3.4", "Valid Name Chaining Whitespace Test4", ok}]). + +capitalization_name_chain(doc) -> + [""]; +capitalization_name_chain(suite) -> + []; +capitalization_name_chain(Config) when is_list(Config) -> + run([{ "4.3.5", "Valid Name Chaining Capitalization Test5",ok}]). + +uid_name_chain(doc) -> + [""]; +uid_name_chain(suite) -> + []; +uid_name_chain(Config) when is_list(Config) -> + run([{ "4.3.6", "Valid Name Chaining UIDs Test6",ok}]). + +attrib_name_chain(doc) -> + [""]; +attrib_name_chain(suite) -> + []; +attrib_name_chain(Config) when is_list(Config) -> + run([{ "4.3.7", "Valid RFC3280 Mandatory Attribute Types Test7", ok}, + { "4.3.8", "Valid RFC3280 Optional Attribute Types Test8", ok}]). + +string_name_chain(doc) -> + [""]; +string_name_chain(suite) -> + []; +string_name_chain(Config) when is_list(Config) -> + run([{ "4.3.9", "Valid UTF8String Encoded Names Test9", ok}, + { "4.3.10", "Valid Rollover from PrintableString to UTF8String Test10", ok}, + { "4.3.11", "Valid UTF8String Case Insensitive Match Test11", ok}]). + +%%----------------------------------------------------------------------------- + +basic_valid(doc) -> + [""]; +basic_valid(suite) -> + []; +basic_valid(Config) when is_list(Config) -> + run([{ "4.5.1", "Valid Basic Self-Issued Old With New Test1", ok}, + { "4.5.3", "Valid Basic Self-Issued New With Old Test3", ok}, + { "4.5.4", "Valid Basic Self-Issued New With Old Test4", ok} + ]). + +basic_invalid(doc) -> + [""]; +basic_invalid(suite) -> + []; +basic_invalid(Config) when is_list(Config) -> + run([{"4.5.2", "Invalid Basic Self-Issued Old With New Test2", + {bad_cert, {revoked, keyCompromise}}}, + {"4.5.5", "Invalid Basic Self-Issued New With Old Test5", + {bad_cert, {revoked, keyCompromise}}} + ]). + +crl_signing_valid(doc) -> + [""]; +crl_signing_valid(suite) -> + []; +crl_signing_valid(Config) when is_list(Config) -> + run([{ "4.5.6", "Valid Basic Self-Issued CRL Signing Key Test6", ok}]). + +crl_signing_invalid(doc) -> + [""]; +crl_signing_invalid(suite) -> + []; +crl_signing_invalid(Config) when is_list(Config) -> + run([{ "4.5.7", "Invalid Basic Self-Issued CRL Signing Key Test7", + {bad_cert, {revoked, keyCompromise}}}, + { "4.5.8", "Invalid Basic Self-Issued CRL Signing Key Test8", + {bad_cert, invalid_key_usage}} + ]). + +%%----------------------------------------------------------------------------- +missing_CRL(doc) -> + [""]; +missing_CRL(suite) -> + []; +missing_CRL(Config) when is_list(Config) -> + run([{ "4.4.1", "Missing CRL Test1",{bad_cert, + revocation_status_undetermined}}]). + +revoked_CA(doc) -> + [""]; +revoked_CA(suite) -> + []; +revoked_CA(Config) when is_list(Config) -> + run([{ "4.4.2", "Invalid Revoked CA Test2", {bad_cert, + {revoked, keyCompromise}}}]). + +revoked_peer(doc) -> + [""]; +revoked_peer(suite) -> + []; +revoked_peer(Config) when is_list(Config) -> + run([{ "4.4.3", "Invalid Revoked EE Test3", {bad_cert, + {revoked, keyCompromise}}}]). + +invalid_CRL_signature(doc) -> + [""]; +invalid_CRL_signature(suite) -> + []; +invalid_CRL_signature(Config) when is_list(Config) -> + run([{ "4.4.4", "Invalid Bad CRL Signature Test4", + {bad_cert, revocation_status_undetermined}}]). + +invalid_CRL_issuer(doc) -> + [""]; +invalid_CRL_issuer(suite) -> + []; +invalid_CRL_issuer(Config) when is_list(Config) -> + run({ "4.4.5", "Invalid Bad CRL Issuer Name Test5", + {bad_cert, revocation_status_undetermined}}). + +invalid_CRL(doc) -> + [""]; +invalid_CRL(suite) -> + []; +invalid_CRL(Config) when is_list(Config) -> + run([{ "4.4.6", "Invalid Wrong CRL Test6", + {bad_cert, revocation_status_undetermined}}]). + +valid_CRL(doc) -> + [""]; +valid_CRL(suite) -> + []; +valid_CRL(Config) when is_list(Config) -> + run([{ "4.4.7", "Valid Two CRLs Test7", ok}]). + +unknown_CRL_extension(doc) -> + [""]; +unknown_CRL_extension(suite) -> + []; +unknown_CRL_extension(Config) when is_list(Config) -> + run([{ "4.4.8", "Invalid Unknown CRL Entry Extension Test8", + {bad_cert, {revoked, keyCompromise}}}, + { "4.4.9", "Invalid Unknown CRL Extension Test9", + {bad_cert, {revoked, keyCompromise}}}, + { "4.4.10", "Invalid Unknown CRL Extension Test10", + {bad_cert, revocation_status_undetermined}}]). + +old_CRL(doc) -> + [""]; +old_CRL(suite) -> + []; +old_CRL(Config) when is_list(Config) -> + run([{ "4.4.11", "Invalid Old CRL nextUpdate Test11", + {bad_cert, revocation_status_undetermined}}, + { "4.4.12", "Invalid pre2000 CRL nextUpdate Test12", + {bad_cert, revocation_status_undetermined}}]). + +fresh_CRL(doc) -> + [""]; +fresh_CRL(suite) -> + []; +fresh_CRL(Config) when is_list(Config) -> + run([{ "4.4.13", "Valid GeneralizedTime CRL nextUpdate Test13", ok}]). + +valid_serial(doc) -> + [""]; +valid_serial(suite) -> + []; +valid_serial(Config) when is_list(Config) -> + run([ + { "4.4.14", "Valid Negative Serial Number Test14",ok}, + { "4.4.16", "Valid Long Serial Number Test16", ok}, + { "4.4.17", "Valid Long Serial Number Test17", ok} + ]). + +invalid_serial(doc) -> + [""]; +invalid_serial(suite) -> + []; +invalid_serial(Config) when is_list(Config) -> + run([{ "4.4.15", "Invalid Negative Serial Number Test15", + {bad_cert, {revoked, keyCompromise}}}, + { "4.4.18", "Invalid Long Serial Number Test18", + {bad_cert, {revoked, keyCompromise}}}]). + +valid_seperate_keys(doc) -> + [""]; +valid_seperate_keys(suite) -> + []; +valid_seperate_keys(Config) when is_list(Config) -> + run([{ "4.4.19", "Valid Separate Certificate and CRL Keys Test19", ok}]). + +invalid_separate_keys(doc) -> + [""]; +invalid_separate_keys(suite) -> + []; +invalid_separate_keys(Config) when is_list(Config) -> + run([{ "4.4.20", "Invalid Separate Certificate and CRL Keys Test20", + {bad_cert, {revoked, keyCompromise}}}, + { "4.4.21", "Invalid Separate Certificate and CRL Keys Test21", + {bad_cert, revocation_status_undetermined}} + ]). +%%----------------------------------------------------------------------------- +missing_basic_constraints(doc) -> + [""]; +missing_basic_constraints(suite) -> + []; +missing_basic_constraints(Config) when is_list(Config) -> + run([{ "4.6.1", "Invalid Missing basicConstraints Test1", + {bad_cert, missing_basic_constraint}}, + { "4.6.2", "Invalid cA False Test2", + {bad_cert, missing_basic_constraint}}, + { "4.6.3", "Invalid cA False Test3", + {bad_cert, missing_basic_constraint}}]). + +valid_basic_constraint(doc) -> + [""]; +valid_basic_constraint(suite) -> + []; +valid_basic_constraint(Config) when is_list(Config) -> + run([{"4.6.4", "Valid basicConstraints Not Critical Test4", ok}]). + +invalid_path_constraints(doc) -> + [""]; +invalid_path_constraints(suite) -> + []; +invalid_path_constraints(Config) when is_list(Config) -> + run([{ "4.6.5", "Invalid pathLenConstraint Test5", {bad_cert, max_path_length_reached}}, + { "4.6.6", "Invalid pathLenConstraint Test6", {bad_cert, max_path_length_reached}}, + { "4.6.9", "Invalid pathLenConstraint Test9", {bad_cert, max_path_length_reached}}, + { "4.6.10", "Invalid pathLenConstraint Test10", {bad_cert, max_path_length_reached}}, + { "4.6.11", "Invalid pathLenConstraint Test11", {bad_cert, max_path_length_reached}}, + { "4.6.12", "Invalid pathLenConstraint Test12", {bad_cert, max_path_length_reached}}, + { "4.6.16", "Invalid Self-Issued pathLenConstraint Test16", + {bad_cert, max_path_length_reached}}]). -signature_verification(doc) -> [""]; -signature_verification(suite) -> []; -signature_verification(Config) when is_list(Config) -> - run(signature_verification()). -validity_periods(doc) -> [""]; -validity_periods(suite) -> []; -validity_periods(Config) when is_list(Config) -> - run(validity_periods()). -verifying_name_chaining(doc) -> [""]; -verifying_name_chaining(suite) -> []; -verifying_name_chaining(Config) when is_list(Config) -> - run(verifying_name_chaining()). -basic_certificate_revocation_tests(doc) -> [""]; -basic_certificate_revocation_tests(suite) -> []; -basic_certificate_revocation_tests(Config) when is_list(Config) -> - run(basic_certificate_revocation_tests()). -verifying_paths_with_self_issued_certificates(doc) -> [""]; -verifying_paths_with_self_issued_certificates(suite) -> []; -verifying_paths_with_self_issued_certificates(Config) when is_list(Config) -> - run(verifying_paths_with_self_issued_certificates()). -verifying_basic_constraints(doc) -> [""]; -verifying_basic_constraints(suite) -> []; -verifying_basic_constraints(Config) when is_list(Config) -> - run(verifying_basic_constraints()). -key_usage(doc) -> [""]; -key_usage(suite) -> []; -key_usage(Config) when is_list(Config) -> - run(key_usage()). +valid_path_constraints(doc) -> + [""]; +valid_path_constraints(suite) -> + []; +valid_path_constraints(Config) when is_list(Config) -> + run([{ "4.6.7", "Valid pathLenConstraint Test7", ok}, + { "4.6.8", "Valid pathLenConstraint Test8", ok}, + { "4.6.13", "Valid pathLenConstraint Test13", ok}, + { "4.6.14", "Valid pathLenConstraint Test14", ok}, + { "4.6.15", "Valid Self-Issued pathLenConstraint Test15", ok}, + { "4.6.17", "Valid Self-Issued pathLenConstraint Test17", ok}]). + +%%----------------------------------------------------------------------------- +invalid_key_usage(doc) -> + [""]; +invalid_key_usage(suite) -> + []; +invalid_key_usage(Config) when is_list(Config) -> + run([{ "4.7.1", "Invalid keyUsage Critical keyCertSign False Test1", + {bad_cert,invalid_key_usage} }, + { "4.7.2", "Invalid keyUsage Not Critical keyCertSign False Test2", + {bad_cert,invalid_key_usage}}, + { "4.7.4", "Invalid keyUsage Critical cRLSign False Test4", + {bad_cert, revocation_status_undetermined}}, + { "4.7.5", "Invalid keyUsage Not Critical cRLSign False Test5", + {bad_cert, revocation_status_undetermined}} + ]). + +valid_key_usage(doc) -> + [""]; +valid_key_usage(suite) -> + []; +valid_key_usage(Config) when is_list(Config) -> + run([{ "4.7.3", "Valid keyUsage Not Critical Test3", ok}]). + +%%----------------------------------------------------------------------------- certificate_policies(doc) -> [""]; certificate_policies(suite) -> []; certificate_policies(Config) when is_list(Config) -> run(certificate_policies()). +%%----------------------------------------------------------------------------- require_explicit_policy(doc) -> [""]; require_explicit_policy(suite) -> []; require_explicit_policy(Config) when is_list(Config) -> run(require_explicit_policy()). +%%----------------------------------------------------------------------------- policy_mappings(doc) -> [""]; policy_mappings(suite) -> []; policy_mappings(Config) when is_list(Config) -> run(policy_mappings()). +%%----------------------------------------------------------------------------- inhibit_policy_mapping(doc) -> [""]; inhibit_policy_mapping(suite) -> []; inhibit_policy_mapping(Config) when is_list(Config) -> run(inhibit_policy_mapping()). +%%----------------------------------------------------------------------------- inhibit_any_policy(doc) -> [""]; inhibit_any_policy(suite) -> []; inhibit_any_policy(Config) when is_list(Config) -> run(inhibit_any_policy()). -name_constraints(doc) -> [""]; -name_constraints(suite) -> []; -name_constraints(Config) when is_list(Config) -> - run(name_constraints()). -distribution_points(doc) -> [""]; -distribution_points(suite) -> []; -distribution_points(Config) when is_list(Config) -> - run(distribution_points()). -delta_crls(doc) -> [""]; -delta_crls(suite) -> []; -delta_crls(Config) when is_list(Config) -> - run(delta_crls()). -private_certificate_extensions(doc) -> [""]; -private_certificate_extensions(suite) -> []; -private_certificate_extensions(Config) when is_list(Config) -> - run(private_certificate_extensions()). - -run() -> - Tests = - [signature_verification(), - validity_periods(), - verifying_name_chaining(), - %%basic_certificate_revocation_tests(), - verifying_paths_with_self_issued_certificates(), - verifying_basic_constraints(), - key_usage(), - %%certificate_policies(), - %%require_explicit_policy(), - %%policy_mappings(), - %%inhibit_policy_mapping(), - %%inhibit_any_policy(), - name_constraints(), - %distribution_points(), - %delta_crls(), - private_certificate_extensions() - ], - run(lists:append(Tests)). +%%----------------------------------------------------------------------------- + +valid_DN_name_constraints(doc) -> + [""]; +valid_DN_name_constraints(suite) -> + []; +valid_DN_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.1", "Valid DN nameConstraints Test1", ok}, + { "4.13.4", "Valid DN nameConstraints Test4", ok}, + { "4.13.5", "Valid DN nameConstraints Test5", ok}, + { "4.13.6", "Valid DN nameConstraints Test6", ok}, + { "4.13.11", "Valid DN nameConstraints Test11", ok}, + { "4.13.14", "Valid DN nameConstraints Test14", ok}, + { "4.13.18", "Valid DN nameConstraints Test18", ok}, + { "4.13.19", "Valid Self-Issued DN nameConstraints Test19", ok}]). + +invalid_DN_name_constraints(doc) -> + [""]; +invalid_DN_name_constraints(suite) -> + []; +invalid_DN_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.2", "Invalid DN nameConstraints Test2", {bad_cert, name_not_permitted}}, + { "4.13.3", "Invalid DN nameConstraints Test3", {bad_cert, name_not_permitted}}, + { "4.13.7", "Invalid DN nameConstraints Test7", {bad_cert, name_not_permitted}}, + { "4.13.8", "Invalid DN nameConstraints Test8", {bad_cert, name_not_permitted}}, + { "4.13.9", "Invalid DN nameConstraints Test9", {bad_cert, name_not_permitted}}, + { "4.13.10", "Invalid DN nameConstraints Test10",{bad_cert, name_not_permitted}}, + { "4.13.12", "Invalid DN nameConstraints Test12",{bad_cert, name_not_permitted}}, + { "4.13.13", "Invalid DN nameConstraints Test13",{bad_cert, name_not_permitted}}, + { "4.13.15", "Invalid DN nameConstraints Test15",{bad_cert, name_not_permitted}}, + { "4.13.16", "Invalid DN nameConstraints Test16",{bad_cert, name_not_permitted}}, + { "4.13.17", "Invalid DN nameConstraints Test17",{bad_cert, name_not_permitted}}, + { "4.13.20", "Invalid Self-Issued DN nameConstraints Test20", + {bad_cert, name_not_permitted}}]). + +valid_rfc822_name_constraints(doc) -> + [""]; +valid_rfc822_name_constraints(suite) -> + []; +valid_rfc822_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.21", "Valid RFC822 nameConstraints Test21", ok}, + { "4.13.23", "Valid RFC822 nameConstraints Test23", ok}, + { "4.13.25", "Valid RFC822 nameConstraints Test25", ok}]). + + +invalid_rfc822_name_constraints(doc) -> + [""]; +invalid_rfc822_name_constraints(suite) -> + []; +invalid_rfc822_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.22", "Invalid RFC822 nameConstraints Test22", + {bad_cert, name_not_permitted}}, + { "4.13.24", "Invalid RFC822 nameConstraints Test24", + {bad_cert, name_not_permitted}}, + { "4.13.26", "Invalid RFC822 nameConstraints Test26", + {bad_cert, name_not_permitted}}]). + +valid_DN_and_rfc822_name_constraints(doc) -> + [""]; +valid_DN_and_rfc822_name_constraints(suite) -> + []; +valid_DN_and_rfc822_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.27", "Valid DN and RFC822 nameConstraints Test27", ok}]). + +invalid_DN_and_rfc822_name_constraints(doc) -> + [""]; +invalid_DN_and_rfc822_name_constraints(suite) -> + []; +invalid_DN_and_rfc822_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.28", "Invalid DN and RFC822 nameConstraints Test28", + {bad_cert, name_not_permitted}}, + { "4.13.29", "Invalid DN and RFC822 nameConstraints Test29", + {bad_cert, name_not_permitted}}]). + +valid_dns_name_constraints(doc) -> + [""]; +valid_dns_name_constraints(suite) -> + []; +valid_dns_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.30", "Valid DNS nameConstraints Test30", ok}, + { "4.13.32", "Valid DNS nameConstraints Test32", ok}]). + +invalid_dns_name_constraints(doc) -> + [""]; +invalid_dns_name_constraints(suite) -> + []; +invalid_dns_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.31", "Invalid DNS nameConstraints Test31", {bad_cert, name_not_permitted}}, + { "4.13.33", "Invalid DNS nameConstraints Test33", {bad_cert, name_not_permitted}}, + { "4.13.38", "Invalid DNS nameConstraints Test38", {bad_cert, name_not_permitted}}]). + +valid_uri_name_constraints(doc) -> + [""]; +valid_uri_name_constraints(suite) -> + []; +valid_uri_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.34", "Valid URI nameConstraints Test34", ok}, + { "4.13.36", "Valid URI nameConstraints Test36", ok}]). + +invalid_uri_name_constraints(doc) -> + [""]; +invalid_uri_name_constraints(suite) -> + []; +invalid_uri_name_constraints(Config) when is_list(Config) -> + run([{ "4.13.35", "Invalid URI nameConstraints Test35",{bad_cert, name_not_permitted}}, + { "4.13.37", "Invalid URI nameConstraints Test37",{bad_cert, name_not_permitted}}]). + +%%----------------------------------------------------------------------------- +delta_without_crl(doc) -> + [""]; +delta_without_crl(suite) -> + []; +delta_without_crl(Config) when is_list(Config) -> + run([{ "4.15.1", "Invalid deltaCRLIndicator No Base Test1",{bad_cert, + revocation_status_undetermined}}, + {"4.15.10", "Invalid delta-CRL Test10", {bad_cert, + revocation_status_undetermined}}]). + +valid_delta_crls(doc) -> + [""]; +valid_delta_crls(suite) -> + []; +valid_delta_crls(Config) when is_list(Config) -> + run([{ "4.15.2", "Valid delta-CRL Test2", ok}, + { "4.15.5", "Valid delta-CRL Test5", ok}, + { "4.15.7", "Valid delta-CRL Test7", ok}, + { "4.15.8", "Valid delta-CRL Test8", ok} + ]). + +invalid_delta_crls(doc) -> + [""]; +invalid_delta_crls(suite) -> + []; +invalid_delta_crls(Config) when is_list(Config) -> + run([{ "4.15.3", "Invalid delta-CRL Test3", {bad_cert,{revoked, keyCompromise}}}, + { "4.15.4", "Invalid delta-CRL Test4", {bad_cert,{revoked, keyCompromise}}}, + { "4.15.6", "Invalid delta-CRL Test6", {bad_cert,{revoked, keyCompromise}}}, + { "4.15.9", "Invalid delta-CRL Test9", {bad_cert,{revoked, keyCompromise}}}]). + +%%----------------------------------------------------------------------------- + +valid_distribution_points(doc) -> + [""]; +valid_distribution_points(suite) -> + []; +valid_distribution_points(Config) when is_list(Config) -> + run([{ "4.14.1", "Valid distributionPoint Test1", ok}, + { "4.14.4", "Valid distributionPoint Test4", ok}, + { "4.14.5", "Valid distributionPoint Test5", ok}, + { "4.14.7", "Valid distributionPoint Test7", ok} + ]). + +valid_distribution_points_no_issuing_distribution_point(doc) -> + [""]; +valid_distribution_points_no_issuing_distribution_point(suite) -> + []; +valid_distribution_points_no_issuing_distribution_point(Config) when is_list(Config) -> + run([{ "4.14.10", "Valid No issuingDistributionPoint Test10", ok} + ]). + +invalid_distribution_points(doc) -> + [""]; +invalid_distribution_points(suite) -> + []; +invalid_distribution_points(Config) when is_list(Config) -> + run([{ "4.14.2", "Invalid distributionPoint Test2", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.3", "Invalid distributionPoint Test3", {bad_cert, + revocation_status_undetermined}}, + { "4.14.6", "Invalid distributionPoint Test6", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.8", "Invalid distributionPoint Test8", {bad_cert, + revocation_status_undetermined}}, + { "4.14.9", "Invalid distributionPoint Test9", {bad_cert, + revocation_status_undetermined}} + ]). + +valid_only_contains(doc) -> + [""]; +valid_only_contains(suite) -> + []; +valid_only_contains(Config) when is_list(Config) -> + run([{ "4.14.13", "Valid onlyContainsCACerts CRL Test13", ok}]). + +invalid_only_contains(doc) -> + [""]; +invalid_only_contains(suite) -> + []; +invalid_only_contains(Config) when is_list(Config) -> + run([{ "4.14.11", "Invalid onlyContainsUserCerts CRL Test11", + {bad_cert, revocation_status_undetermined}}, + { "4.14.12", "Invalid onlyContainsCACerts CRL Test12", + {bad_cert, revocation_status_undetermined}}, + { "4.14.14", "Invalid onlyContainsAttributeCerts Test14", + {bad_cert, revocation_status_undetermined}} + ]). + +valid_only_some_reasons(doc) -> + [""]; +valid_only_some_reasons(suite) -> + []; +valid_only_some_reasons(Config) when is_list(Config) -> + run([{ "4.14.18", "Valid onlySomeReasons Test18", ok}, + { "4.14.19", "Valid onlySomeReasons Test19", ok} + ]). + +invalid_only_some_reasons(doc) -> + [""]; +invalid_only_some_reasons(suite) -> + []; +invalid_only_some_reasons(Config) when is_list(Config) -> + run([{ "4.14.15", "Invalid onlySomeReasons Test15", + {bad_cert,{revoked, keyCompromise}}}, + { "4.14.16", "Invalid onlySomeReasons Test16", + {bad_cert,{revoked, certificateHold}}}, + { "4.14.17", "Invalid onlySomeReasons Test17", + {bad_cert, revocation_status_undetermined}}, + { "4.14.20", "Invalid onlySomeReasons Test20", + {bad_cert,{revoked, keyCompromise}}}, + { "4.14.21", "Invalid onlySomeReasons Test21", + {bad_cert,{revoked, affiliationChanged}}} + ]). + +valid_indirect_crl(doc) -> + [""]; +valid_indirect_crl(suite) -> + []; +valid_indirect_crl(Config) when is_list(Config) -> + run([{ "4.14.22", "Valid IDP with indirectCRL Test22", ok}, + { "4.14.24", "Valid IDP with indirectCRL Test24", ok}, + { "4.14.25", "Valid IDP with indirectCRL Test25", ok} + ]). + +invalid_indirect_crl(doc) -> + [""]; +invalid_indirect_crl(suite) -> + []; +invalid_indirect_crl(Config) when is_list(Config) -> + run([{ "4.14.23", "Invalid IDP with indirectCRL Test23", + {bad_cert,{revoked, keyCompromise}}}, + { "4.14.26", "Invalid IDP with indirectCRL Test26", + {bad_cert, revocation_status_undetermined}} + ]). + +valid_crl_issuer(doc) -> + [""]; +valid_crl_issuer(suite) -> + []; +valid_crl_issuer(Config) when is_list(Config) -> + run([{ "4.14.28", "Valid cRLIssuer Test28", ok}%%, + %%{ "4.14.29", "Valid cRLIssuer Test29", ok}, + %%{ "4.14.33", "Valid cRLIssuer Test33", ok} + ]). + +invalid_crl_issuer(doc) -> + [""]; +invalid_crl_issuer(suite) -> + []; +invalid_crl_issuer(Config) when is_list(Config) -> + run([ + { "4.14.27", "Invalid cRLIssuer Test27", {bad_cert, revocation_status_undetermined}}, + { "4.14.31", "Invalid cRLIssuer Test31", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.32", "Invalid cRLIssuer Test32", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.34", "Invalid cRLIssuer Test34", {bad_cert,{revoked, keyCompromise}}}, + { "4.14.35", "Invalid cRLIssuer Test35", {bad_cert, revocation_status_undetermined}} + ]). + + +%%distribution_points() -> + %%{ "4.14", "Distribution Points" }, +%% [ + %% Although this test is valid it has a circular dependency. As a result + %% an attempt is made to reursively checks a CRL path and rejected due to + %% a CRL path validation error. PKITS notes suggest this test does not + %% need to be run due to this issue. +%% { "4.14.30", "Valid cRLIssuer Test30", 54 }]. + + +%%----------------------------------------------------------------------------- + +unknown_critical_extension(doc) -> + [""]; +unknown_critical_extension(suite) -> + []; +unknown_critical_extension(Config) when is_list(Config) -> + run([{ "4.16.2", "Invalid Unknown Critical Certificate Extension Test2", + {bad_cert,unknown_critical_extension}}]). + +unknown_not_critical_extension(doc) -> + [""]; +unknown_not_critical_extension(suite) -> + []; +unknown_not_critical_extension(Config) when is_list(Config) -> + run([{ "4.16.1", "Valid Unknown Not Critical Certificate Extension Test1", ok}]). + +%%----------------------------------------------------------------------------- run(Tests) -> File = file(?CERTS,"TrustAnchorRootCertificate.crt"), {ok, TA} = file:read_file(File), run(Tests, TA). run({Chap, Test, Result}, TA) -> - CertChain = sort_chain(read_certs(Test),TA, [], false), - try public_key:pkix_path_validation(TA, CertChain, []) of - {Result, _} -> ok; + CertChain = sort_chain(read_certs(Test),TA, [], false, Chap), + Options = path_validation_options(TA, Chap,Test), + try public_key:pkix_path_validation(TA, CertChain, Options) of + {Result, _} -> ok; {error,Result} when Result =/= ok -> ok; - {error,Error} when is_integer(Result) -> - ?warning(" ~p~n Got ~p expected ~p~n",[Test, Error, Result]); - {error,Error} when Result =/= ok -> - ?error(" minor ~p~n Got ~p expected ~p~n",[Test, Error, Result]); {error, Error} -> ?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, Error]), fail; - {ok, _} when Result =/= ok -> + {ok, _OK} when Result =/= ok -> ?error(" ~p ~p~n Expected ~p got ~p ~n", [Chap, Test, Result, ok]), fail catch Type:Reason -> @@ -181,14 +821,318 @@ run([Test|Rest],TA) -> run(Rest,TA); run([],_) -> ok. +path_validation_options(TA, Chap, Test) -> + case needs_crl_options(Chap) of + true -> + crl_options(TA, Test); + false -> + Fun = + fun(_,{bad_cert, _} = Reason, _) -> + {fail, Reason}; + (_,{extension, _}, UserState) -> + {unknown, UserState}; + (_, Valid, UserState) when Valid == valid; + Valid == valid_peer -> + {valid, UserState} + end, + [{verify_fun, {Fun, []}}] + end. + +needs_crl_options("4.4" ++ _) -> + true; +needs_crl_options("4.5" ++ _) -> + true; +needs_crl_options("4.7.4" ++ _) -> + true; +needs_crl_options("4.7.5" ++ _) -> + true; +needs_crl_options("4.14" ++ _) -> + true; +needs_crl_options("4.15" ++ _) -> + true; +needs_crl_options(_) -> + false. + +crl_options(TA, Test) -> + case read_crls(Test) of + [] -> + []; + CRLs -> + Fun = + fun(_,{bad_cert, _} = Reason, _) -> + {fail, Reason}; + (_,{extension, + #'Extension'{extnID = ?'id-ce-cRLDistributionPoints', + extnValue = Value}}, UserState0) -> + UserState = update_crls(Value, UserState0), + {valid, UserState}; + (_,{extension, _}, UserState) -> + {unknown, UserState}; + (OtpCert, Valid, UserState) when Valid == valid; + Valid == valid_peer -> + {ErlCerts, CRLs} = UserState#verify_state.crl_info, + CRLInfo0 = + crl_info(OtpCert, + ErlCerts,[{DerCRL, public_key:der_decode('CertificateList', + DerCRL)} || DerCRL <- CRLs], + []), + CRLInfo = lists:reverse(CRLInfo0), + Certs = UserState#verify_state.certs_db, + Fun = fun(DP, CRLtoValidate, Id, CertsDb) -> + trusted_cert_and_path(DP, CRLtoValidate, Id, CertsDb) + end, + Ignore = ignore_sign_test_when_building_path(Test), + case public_key:pkix_crls_validate(OtpCert, CRLInfo, + [{issuer_fun,{Fun, {Ignore, Certs}}}]) of + valid -> + {valid, UserState}; + Reason -> + {fail, Reason} + end + end, + + Certs = read_certs(Test), + ErlCerts = [public_key:pkix_decode_cert(Cert, otp) || Cert <- Certs], + + [{verify_fun, {Fun, #verify_state{certs_db = [TA| Certs], + crl_info = {ErlCerts, CRLs}}}}] + end. + +crl_info(_, _, [], Acc) -> + Acc; +crl_info(OtpCert, Certs, [{_, #'CertificateList'{tbsCertList = + #'TBSCertList'{issuer = Issuer, + crlExtensions = CRLExtensions}}} + = CRL | Rest], Acc) -> + OtpTBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + Extensions = OtpTBSCert#'OTPTBSCertificate'.extensions, + ExtList = pubkey_cert:extensions_list(CRLExtensions), + DPs = case pubkey_cert:select_extension(?'id-ce-cRLDistributionPoints', Extensions) of + #'Extension'{extnValue = Value} -> + lists:map(fun(Point) -> pubkey_cert_records:transform(Point, decode) end, Value); + _ -> + case same_issuer(OtpCert, Issuer) of + true -> + [make_dp(ExtList, asn1_NOVALUE, Issuer)]; + false -> + [make_dp(ExtList, Issuer, ignore)] + end + end, + DPsCRLs = lists:map(fun(DP) -> {DP, CRL} end, DPs), + crl_info(OtpCert, Certs, Rest, DPsCRLs ++ Acc). + +ignore_sign_test_when_building_path("Invalid Bad CRL Signature Test4") -> + true; +ignore_sign_test_when_building_path(_) -> + false. + +same_issuer(OTPCert, Issuer) -> + DecIssuer = pubkey_cert_records:transform(Issuer, decode), + OTPTBSCert = OTPCert#'OTPCertificate'.tbsCertificate, + CertIssuer = OTPTBSCert#'OTPTBSCertificate'.issuer, + pubkey_cert:is_issuer(DecIssuer, CertIssuer). + +make_dp(Extensions, Issuer0, DpInfo) -> + {Issuer, Point} = mk_issuer_dp(Issuer0, DpInfo), + case pubkey_cert:select_extension('id-ce-cRLReason', Extensions) of + #'Extension'{extnValue = Reasons} -> + #'DistributionPoint'{cRLIssuer = Issuer, + reasons = Reasons, + distributionPoint = Point}; + _ -> + #'DistributionPoint'{cRLIssuer = Issuer, + reasons = [unspecified, keyCompromise, + cACompromise, affiliationChanged, superseded, + cessationOfOperation, certificateHold, + removeFromCRL, privilegeWithdrawn, aACompromise], + distributionPoint = Point} + end. + +mk_issuer_dp(asn1_NOVALUE, Issuer) -> + {asn1_NOVALUE, {fullName, [{directoryName, Issuer}]}}; +mk_issuer_dp(Issuer, _) -> + {[{directoryName, Issuer}], asn1_NOVALUE}. + +update_crls(_, State) -> + State. + +trusted_cert_and_path(DP, CRL, Id, {Ignore, CertsList}) -> + case crl_issuer(crl_issuer_name(DP), CRL, Id, CertsList, CertsList, Ignore) of + {ok, IssuerCert, DerIssuerCert} -> + Certs = [{public_key:pkix_decode_cert(Cert, otp), Cert} || Cert <- CertsList], + CertChain = build_chain(Certs, Certs, IssuerCert, Ignore, [DerIssuerCert]), + {ok, public_key:pkix_decode_cert(hd(CertChain), otp), CertChain}; + Other -> + Other + end. + +crl_issuer_name(#'DistributionPoint'{cRLIssuer = asn1_NOVALUE}) -> + undefined; +crl_issuer_name(#'DistributionPoint'{cRLIssuer = [{directoryName, Issuer}]}) -> + pubkey_cert_records:transform(Issuer, decode). + +build_chain([],_, _, _,Acc) -> + Acc; + +build_chain([{First, DerFirst}|Certs], All, Cert, Ignore, Acc) -> + case public_key:pkix_is_self_signed(Cert) andalso is_test_root(Cert) of + true -> + Acc; + false -> + case public_key:pkix_is_issuer(Cert, First) + %%andalso check_extension_cert_signer(First) + andalso is_signer(First, Cert, Ignore) + of + true -> + build_chain(All, All, First, Ignore, [DerFirst | Acc]); + false -> + build_chain(Certs, All, Cert, Ignore, Acc) + end + end. + +is_signer(_,_, true) -> + true; +is_signer(Signer, #'OTPCertificate'{} = Cert,_) -> + TBSCert = Signer#'OTPCertificate'.tbsCertificate, + PublicKeyInfo = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, + PublicKey = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.subjectPublicKey, + AlgInfo = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm, + PublicKeyParams = AlgInfo#'PublicKeyAlgorithm'.parameters, + try pubkey_cert:validate_signature(Cert, public_key:pkix_encode('OTPCertificate', + Cert, otp), + PublicKey, PublicKeyParams, true, ?DEFAULT_VERIFYFUN) of + true -> + true + catch + _:_ -> + false + end; +is_signer(Signer, #'CertificateList'{} = CRL, _) -> + TBSCert = Signer#'OTPCertificate'.tbsCertificate, + PublicKeyInfo = TBSCert#'OTPTBSCertificate'.subjectPublicKeyInfo, + PublicKey = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.subjectPublicKey, + AlgInfo = PublicKeyInfo#'OTPSubjectPublicKeyInfo'.algorithm, + PublicKeyParams = AlgInfo#'PublicKeyAlgorithm'.parameters, + pubkey_crl:verify_crl_signature(CRL, public_key:pkix_encode('CertificateList', + CRL, plain), + PublicKey, PublicKeyParams). + +is_test_root(OtpCert) -> + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + {rdnSequence, AtterList} = TBSCert#'OTPTBSCertificate'.issuer, + lists:member([{'AttributeTypeAndValue',{2,5,4,3},{printableString,"Trust Anchor"}}], + AtterList). + +check_extension_cert_signer(OtpCert) -> + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + Extensions = TBSCert#'OTPTBSCertificate'.extensions, + case pubkey_cert:select_extension(?'id-ce-keyUsage', Extensions) of + #'Extension'{extnValue = KeyUse} -> + lists:member(keyCertSign, KeyUse); + _ -> + true + end. + +check_extension_crl_signer(OtpCert) -> + TBSCert = OtpCert#'OTPCertificate'.tbsCertificate, + Extensions = TBSCert#'OTPTBSCertificate'.extensions, + case pubkey_cert:select_extension(?'id-ce-keyUsage', Extensions) of + #'Extension'{extnValue = KeyUse} -> + lists:member(cRLSign, KeyUse); + _ -> + true + end. + +crl_issuer(undefined, CRL, issuer_not_found, _, CertsList, Ignore) -> + crl_issuer(CRL, CertsList, Ignore); + +crl_issuer(IssuerName, CRL, issuer_not_found, CertsList, CertsList, Ignore) -> + crl_issuer(IssuerName, CRL, IssuerName, CertsList, CertsList, Ignore); + +crl_issuer(undefined, CRL, Id, [Cert | Rest], All, false) -> + ErlCert = public_key:pkix_decode_cert(Cert, otp), + TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate, + SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber, + Issuer = public_key:pkix_normalize_name( + TBSCertificate#'OTPTBSCertificate'.subject), + Bool = is_signer(ErlCert, CRL, false), + case {SerialNumber, Issuer} of + Id when Bool == true -> + {ok, ErlCert, Cert}; + _ -> + crl_issuer(undefined, CRL, Id, Rest, All, false) + end; + +crl_issuer(IssuerName, CRL, Id, [Cert | Rest], All, false) -> + ErlCert = public_key:pkix_decode_cert(Cert, otp), + TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate, + SerialNumber = TBSCertificate#'OTPTBSCertificate'.serialNumber, + %%Issuer = public_key:pkix_normalize_name( + %% TBSCertificate#'OTPTBSCertificate'.subject), + Bool = is_signer(ErlCert, CRL, false), + case {SerialNumber, IssuerName} of + Id when Bool == true -> + {ok, ErlCert, Cert}; + {_, IssuerName} when Bool == true -> + {ok, ErlCert, Cert}; + _ -> + crl_issuer(IssuerName, CRL, Id, Rest, All, false) + end; + +crl_issuer(undefined, CRL, _, [], CertsList, Ignore) -> + crl_issuer(CRL, CertsList, Ignore); +crl_issuer(CRLName, CRL, _, [], CertsList, Ignore) -> + crl_issuer(CRLName, CRL, CertsList, Ignore). + + +crl_issuer(_, [],_) -> + {error, issuer_not_found}; +crl_issuer(CRL, [Cert | Rest], Ignore) -> + ErlCert = public_key:pkix_decode_cert(Cert, otp), + case public_key:pkix_is_issuer(CRL, ErlCert) andalso + check_extension_crl_signer(ErlCert) andalso + is_signer(ErlCert, CRL, Ignore) + of + true -> + {ok, ErlCert,Cert}; + false -> + crl_issuer(CRL, Rest, Ignore) + end. + +crl_issuer(_,_, [],_) -> + {error, issuer_not_found}; +crl_issuer(IssuerName, CRL, [Cert | Rest], Ignore) -> + ErlCert = public_key:pkix_decode_cert(Cert, otp), + TBSCertificate = ErlCert#'OTPCertificate'.tbsCertificate, + Issuer = public_key:pkix_normalize_name( + TBSCertificate#'OTPTBSCertificate'.subject), + + case + public_key:pkix_is_issuer(CRL, ErlCert) andalso + check_extension_crl_signer(ErlCert) andalso + is_signer(ErlCert, CRL, Ignore) + of + true -> + case pubkey_cert:is_issuer(Issuer, IssuerName) of + true -> + {ok, ErlCert,Cert}; + false -> + crl_issuer(IssuerName, CRL, Rest, Ignore) + end; + false -> + crl_issuer(IssuerName, CRL, Rest, Ignore) + end. read_certs(Test) -> File = test_file(Test), - %% io:format("Read ~p ",[File]), Ders = erl_make_certs:pem_to_der(File), - %% io:format("Ders ~p ~n",[length(Ders)]), [Cert || {'Certificate', Cert, not_encrypted} <- Ders]. +read_crls(Test) -> + File = test_file(Test), + Ders = erl_make_certs:pem_to_der(File), + [CRL || {'CertificateList', CRL, not_encrypted} <- Ders]. + test_file(Test) -> file(?CONV, lists:append(string:tokens(Test, " -")) ++ ".pem"). @@ -206,118 +1150,89 @@ file(Sub,File) -> end, AbsFile. -sort_chain([First|Certs], TA, Try, Found) -> +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.5.3"-> + [CA, Entity, Self] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Self, Entity]; +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.5.4"; + Chap == "4.5.5" -> + [CA, Entity, _Self] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Entity]; + +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.24"; + Chap == "4.14.25"; + Chap == "4.14.26"; + Chap == "4.14.27"; + Chap == "4.14.31"; + Chap == "4.14.32"; + Chap == "4.14.33" -> + [_OtherCA, Entity, CA] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Entity]; + +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.28"; + Chap == "4.14.29" -> + [CA, _OtherCA, Entity] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Entity]; + + +sort_chain(Certs, TA, Acc, Bool, Chap) when Chap == "4.14.33" -> + [Entity, CA, _OtherCA] = do_sort_chain(Certs, TA, Acc, Bool, Chap), + [CA, Entity]; + + +sort_chain(Certs, TA, Acc, Bool, Chap) -> + do_sort_chain(Certs, TA, Acc, Bool, Chap). + +do_sort_chain([First], TA, Try, Found, Chap) when Chap == "4.5.6"; + Chap == "4.5.7"; + Chap == "4.4.19"; + Chap == "4.4.20"; + Chap == "4.4.21"-> case public_key:pkix_is_issuer(First,TA) of true -> - [First|sort_chain(Certs,First,Try,true)]; + [First|do_sort_chain([],First,Try,true, Chap)]; false -> - sort_chain(Certs,TA,[First|Try],Found) + do_sort_chain([],TA,[First|Try],Found, Chap) end; -sort_chain([], _, [],_) -> []; -sort_chain([], Valid, Check, true) -> - sort_chain(lists:reverse(Check), Valid, [], false); -sort_chain([], _Valid, Check, false) -> +do_sort_chain([First|Certs], TA, Try, Found, Chap) when Chap == "4.5.6"; + Chap == "4.5.7"; + Chap == "4.4.19"; + Chap == "4.4.20"; + Chap == "4.4.21"-> +%% case check_extension_cert_signer(public_key:pkix_decode_cert(First, otp)) of +%% true -> + case public_key:pkix_is_issuer(First,TA) of + true -> + [First|do_sort_chain(Certs,First,Try,true, Chap)]; + false -> + do_sort_chain(Certs,TA,[First|Try],Found, Chap) + end; +%% false -> +%% do_sort_chain(Certs, TA, Try, Found, Chap) +%% end; + +do_sort_chain([First|Certs], TA, Try, Found, Chap) -> + case public_key:pkix_is_issuer(First,TA) of + true -> + [First|do_sort_chain(Certs,First,Try,true, Chap)]; + false -> + do_sort_chain(Certs,TA,[First|Try],Found, Chap) + end; + +do_sort_chain([], _, [],_, _) -> []; +do_sort_chain([], Valid, Check, true, Chap) -> + do_sort_chain(lists:reverse(Check), Valid, [], false, Chap); +do_sort_chain([], _Valid, Check, false, _) -> Check. -signature_verification() -> - %% "4.1", "Signature Verification" , - [{ "4.1.1", "Valid Signatures Test1", ok}, - { "4.1.2", "Invalid CA Signature Test2", {bad_cert,invalid_signature}}, - { "4.1.3", "Invalid EE Signature Test3", {bad_cert,invalid_signature}}, - { "4.1.4", "Valid DSA Signatures Test4", ok}, - { "4.1.5", "Valid DSA Parameter Inheritance Test5", ok}, - { "4.1.6", "Invalid DSA Signature Test6", {bad_cert,invalid_signature}}]. -validity_periods() -> - %% { "4.2", "Validity Periods" }, - [{ "4.2.1", "Invalid CA notBefore Date Test1", {bad_cert, cert_expired}}, - { "4.2.2", "Invalid EE notBefore Date Test2", {bad_cert, cert_expired}}, - { "4.2.3", "Valid pre2000 UTC notBefore Date Test3", ok}, - { "4.2.4", "Valid GeneralizedTime notBefore Date Test4", ok}, - { "4.2.5", "Invalid CA notAfter Date Test5", {bad_cert, cert_expired}}, - { "4.2.6", "Invalid EE notAfter Date Test6", {bad_cert, cert_expired}}, - { "4.2.7", "Invalid pre2000 UTC EE notAfter Date Test7", {bad_cert, cert_expired}}, - { "4.2.8", "Valid GeneralizedTime notAfter Date Test8", ok}]. -verifying_name_chaining() -> - %%{ "4.3", "Verifying Name Chaining" }, - [{ "4.3.1", "Invalid Name Chaining EE Test1", {bad_cert, invalid_issuer}}, - { "4.3.2", "Invalid Name Chaining Order Test2", {bad_cert, invalid_issuer}}, - { "4.3.3", "Valid Name Chaining Whitespace Test3", ok}, - { "4.3.4", "Valid Name Chaining Whitespace Test4", ok}, - { "4.3.5", "Valid Name Chaining Capitalization Test5", ok}, - { "4.3.6", "Valid Name Chaining UIDs Test6", ok}, - { "4.3.7", "Valid RFC3280 Mandatory Attribute Types Test7", ok}, - { "4.3.8", "Valid RFC3280 Optional Attribute Types Test8", ok}, - { "4.3.9", "Valid UTF8String Encoded Names Test9", ok}, - { "4.3.10", "Valid Rollover from PrintableString to UTF8String Test10", ok}, - { "4.3.11", "Valid UTF8String Case Insensitive Match Test11", ok}]. -basic_certificate_revocation_tests() -> - %%{ "4.4", "Basic Certificate Revocation Tests" }, - [{ "4.4.1", "Missing CRL Test1", 3 }, - { "4.4.2", "Invalid Revoked CA Test2", 23 }, - { "4.4.3", "Invalid Revoked EE Test3", 23 }, - { "4.4.4", "Invalid Bad CRL Signature Test4", 8 }, - { "4.4.5", "Invalid Bad CRL Issuer Name Test5", 3 }, - { "4.4.6", "Invalid Wrong CRL Test6", 3 }, - { "4.4.7", "Valid Two CRLs Test7", ok}, - - %% The test document suggests these should return certificate revoked... - %% Subsquent discussion has concluded they should not due to unhandle - %% critical CRL extensions. - { "4.4.8", "Invalid Unknown CRL Entry Extension Test8", 36 }, - { "4.4.9", "Invalid Unknown CRL Extension Test9", 36 }, - - { "4.4.10", "Invalid Unknown CRL Extension Test10", 36 }, - { "4.4.11", "Invalid Old CRL nextUpdate Test11", 12 }, - { "4.4.12", "Invalid pre2000 CRL nextUpdate Test12", 12 }, - { "4.4.13", "Valid GeneralizedTime CRL nextUpdate Test13", ok}, - { "4.4.14", "Valid Negative Serial Number Test14", ok}, - { "4.4.15", "Invalid Negative Serial Number Test15", 23 }, - { "4.4.16", "Valid Long Serial Number Test16", ok}, - { "4.4.17", "Valid Long Serial Number Test17", ok}, - { "4.4.18", "Invalid Long Serial Number Test18", 23 }, - { "4.4.19", "Valid Separate Certificate and CRL Keys Test19", ok}, - { "4.4.20", "Invalid Separate Certificate and CRL Keys Test20", 23 }, - - %% CRL path is revoked so get a CRL path validation error - { "4.4.21", "Invalid Separate Certificate and CRL Keys Test21", 54 }]. -verifying_paths_with_self_issued_certificates() -> - %%{ "4.5", "Verifying Paths with Self-Issued Certificates" }, - [{ "4.5.1", "Valid Basic Self-Issued Old With New Test1", ok}, - %%{ "4.5.2", "Invalid Basic Self-Issued Old With New Test2", 23 }, - %%{ "4.5.3", "Valid Basic Self-Issued New With Old Test3", ok}, - %%{ "4.5.4", "Valid Basic Self-Issued New With Old Test4", ok}, - { "4.5.5", "Invalid Basic Self-Issued New With Old Test5", 23 }, - %%{ "4.5.6", "Valid Basic Self-Issued CRL Signing Key Test6", ok}, - { "4.5.7", "Invalid Basic Self-Issued CRL Signing Key Test7", 23 }, - { "4.5.8", "Invalid Basic Self-Issued CRL Signing Key Test8", {bad_cert,invalid_key_usage} }]. -verifying_basic_constraints() -> - [%%{ "4.6", "Verifying Basic Constraints" }, - { "4.6.1", "Invalid Missing basicConstraints Test1", - {bad_cert, missing_basic_constraint} }, - { "4.6.2", "Invalid cA False Test2", {bad_cert, missing_basic_constraint}}, - { "4.6.3", "Invalid cA False Test3", {bad_cert, missing_basic_constraint}}, - { "4.6.4", "Valid basicConstraints Not Critical Test4", ok}, - { "4.6.5", "Invalid pathLenConstraint Test5", {bad_cert, max_path_length_reached}}, - { "4.6.6", "Invalid pathLenConstraint Test6", {bad_cert, max_path_length_reached}}, - { "4.6.7", "Valid pathLenConstraint Test7", ok}, - { "4.6.8", "Valid pathLenConstraint Test8", ok}, - { "4.6.9", "Invalid pathLenConstraint Test9", {bad_cert, max_path_length_reached}}, - { "4.6.10", "Invalid pathLenConstraint Test10", {bad_cert, max_path_length_reached}}, - { "4.6.11", "Invalid pathLenConstraint Test11", {bad_cert, max_path_length_reached}}, - { "4.6.12", "Invalid pathLenConstraint Test12", {bad_cert, max_path_length_reached}}, - { "4.6.13", "Valid pathLenConstraint Test13", ok}, - { "4.6.14", "Valid pathLenConstraint Test14", ok}, - { "4.6.15", "Valid Self-Issued pathLenConstraint Test15", ok}, - { "4.6.16", "Invalid Self-Issued pathLenConstraint Test16", {bad_cert, max_path_length_reached}}, - { "4.6.17", "Valid Self-Issued pathLenConstraint Test17", ok}]. -key_usage() -> - %%{ "4.7", "Key Usage" }, - [{ "4.7.1", "Invalid keyUsage Critical keyCertSign False Test1", {bad_cert,invalid_key_usage} }, - { "4.7.2", "Invalid keyUsage Not Critical keyCertSign False Test2", {bad_cert,invalid_key_usage} }, - { "4.7.3", "Valid keyUsage Not Critical Test3", ok} - %%,{ "4.7.4", "Invalid keyUsage Critical cRLSign False Test4", 35 } - %%,{ "4.7.5", "Invalid keyUsage Not Critical cRLSign False Test5", 35 } - ]. +error(Format, Args, File0, Line) -> + File = filename:basename(File0), + Pid = group_leader(), + Pid ! {failed, File, Line}, + io:format(Pid, "~s(~p): ERROR"++Format, [File,Line|Args]). + +warning(Format, Args, File0, Line) -> + File = filename:basename(File0), + io:format("~s(~p): Warning "++Format, [File,Line|Args]). %% Certificate policy tests need special handling. They can have several %% sub tests and we need to check the outputs are correct. @@ -425,182 +1340,3 @@ inhibit_any_policy() -> {"4.12.8", "Invalid Self-Issued inhibitAnyPolicy Test8", 43 }, {"4.12.9", "Valid Self-Issued inhibitAnyPolicy Test9", ok}, {"4.12.10", "Invalid Self-Issued inhibitAnyPolicy Test10", 43 }]. - -name_constraints() -> - %%{ "4.13", "Name Constraints" }, - [{ "4.13.1", "Valid DN nameConstraints Test1", ok}, - { "4.13.2", "Invalid DN nameConstraints Test2", {bad_cert, name_not_permitted}}, - { "4.13.3", "Invalid DN nameConstraints Test3", {bad_cert, name_not_permitted}}, - { "4.13.4", "Valid DN nameConstraints Test4", ok}, - { "4.13.5", "Valid DN nameConstraints Test5", ok}, - { "4.13.6", "Valid DN nameConstraints Test6", ok}, - { "4.13.7", "Invalid DN nameConstraints Test7", {bad_cert, name_not_permitted}}, - { "4.13.8", "Invalid DN nameConstraints Test8", {bad_cert, name_not_permitted}}, - { "4.13.9", "Invalid DN nameConstraints Test9", {bad_cert, name_not_permitted}}, - { "4.13.10", "Invalid DN nameConstraints Test10", {bad_cert, name_not_permitted}}, - { "4.13.11", "Valid DN nameConstraints Test11", ok}, - { "4.13.12", "Invalid DN nameConstraints Test12", {bad_cert, name_not_permitted}}, - { "4.13.13", "Invalid DN nameConstraints Test13", {bad_cert, name_not_permitted}}, - { "4.13.14", "Valid DN nameConstraints Test14", ok}, - { "4.13.15", "Invalid DN nameConstraints Test15", {bad_cert, name_not_permitted}}, - { "4.13.16", "Invalid DN nameConstraints Test16", {bad_cert, name_not_permitted}}, - { "4.13.17", "Invalid DN nameConstraints Test17", {bad_cert, name_not_permitted}}, - { "4.13.18", "Valid DN nameConstraints Test18", ok}, - { "4.13.19", "Valid Self-Issued DN nameConstraints Test19", ok}, - { "4.13.20", "Invalid Self-Issued DN nameConstraints Test20", {bad_cert, name_not_permitted} }, - { "4.13.21", "Valid RFC822 nameConstraints Test21", ok}, - { "4.13.22", "Invalid RFC822 nameConstraints Test22", {bad_cert, name_not_permitted} }, - { "4.13.23", "Valid RFC822 nameConstraints Test23", ok}, - { "4.13.24", "Invalid RFC822 nameConstraints Test24", {bad_cert, name_not_permitted} }, - { "4.13.25", "Valid RFC822 nameConstraints Test25", ok}, - { "4.13.26", "Invalid RFC822 nameConstraints Test26", {bad_cert, name_not_permitted}}, - { "4.13.27", "Valid DN and RFC822 nameConstraints Test27", ok}, - { "4.13.28", "Invalid DN and RFC822 nameConstraints Test28", {bad_cert, name_not_permitted} }, - { "4.13.29", "Invalid DN and RFC822 nameConstraints Test29", {bad_cert, name_not_permitted} }, - { "4.13.30", "Valid DNS nameConstraints Test30", ok}, - { "4.13.31", "Invalid DNS nameConstraints Test31", {bad_cert, name_not_permitted} }, - { "4.13.32", "Valid DNS nameConstraints Test32", ok}, - { "4.13.33", "Invalid DNS nameConstraints Test33", {bad_cert, name_not_permitted}}, - { "4.13.34", "Valid URI nameConstraints Test34", ok}, - { "4.13.35", "Invalid URI nameConstraints Test35", {bad_cert, name_not_permitted} }, - { "4.13.36", "Valid URI nameConstraints Test36", ok}, - { "4.13.37", "Invalid URI nameConstraints Test37", {bad_cert, name_not_permitted}}, - { "4.13.38", "Invalid DNS nameConstraints Test38", {bad_cert, name_not_permitted} }]. -distribution_points() -> - %%{ "4.14", "Distribution Points" }, - [{ "4.14.1", "Valid distributionPoint Test1", ok}, - { "4.14.2", "Invalid distributionPoint Test2", 23 }, - { "4.14.3", "Invalid distributionPoint Test3", 44 }, - { "4.14.4", "Valid distributionPoint Test4", ok}, - { "4.14.5", "Valid distributionPoint Test5", ok}, - { "4.14.6", "Invalid distributionPoint Test6", 23 }, - { "4.14.7", "Valid distributionPoint Test7", ok}, - { "4.14.8", "Invalid distributionPoint Test8", 44 }, - { "4.14.9", "Invalid distributionPoint Test9", 44 }, - { "4.14.10", "Valid No issuingDistributionPoint Test10", ok}, - { "4.14.11", "Invalid onlyContainsUserCerts CRL Test11", 44 }, - { "4.14.12", "Invalid onlyContainsCACerts CRL Test12", 44 }, - { "4.14.13", "Valid onlyContainsCACerts CRL Test13", ok}, - { "4.14.14", "Invalid onlyContainsAttributeCerts Test14", 44 }, - { "4.14.15", "Invalid onlySomeReasons Test15", 23 }, - { "4.14.16", "Invalid onlySomeReasons Test16", 23 }, - { "4.14.17", "Invalid onlySomeReasons Test17", 3 }, - { "4.14.18", "Valid onlySomeReasons Test18", ok}, - { "4.14.19", "Valid onlySomeReasons Test19", ok}, - { "4.14.20", "Invalid onlySomeReasons Test20", 23 }, - { "4.14.21", "Invalid onlySomeReasons Test21", 23 }, - { "4.14.22", "Valid IDP with indirectCRL Test22", ok}, - { "4.14.23", "Invalid IDP with indirectCRL Test23", 23 }, - { "4.14.24", "Valid IDP with indirectCRL Test24", ok}, - { "4.14.25", "Valid IDP with indirectCRL Test25", ok}, - { "4.14.26", "Invalid IDP with indirectCRL Test26", 44 }, - { "4.14.27", "Invalid cRLIssuer Test27", 3 }, - { "4.14.28", "Valid cRLIssuer Test28", ok}, - { "4.14.29", "Valid cRLIssuer Test29", ok}, - - %% Although this test is valid it has a circular dependency. As a result - %% an attempt is made to reursively checks a CRL path and rejected due to - %% a CRL path validation error. PKITS notes suggest this test does not - %% need to be run due to this issue. - { "4.14.30", "Valid cRLIssuer Test30", 54 }, - { "4.14.31", "Invalid cRLIssuer Test31", 23 }, - { "4.14.32", "Invalid cRLIssuer Test32", 23 }, - { "4.14.33", "Valid cRLIssuer Test33", ok}, - { "4.14.34", "Invalid cRLIssuer Test34", 23 }, - { "4.14.35", "Invalid cRLIssuer Test35", 44 }]. -delta_crls() -> - %%{ "4.15", "Delta-CRLs" }, - [{ "4.15.1", "Invalid deltaCRLIndicator No Base Test1", 3 }, - { "4.15.2", "Valid delta-CRL Test2", ok}, - { "4.15.3", "Invalid delta-CRL Test3", 23 }, - { "4.15.4", "Invalid delta-CRL Test4", 23 }, - { "4.15.5", "Valid delta-CRL Test5", ok}, - { "4.15.6", "Invalid delta-CRL Test6", 23 }, - { "4.15.7", "Valid delta-CRL Test7", ok}, - { "4.15.8", "Valid delta-CRL Test8", ok}, - { "4.15.9", "Invalid delta-CRL Test9", 23 }, - { "4.15.10", "Invalid delta-CRL Test10", 12 }]. -private_certificate_extensions() -> - %%{ "4.16", "Private Certificate Extensions" }, - [{ "4.16.1", "Valid Unknown Not Critical Certificate Extension Test1", ok}, - { "4.16.2", "Invalid Unknown Critical Certificate Extension Test2", - {bad_cert,unknown_critical_extension}}]. - - -convert() -> - Tests = [signature_verification(), - validity_periods(), - verifying_name_chaining(), - basic_certificate_revocation_tests(), - verifying_paths_with_self_issued_certificates(), - verifying_basic_constraints(), - key_usage(), - certificate_policies(), - require_explicit_policy(), - policy_mappings(), - inhibit_policy_mapping(), - inhibit_any_policy(), - name_constraints(), - distribution_points(), - delta_crls(), - private_certificate_extensions()], - [convert(Test) || Test <- lists:flatten(Tests)]. - -convert({_,Test,_}) -> - convert1(Test); -convert({_,Test,_,_,_,_,_}) -> - convert1(Test). - -convert1(Test) -> - FName = lists:append(string:tokens(Test, " -")), - File = filename:join(?MIME, "Signed" ++ FName ++ ".eml"), - io:format("Convert ~p~n",[File]), - {ok, Mail} = file:read_file(File), - Base64 = skip_lines(Mail), - %%io:format("~s",[Base64]), - Tmp = base64:mime_decode(Base64), - file:write_file("pkits/smime-pem/tmp-pkcs7.der", Tmp), - Cmd = "openssl pkcs7 -inform der -in pkits/smime-pem/tmp-pkcs7.der" - " -print_certs -out pkits/smime-pem/" ++ FName ++ ".pem", - case os:cmd(Cmd) of - "" -> ok; - Err -> - io:format("~s",[Err]), - erlang:error(bad_cmd) - end. - -skip_lines(<<"\r\n\r\n", Rest/binary>>) -> Rest; -skip_lines(<<"\n\n", Rest/binary>>) -> Rest; -skip_lines(<<_:8, Rest/binary>>) -> - skip_lines(Rest). - -init_per_testcase(_Func, Config) -> - Datadir = proplists:get_value(data_dir, Config), - put(datadir, Datadir), - Config. - -end_per_testcase(_Func, Config) -> - %% Nodes = select_nodes(all, Config, ?FILE, ?LINE), - %% rpc:multicall(Nodes, mnesia, lkill, []), - Config. - -init_per_suite(Config) -> - try crypto:start() of - ok -> - Config - catch _:_ -> - {skip, "Crypto did not start"} - end. - -end_per_suite(_Config) -> - application:stop(crypto). - -error(Format, Args, File0, Line) -> - File = filename:basename(File0), - Pid = group_leader(), - Pid ! {failed, File, Line}, - io:format(Pid, "~s(~p): ERROR"++Format, [File,Line|Args]). - -warning(Format, Args, File0, Line) -> - File = filename:basename(File0), - io:format("~s(~p): Warning "++Format, [File,Line|Args]). diff --git a/lib/public_key/vsn.mk b/lib/public_key/vsn.mk index c99fd6fee1..3c6b012152 100644 --- a/lib/public_key/vsn.mk +++ b/lib/public_key/vsn.mk @@ -1 +1 @@ -PUBLIC_KEY_VSN = 0.11 +PUBLIC_KEY_VSN = 0.12 diff --git a/lib/reltool/test/Makefile b/lib/reltool/test/Makefile index abd2e81cdf..62fe05238b 100644 --- a/lib/reltool/test/Makefile +++ b/lib/reltool/test/Makefile @@ -76,7 +76,7 @@ release_tests_spec: opt $(INSTALL_DATA) reltool.spec reltool.cover $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR) $(INSTALL_SCRIPT) rtt $(INSTALL_PROGS) $(RELSYSDIR) $(INSTALL_DATA) $(INSTALL_PROGS) $(RELSYSDIR) -# chmod -f -R u+w $(RELSYSDIR) +# chmod -R u+w $(RELSYSDIR) # @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/runtime_tools/test/Makefile b/lib/runtime_tools/test/Makefile index 7dc7a015e1..cfaf420d65 100644 --- a/lib/runtime_tools/test/Makefile +++ b/lib/runtime_tools/test/Makefile @@ -59,7 +59,7 @@ release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) runtime_tools.spec runtime_tools.cover $(ERL_FILES) $(RELSYSDIR) $(INSTALL_DATA) $(EMAKEFILE) runtime_tools.cover $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/sasl/doc/src/systools.xml b/lib/sasl/doc/src/systools.xml index e28cd25f27..883c9c372b 100644 --- a/lib/sasl/doc/src/systools.xml +++ b/lib/sasl/doc/src/systools.xml @@ -130,7 +130,7 @@ <fsummary>Generate a boot script <c>.script/.boot</c>.</fsummary> <type> <v>Name = string()</v> - <v>Opt = no_module_tests | {path,[Dir]} | local | {variables,[Var]} | exref | {exref,[App]}] | silent | {outdir,Dir}</v> + <v>Opt = src_tests | {path,[Dir]} | local | {variables,[Var]} | exref | {exref,[App]}] | silent | {outdir,Dir}</v> <v> Dir = string()</v> <v> Var = {VarName,Prefix}</v> <v> VarName = Prefix = string()</v> @@ -174,15 +174,13 @@ the applications.</p> </item> <item> - <p>There should no duplicated modules, that is, modules with + <p>There should be no duplicated modules, that is, modules with the same name but belonging to different applications.</p> </item> <item> - <p>A warning is issued if the source code for a module is - missing or newer than the object code. <br></br> - - If the <c>no_module_tests</c> option is specified, this - check is omitted.</p> + <p>If the <c>src_tests</c> option is specified, a + warning is issued if the source code for a module is + missing or newer than the object code.</p> </item> </list> <p>The applications are sorted according to the dependencies @@ -242,7 +240,7 @@ <fsummary>Create a release package.</fsummary> <type> <v>Name = string()</v> - <v>Opt = {dirs,[IncDir]} | {path,[Dir]} | {variables,[Var]} | {var_tar,VarTar} | {erts,Dir} | no_module_tests | exref | {exref,[App]} | silent | {outdir,Dir}</v> + <v>Opt = {dirs,[IncDir]} | {path,[Dir]} | {variables,[Var]} | {var_tar,VarTar} | {erts,Dir} | src_tests | exref | {exref,[App]} | silent | {outdir,Dir}</v> <v> Dir = string()</v> <v> IncDir = src | include | atom()</v> <v> Var = {VarName,PreFix}</v> @@ -330,7 +328,7 @@ myapp-1/ebin/myapp.app system <c>{erts,Dir}</c> is copied to <c>erts-ErtsVsn/bin</c>.</p> <p>All checks performed with the <c>make_script</c> function are performed before the release package is created. The - <c>no_module_tests</c> and <c>exref</c> options are also + <c>src_tests</c> and <c>exref</c> options are also valid here.</p> <p>The return value and the handling of errors and warnings are the same as described for <c>make_script</c> above.</p> diff --git a/lib/sasl/src/rb.erl b/lib/sasl/src/rb.erl index 38e486b7a7..13753565d8 100644 --- a/lib/sasl/src/rb.erl +++ b/lib/sasl/src/rb.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -169,7 +169,7 @@ print_filters() -> print_dates() -> io:format(" - {StartDate, EndDate}~n"), - io:format(" StartDate = EndDate = {{Y-M-D},{H,M,S}} ~n"), + io:format(" StartDate = EndDate = {{Y,M,D},{H,M,S}} ~n"), io:format(" prints the reports with date between StartDate and EndDate~n"), io:format(" - {StartDate, from}~n"), io:format(" prints the reports with date greater than StartDate~n"), diff --git a/lib/sasl/src/systools_make.erl b/lib/sasl/src/systools_make.erl index 20a142c763..7489ee58d2 100644 --- a/lib/sasl/src/systools_make.erl +++ b/lib/sasl/src/systools_make.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1996-2009. All Rights Reserved. +%% Copyright Ericsson AB 1996-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -50,7 +50,7 @@ %% the applications are found. %% %% New options: {path,Path} can contain wildcards -%% no_module_tests +%% src_tests %% {variables,[{Name,AbsString}]} %% {machine, jam | beam | vee} %% exref | {exref, [AppName]} @@ -82,8 +82,7 @@ make_script(RelName, Output, Flags) when is_list(RelName), Path0 = get_path(Flags), Path1 = mk_path(Path0), % expand wildcards etc. Path = make_set(Path1 ++ code:get_path()), - ModTestP = {not member(no_module_tests, Flags), - xref_p(Flags)}, + ModTestP = {member(src_tests, Flags),xref_p(Flags)}, case get_release(RelName, Path, ModTestP, machine(Flags)) of {ok, Release, Appls, Warnings} -> case generate_script(Output,Release,Appls,Flags) of @@ -155,7 +154,7 @@ return({error,Mod,Error},_,Flags) -> %% should be included in the release package and there it can be found. %% %% New options: {path,Path} can contain wildcards -%% no_module_tests +%% src_tests %% exref | {exref, [AppName]} %% {variables,[{Name,AbsString}]} %% {machine, jam | beam | vee} @@ -190,8 +189,7 @@ make_tar(RelName, Flags) when is_list(RelName), is_list(Flags) -> Path0 = get_path(Flags), Path1 = mk_path(Path0), Path = make_set(Path1 ++ code:get_path()), - ModTestP = {not member(no_module_tests, Flags), - xref_p(Flags)}, + ModTestP = {member(src_tests, Flags),xref_p(Flags)}, case get_release(RelName, Path, ModTestP, machine(Flags)) of {ok, Release, Appls, Warnings} -> case catch mk_tar(RelName, Release, Appls, Flags, Path1) of @@ -218,7 +216,7 @@ make_tar(RelName, Flags) -> %% {ok, #release, [{{Name,Vsn},#application}], Warnings} | {error, What} get_release(File, Path) -> - get_release(File, Path, true, false). + get_release(File, Path, {false,false}, false). get_release(File, Path, ModTestP) -> get_release(File, Path, ModTestP, false). @@ -771,36 +769,40 @@ get_mod_vsn([]) -> %% Use the module extension of the running machine as extension for %% the checked modules. -check_mods(Modules, Appls, Path, {true, XrefP}, Machine) -> - Ext = objfile_extension(Machine), - IncPath = create_include_path(Appls, Path), - Res = append(map(fun(ModT) -> - {Mod,_Vsn,App,_,Dir} = ModT, - case check_mod(Mod,App,Dir,Ext,IncPath) of - ok -> - []; - {error, Error} -> - [{error,{Error, ModT}}]; - {warning, Warn} -> - [{warning,{Warn,ModT}}] - end - end, - Modules)), - Res2 = Res ++ check_xref(Appls, Path, XrefP), +check_mods(Modules, Appls, Path, {SrcTestP, XrefP}, Machine) -> + SrcTestRes = check_src(Modules, Appls, Path, SrcTestP, Machine), + XrefRes = check_xref(Appls, Path, XrefP), + Res = SrcTestRes ++ XrefRes, case filter(fun({error, _}) -> true; (_) -> false end, - Res2) of + Res) of [] -> {ok, filter(fun({warning, _}) -> true; (_) -> false end, - Res2)}; + Res)}; Errors -> {error, Errors} - end; -check_mods(_, _, _, _, _) -> - {ok, []}. + end. + +check_src(Modules, Appls, Path, true, Machine) -> + Ext = objfile_extension(Machine), + IncPath = create_include_path(Appls, Path), + append(map(fun(ModT) -> + {Mod,_Vsn,App,_,Dir} = ModT, + case check_mod(Mod,App,Dir,Ext,IncPath) of + ok -> + []; + {error, Error} -> + [{error,{Error, ModT}}]; + {warning, Warn} -> + [{warning,{Warn,ModT}}] + end + end, + Modules)); +check_src(_, _, _, _, _) -> + []. check_xref(_Appls, _Path, false) -> []; @@ -1853,11 +1855,11 @@ cas([silent | Args], {Path, _Sil, Loc, Test, Var, Mach, cas([local | Args], {Path, Sil, _Loc, Test, Var, Mach, Xref, XrefApps, X}) -> cas(Args, {Path, Sil, local, Test, Var, Mach, Xref, XrefApps, X}); -%%% no_module_tests ---------------------------------------------------- -cas([no_module_tests | Args], {Path, Sil, Loc, _Test, Var, Mach, - Xref, XrefApps, X}) -> +%%% src_tests ------------------------------------------------------- +cas([src_tests | Args], {Path, Sil, Loc, _Test, Var, Mach, + Xref, XrefApps, X}) -> cas(Args, - {Path, Sil, Loc, no_module_tests, Var, Mach, Xref, XrefApps,X}); + {Path, Sil, Loc, src_tests, Var, Mach, Xref, XrefApps,X}); %%% variables ---------------------------------------------------------- cas([{variables, V} | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}) when is_list(V) -> @@ -1896,6 +1898,10 @@ cas([{outdir, Dir} | Args], {Path, Sil, Loc, Test, Var, Mach, cas([otp_build | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}) -> cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}); +%%% no_module_tests (kept for backwards compatibility, but ignored) ---- +cas([no_module_tests | Args], {Path, Sil, Loc, Test, Var, Mach, + Xref, XrefApps, X}) -> + cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps,X}); %%% ERROR -------------------------------------------------------------- cas([Y | Args], {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps, X}) -> cas(Args, {Path, Sil, Loc, Test, Var, Mach, Xref, XrefApps,X++[Y]}). @@ -1935,10 +1941,10 @@ cat([{dirs, D} | Args], {Path, Sil, Dirs, Erts, Test, cat([{erts, E} | Args], {Path, Sil, Dirs, _Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(E)-> cat(Args, {Path, Sil, Dirs, E, Test, Var, VarTar, Mach, Xref, XrefApps, X}); -%%% no_module_tests ---------------------------------------------------- -cat([no_module_tests | Args], {Path, Sil, Dirs, Erts, _Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> - cat(Args, {Path, Sil, Dirs, Erts, no_module_tests, Var, VarTar, Mach, - Xref, XrefApps, X}); +%%% src_tests ---------------------------------------------------- +cat([src_tests | Args], {Path, Sil, Dirs, Erts, _Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> + cat(Args, {Path, Sil, Dirs, Erts, src_tests, Var, VarTar, Mach, + Xref, XrefApps, X}); %%% variables ---------------------------------------------------------- cat([{variables, V} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) when is_list(V) -> case check_vars(V) of @@ -1982,6 +1988,9 @@ cat([{outdir, Dir} | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xre %%% otp_build (secret, not documented) --------------------------------- cat([otp_build | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); +%%% no_module_tests (kept for backwards compatibility, but ignored) ---- +cat([no_module_tests | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> + cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}); %%% ERROR -------------------------------------------------------------- cat([Y | Args], {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X}) -> cat(Args, {Path, Sil, Dirs, Erts, Test, Var, VarTar, Mach, Xref, XrefApps, X++[Y]}). diff --git a/lib/sasl/src/systools_relup.erl b/lib/sasl/src/systools_relup.erl index 6b0f77703e..ec5486226c 100644 --- a/lib/sasl/src/systools_relup.erl +++ b/lib/sasl/src/systools_relup.erl @@ -179,8 +179,7 @@ check_opts([]) -> []. do_mk_relup(TopRelFile, BaseUpRelDcs, BaseDnRelDcs, Path, Opts) -> - ModTest = false, - case systools_make:get_release(to_list(TopRelFile), Path, ModTest) of + case systools_make:get_release(to_list(TopRelFile), Path) of %% %% TopRel = #release %% NameVsnApps = [{{Name, Vsn}, #application}] @@ -246,9 +245,8 @@ foreach_baserel_up(TopRel, TopApps, [BaseRelDc|BaseRelDcs], Path, Opts, {RUs4, Ws4} = check_for_emulator_restart(TopRel, BaseRel, RUs3, Ws3, Opts), - ModTest = false, BaseApps = - case systools_make:get_release(BaseRelFile, Path, ModTest) of + case systools_make:get_release(BaseRelFile, Path) of {ok, _, NameVsnApps, _Warns} -> lists:map(fun({_,App}) -> App end, NameVsnApps); Other1 -> @@ -283,9 +281,8 @@ foreach_baserel_dn(TopRel, TopApps, [BaseRelDc|BaseRelDcs], Path, Opts, %% {RUs1, Ws1} = collect_appup_scripts(dn, TopApps, BaseRel, Ws, []), - ModTest = false, {BaseApps, Ws2} = - case systools_make:get_release(BaseRelFile, Path, ModTest) of + case systools_make:get_release(BaseRelFile, Path) of %% %% NameVsnApps = [{{Name, Vsn}, #application}] {ok, _, NameVsnApps, Warns} -> diff --git a/lib/snmp/test/Makefile b/lib/snmp/test/Makefile index 86af2460f5..b7975024b4 100644 --- a/lib/snmp/test/Makefile +++ b/lib/snmp/test/Makefile @@ -227,7 +227,7 @@ release_spec: release_tests_spec: opt $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(RELTEST_FILES) $(COVER_SPEC_FILE) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) tar cf - snmp_test_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/ssh/doc/src/notes.xml b/lib/ssh/doc/src/notes.xml index af667b1a71..4f546a37ed 100644 --- a/lib/ssh/doc/src/notes.xml +++ b/lib/ssh/doc/src/notes.xml @@ -29,6 +29,33 @@ <file>notes.xml</file> </header> +<section><title>Ssh 2.0.6</title> + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A memory leak has been fixed. I.e. per terminated connection the size of + a pid and the length of a user name string was not cleared.</p> + <p> + Own Id: OTP-9232</p> + </item> + </list> + </section> +</section> + +<section><title>Ssh 2.0.5</title> + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Strengthened random number generation. (Thanks to Geoff Cant)</p> + <p> + Own Id: OTP-9225</p> + </item> + </list> + </section> +</section> + <section><title>Ssh 2.0.4</title> <section><title>Fixed Bugs and Malfunctions</title> <list> diff --git a/lib/ssh/src/ssh.appup.src b/lib/ssh/src/ssh.appup.src index 501da8ceb9..37f24e2463 100644 --- a/lib/ssh/src/ssh.appup.src +++ b/lib/ssh/src/ssh.appup.src @@ -19,34 +19,12 @@ {"%VSN%", [ - {"2.0.3", [{load_module, ssh_file, soft_purge, soft_purge, []}, - {load_module, ssh, soft_purge, soft_purge, []}, - {load_module, ssh_rsa, soft_purge, soft_purge, []}, - {load_module, ssh_acceptor, soft_purge, soft_purge, []}, - {load_module, ssh_transport, soft_purge, soft_purge, []}, - {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, - {"2.0.2", [{load_module, ssh_file, soft_purge, soft_purge, []}, - {load_module, ssh, soft_purge, soft_purge, []}, - {load_module, ssh_rsa, soft_purge, soft_purge, []}, - {load_module, ssh_acceptor, soft_purge, soft_purge, []}, - {load_module, ssh_transport, soft_purge, soft_purge, []}, - {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, - {"2.0.1", [{restart_application, ssh}]} + {"2.0.5", [{load_module, ssh_userreg, soft_purge, soft_purge, []}, + {load_module, ssh_connection_handler, soft_purge, soft_purge, [ssh_userreg]}]} ], [ - {"2.0.3", [{load_module, ssh_file, soft_purge, soft_purge, []}, - {load_module, ssh, soft_purge, soft_purge, []}, - {load_module, ssh_rsa, soft_purge, soft_purge, []}, - {load_module, ssh_acceptor, soft_purge, soft_purge, []}, - {load_module, ssh_transport, soft_purge, soft_purge, []}, - {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, - {"2.0.2", [{load_module, ssh_file, soft_purge, soft_purge, []}, - {load_module, ssh, soft_purge, soft_purge, []}, - {load_module, ssh_rsa, soft_purge, soft_purge, []}, - {load_module, ssh_acceptor, soft_purge, soft_purge, []}, - {load_module, ssh_transport, soft_purge, soft_purge, []}, - {load_module, ssh_connection_manager, soft_purge, soft_purge, []}]}, - {"2.0.1", [{restart_application, ssh}]} + {"2.0.5", [{load_module, ssh_userreg, soft_purge, soft_purge, []}, + {load_module, ssh_connection_handler, soft_purge, soft_purge, [ssh_userreg]}]} ] }. diff --git a/lib/ssh/src/ssh_bits.erl b/lib/ssh/src/ssh_bits.erl index 399581a0fd..3f0a06575c 100755 --- a/lib/ssh/src/ssh_bits.erl +++ b/lib/ssh/src/ssh_bits.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -34,7 +34,7 @@ %% integer utils -export([isize/1]). -export([irandom/1, irandom/3]). --export([random/1, random/3]). +-export([random/1]). -export([xor_bits/2, fill_bits/2]). -export([i2bin/2, bin2i/1]). @@ -401,9 +401,6 @@ xor_bits(XBits, YBits) -> irandom(Bits) -> irandom(Bits, 1, 0). -%% irandom_odd(Bits) -> -%% irandom(Bits, 1, 1). - %% %% irandom(N, Top, Bottom) %% @@ -414,57 +411,16 @@ irandom(Bits) -> %% Bot = 0 - do not set the least signifcant bit %% Bot = 1 - set the least signifcant bit (i.e always odd) %% -irandom(0, _Top, _Bottom) -> - 0; -irandom(Bits, Top, Bottom) -> - Bytes = (Bits+7) div 8, - Skip = (8-(Bits rem 8)) rem 8, - TMask = case Top of - 0 -> 0; - 1 -> 16#80; - 2 -> 16#c0 - end, - BMask = case Bottom of - 0 -> 0; - 1 -> (1 bsl Skip) - end, - <<X:Bits/big-unsigned-integer, _:Skip>> = random(Bytes, TMask, BMask), - X. +irandom(Bits, Top, Bottom) when is_integer(Top), + 0 =< Top, Top =< 2 -> + crypto:erlint(crypto:strong_rand_mpint(Bits, Top - 1, Bottom)). %% %% random/1 %% Generate N random bytes %% random(N) -> - random(N, 0, 0). - -random(N, TMask, BMask) -> - list_to_binary(rnd(N, TMask, BMask)). - -%% random/3 -%% random(Bytes, TopMask, BotMask) -%% where -%% Bytes is the number of bytes to generate -%% TopMask is bitwised or'ed to the first byte -%% BotMask is bitwised or'ed to the last byte -%% -rnd(0, _TMask, _BMask) -> - []; -rnd(1, TMask, BMask) -> - [(rand8() bor TMask) bor BMask]; -rnd(N, TMask, BMask) -> - [(rand8() bor TMask) | rnd_n(N-1, BMask)]. - -rnd_n(1, BMask) -> - [rand8() bor BMask]; -rnd_n(I, BMask) -> - [rand8() | rnd_n(I-1, BMask)]. - -rand8() -> - (rand32() bsr 8) band 16#ff. - -rand32() -> - random:uniform(16#100000000) -1. + crypto:strong_rand_bytes(N). %% %% Base 64 encode/decode diff --git a/lib/ssh/src/ssh_cli.erl b/lib/ssh/src/ssh_cli.erl index cb78acb84c..781e01b9d1 100644 --- a/lib/ssh/src/ssh_cli.erl +++ b/lib/ssh/src/ssh_cli.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 0ba11b0a26..3193be2510 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -106,8 +106,6 @@ peer_address(ConnectionHandler) -> %% initialize. %%-------------------------------------------------------------------- init([Role, Manager, Socket, SshOpts]) -> - {A,B,C} = erlang:now(), - random:seed(A, B, C), {NumVsn, StrVsn} = ssh_transport:versions(Role, SshOpts), ssh_bits:install_messages(ssh_transport:transport_messages(NumVsn)), {Protocol, Callback, CloseTag} = @@ -580,7 +578,9 @@ handle_info({CloseTag, _Socket}, _StateName, %% Reason. The return value is ignored. %%-------------------------------------------------------------------- terminate(normal, _, #state{transport_cb = Transport, - socket = Socket}) -> + socket = Socket, + manager = Pid}) -> + (catch ssh_userreg:delete_user(Pid)), (catch Transport:close(Socket)), ok; @@ -812,7 +812,7 @@ handle_disconnect(#ssh_msg_disconnect{} = Msg, #state{ssh_params = Ssh0, manager = Pid} = State) -> {SshPacket, Ssh} = ssh_transport:ssh_packet(Msg, Ssh0), try - send_msg(SshPacket, State), + send_msg(SshPacket, State), ssh_connection_manager:event(Pid, Msg) catch exit:{noproc, _Reason} -> @@ -824,6 +824,7 @@ handle_disconnect(#ssh_msg_disconnect{} = Msg, [Msg, Exit]), error_logger:info_report(Report) end, + (catch ssh_userreg:delete_user(Pid)), {stop, normal, State#state{ssh_params = Ssh}}. counterpart_versions(NumVsn, StrVsn, #ssh{role = server} = Ssh) -> diff --git a/lib/ssh/src/ssh_userreg.erl b/lib/ssh/src/ssh_userreg.erl index 33c801f490..f901461aea 100644 --- a/lib/ssh/src/ssh_userreg.erl +++ b/lib/ssh/src/ssh_userreg.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2011. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -25,11 +25,18 @@ -behaviour(gen_server). %% API --export([start_link/0, register_user/2, lookup_user/1]). +-export([start_link/0, + register_user/2, + lookup_user/1, + delete_user/1]). %% gen_server callbacks --export([init/1, handle_call/3, handle_cast/2, handle_info/2, - terminate/2, code_change/3]). +-export([init/1, + handle_call/3, + handle_cast/2, + handle_info/2, + terminate/2, + code_change/3]). -record(state, {user_db = []}). @@ -46,6 +53,9 @@ start_link() -> register_user(User, Cm) -> gen_server:cast(?MODULE, {register, {User, Cm}}). +delete_user(Cm) -> + gen_server:cast(?MODULE, {delete, Cm}). + lookup_user(Cm) -> gen_server:call(?MODULE, {get_user, Cm}, infinity). @@ -82,9 +92,10 @@ handle_call({get_user, Cm}, _From, #state{user_db = Db} = State) -> %% {stop, Reason, State} %% Description: Handling cast messages %%-------------------------------------------------------------------- -handle_cast({register, UserCm}, State0) -> - State = insert(UserCm, State0), - {noreply, State}. +handle_cast({register, UserCm}, State) -> + {noreply, insert(UserCm, State)}; +handle_cast({delete, UserCm}, State) -> + {noreply, delete(UserCm, State)}. %%-------------------------------------------------------------------- %% Function: handle_info(Info, State) -> {noreply, State} | @@ -118,6 +129,9 @@ code_change(_OldVsn, State, _Extra) -> insert({User, Cm}, #state{user_db = Db} = State) -> State#state{user_db = [{User, Cm} | Db]}. +delete(Cm, #state{user_db = Db} = State) -> + State#state{user_db = lists:keydelete(Cm, 2, Db)}. + lookup(_, []) -> undefined; lookup(Cm, [{User, Cm} | _Rest]) -> diff --git a/lib/ssh/vsn.mk b/lib/ssh/vsn.mk index 51f9f47446..d0861b3ddc 100644 --- a/lib/ssh/vsn.mk +++ b/lib/ssh/vsn.mk @@ -1,5 +1,5 @@ #-*-makefile-*- ; force emacs to enter makefile-mode -SSH_VSN = 2.0.4 +SSH_VSN = 2.0.6 APP_VSN = "ssh-$(SSH_VSN)" diff --git a/lib/ssl/doc/src/ssl.xml b/lib/ssl/doc/src/ssl.xml index cd5c9281cd..0da6bbee5b 100644 --- a/lib/ssl/doc/src/ssl.xml +++ b/lib/ssl/doc/src/ssl.xml @@ -53,13 +53,11 @@ <p>The following data types are used in the functions below: </p> - <p><c>boolean() = true | false</c></p> - - <p><c>property() = atom()</c></p> - + <p><c>boolean() = true | false</c></p> + <p><c>option() = socketoption() | ssloption() | transportoption()</c></p> - <p><c>socketoption() = [{property(), term()}] - defaults to + <p><c>socketoption() = proplists:property() - The default socket options are [{mode,list},{packet, 0},{header, 0},{active, true}]. </c></p> @@ -266,7 +264,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <p>Possible path validation errors: </p> -<p> {bad_cert, cert_expired}, {bad_cert, invalid_issuer}, {bad_cert, invalid_signature}, {bad_cert, unknown_ca}, {bad_cert, name_not_permitted}, {bad_cert, missing_basic_constraint}, {bad_cert, invalid_key_usage}</p> +<p> {bad_cert, cert_expired}, {bad_cert, invalid_issuer}, {bad_cert, invalid_signature}, {bad_cert, unknown_ca},{bad_cert, selfsigned_peer}, {bad_cert, name_not_permitted}, {bad_cert, missing_basic_constraint}, {bad_cert, invalid_key_usage}</p> </item> <tag>{hibernate_after, integer()|undefined}</tag> @@ -488,7 +486,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <fsummary>Get the value of the specified options.</fsummary> <type> <v>Socket = sslsocket()</v> - <v>OptionNames = [property()]</v> + <v>OptionNames = [atom()]</v> </type> <desc> <p>Get the value of the specified socket options, if no @@ -583,7 +581,7 @@ fun(OtpCert :: #'OTPCertificate'{}, Event :: {bad_cert, Reason :: atom()} | <fsummary>Write data to a socket.</fsummary> <type> <v>Socket = sslsocket()</v> - <v>Data = iolist() | binary()</v> + <v>Data = iodata()</v> </type> <desc> <p>Writes <c>Data</c> to <c>Socket</c>. </p> diff --git a/lib/ssl/examples/certs/Makefile b/lib/ssl/examples/certs/Makefile index b811b461dc..a4f067ade6 100644 --- a/lib/ssl/examples/certs/Makefile +++ b/lib/ssl/examples/certs/Makefile @@ -57,5 +57,5 @@ release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/examples/certs tar cf - etc | \ (cd $(RELSYSDIR)/examples/certs; tar xf -) - chmod -f -R ug+rw $(RELSYSDIR)/examples + chmod -R ug+rw $(RELSYSDIR)/examples release_docs_spec: diff --git a/lib/ssl/examples/src/Makefile b/lib/ssl/examples/src/Makefile index 46c0507b3a..ae5881d49b 100644 --- a/lib/ssl/examples/src/Makefile +++ b/lib/ssl/examples/src/Makefile @@ -66,7 +66,7 @@ release_spec: opt $(INSTALL_DIR) $(RELSYSDIR)/examples/src $(INSTALL_DIR) $(RELSYSDIR)/examples/ebin (cd ..; tar cf - src ebin | (cd $(RELSYSDIR)/examples; tar xf -)) - chmod -f -R ug+w $(RELSYSDIR)/examples + chmod -R ug+w $(RELSYSDIR)/examples release_docs_spec: diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index d3e426f254..a0ecb4ac6f 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,6 +1,7 @@ %% -*- erlang -*- {"%VSN%", [ + {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, {"4.1.2", [{restart_application, ssl}]}, {"4.1.1", [{restart_application, ssl}]}, @@ -8,6 +9,7 @@ {"4.0.1", [{restart_application, ssl}]} ], [ + {"4.1.4", [{restart_application, ssl}]}, {"4.1.3", [{restart_application, ssl}]}, {"4.1.2", [{restart_application, ssl}]}, {"4.1.1", [{restart_application, ssl}]}, diff --git a/lib/ssl/src/ssl.erl b/lib/ssl/src/ssl.erl index 7b1fda4cf9..380c59b058 100644 --- a/lib/ssl/src/ssl.erl +++ b/lib/ssl/src/ssl.erl @@ -50,8 +50,7 @@ cb %% Callback info }). -type option() :: socketoption() | ssloption() | transportoption(). --type socketoption() :: [{property(), term()}]. %% See gen_tcp and inet --type property() :: atom(). +-type socketoption() :: term(). %% See gen_tcp and inet, import spec later when there is one to import -type ssloption() :: {verify, verify_type()} | {verify_fun, {fun(), InitialUserState::term()}} | {fail_if_no_peer_cert, boolean()} | {depth, integer()} | @@ -264,7 +263,7 @@ close(Socket = #sslsocket{}) -> ssl_broker:close(Socket). %%-------------------------------------------------------------------- --spec send(#sslsocket{}, iolist()) -> ok | {error, reason()}. +-spec send(#sslsocket{}, iodata()) -> ok | {error, reason()}. %% %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- @@ -403,9 +402,9 @@ cipher_suites(openssl) -> [ssl_cipher:openssl_suite_name(S) || S <- ssl_cipher:suites(Version)]. %%-------------------------------------------------------------------- --spec getopts(#sslsocket{}, [atom()]) -> {ok, [{atom(), term()}]}| {error, reason()}. +-spec getopts(#sslsocket{}, [atom()]) -> {ok, [{atom(), term()}]} | {error, reason()}. %% -%% Description: +%% Description: Gets options %%-------------------------------------------------------------------- getopts(#sslsocket{fd = new_ssl, pid = Pid}, OptTags) when is_pid(Pid) -> ssl_connection:get_opts(Pid, OptTags); @@ -416,9 +415,9 @@ getopts(#sslsocket{} = Socket, Options) -> ssl_broker:getopts(Socket, Options). %%-------------------------------------------------------------------- --spec setopts(#sslsocket{}, [{atom(), term()}]) -> ok | {error, reason()}. +-spec setopts(#sslsocket{}, [proplist:property()]) -> ok | {error, reason()}. %% -%% Description: +%% Description: Sets options %%-------------------------------------------------------------------- setopts(#sslsocket{fd = new_ssl, pid = Pid}, Opts0) when is_pid(Pid) -> Opts = proplists:expand([{binary, [{mode, binary}]}, diff --git a/lib/ssl/src/ssl_connection.erl b/lib/ssl/src/ssl_connection.erl index 574e1e9468..0a86e9bd29 100644 --- a/lib/ssl/src/ssl_connection.erl +++ b/lib/ssl/src/ssl_connection.erl @@ -107,12 +107,14 @@ %%==================================================================== %%-------------------------------------------------------------------- --spec send(pid(), iolist()) -> ok | {error, reason()}. +-spec send(pid(), iodata()) -> ok | {error, reason()}. %% %% Description: Sends data over the ssl connection %%-------------------------------------------------------------------- send(Pid, Data) -> sync_send_all_state_event(Pid, {application_data, + %% iolist_to_binary should really + %% be called iodata_to_binary() erlang:iolist_to_binary(Data)}, infinity). %%-------------------------------------------------------------------- diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index fd3b6d06ad..53b2223035 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -128,7 +128,7 @@ release_tests_spec: opt $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(HRL_FILES_NEEDED_IN_TEST) $(COVER_FILE) $(RELSYSDIR) $(INSTALL_DATA) ssl.spec ssl.cover $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index 2f1edfa186..0e80e42637 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 4.1.4 +SSL_VSN = 4.1.5 diff --git a/lib/stdlib/doc/src/dict.xml b/lib/stdlib/doc/src/dict.xml index 40e61d7d33..0cc76e0c78 100644 --- a/lib/stdlib/doc/src/dict.xml +++ b/lib/stdlib/doc/src/dict.xml @@ -55,10 +55,8 @@ dictionary() </type> <desc> <p>This function appends a new <c>Value</c> to the current list - of values associated with <c>Key</c>. An exception is - generated if the initial value associated with <c>Key</c> is - not a list of values.</p> - </desc> + of values associated with <c>Key</c>.</p> + </desc> </func> <func> <name>append_list(Key, ValList, Dict1) -> Dict2</name> diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml index 45fa0847a8..d6203bdaa0 100644 --- a/lib/stdlib/doc/src/supervisor.xml +++ b/lib/stdlib/doc/src/supervisor.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2010</year> + <year>1996</year><year>2011</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -83,11 +83,17 @@ supervisor, where all child processes are dynamically added instances of the same process type, i.e. running the same code.</p> - <p>The functions <c>terminate_child/2</c>, <c>delete_child/2</c> + <p>The functions <c>delete_child/2</c> and <c>restart_child/2</c> are invalid for <c>simple_one_for_one</c> supervisors and will return <c>{error,simple_one_for_one}</c> if the specified supervisor uses this restart strategy.</p> + <p>The function <c>terminate_child/2</c> can be used for + children under <c>simple_one_for_one</c> supervisors by + giving the child's <c>pid()</c> as the second argument. If + instead the child specification identifier is used, + <c>terminate_child/2</c> will return + <c>{error,simple_one_for_one}</c>.</p> </item> </list> <p>To prevent a supervisor from getting into an infinite loop of @@ -311,24 +317,33 @@ child_spec() = {Id,StartFunc,Restart,Shutdown,Type,Modules} <type> <v>SupRef = Name | {Name,Node} | {global,Name} | pid()</v> <v> Name = Node = atom()</v> - <v>Id = term()</v> + <v>Id = pid() | term()</v> <v>Result = ok | {error,Error}</v> <v> Error = not_found | simple_one_for_one</v> </type> <desc> - <p>Tells the supervisor <c>SupRef</c> to terminate the child - process corresponding to the child specification identified - by <c>Id</c>. The process, if there is one, is terminated but - the child specification is kept by the supervisor. This means - that the child process may be later be restarted by - the supervisor. The child process can also be restarted - explicitly by calling <c>restart_child/2</c>. Use - <c>delete_child/2</c> to remove the child specification.</p> + <p>Tells the supervisor <c>SupRef</c> to terminate the given + child.</p> + <p>If the supervisor is not <c>simple_one_for_one</c>, + <c>Id</c> must be the child specification identifier. The + process, if there is one, is terminated but the child + specification is kept by the supervisor. The child process + may later be restarted by the supervisor. The child process + can also be restarted explicitly by calling + <c>restart_child/2</c>. Use <c>delete_child/2</c> to remove + the child specification.</p> + <p>If the supervisor is <c>simple_one_for_one</c>, <c>Id</c> + must be the child process' <c>pid()</c>. I the specified + process is alive, but is not a child of the given + supervisor, the function will return + <c>{error,not_found}</c>. If the child specification + identifier is given instead instead of a <c>pid()</c>, the + function will return <c>{error,simple_one_for_one}</c>.</p> + <p>If successful, the function returns <c>ok</c>. If there is + no child specification with the specified <c>Id</c>, the + function returns <c>{error,not_found}</c>.</p> <p>See <c>start_child/2</c> for a description of <c>SupRef</c>.</p> - <p>If successful, the function returns <c>ok</c>. If there is - no child specification with the specified <c>Id</c>, - the function returns <c>{error,not_found}</c>.</p> </desc> </func> <func> diff --git a/lib/stdlib/doc/src/unicode.xml b/lib/stdlib/doc/src/unicode.xml index e3a25a407b..cb1cfa8ed0 100644 --- a/lib/stdlib/doc/src/unicode.xml +++ b/lib/stdlib/doc/src/unicode.xml @@ -164,10 +164,16 @@ latin1_charlist() = [latin1_char() | latin1_binary() | latin1_charlist()] <item>Integers out of range - If <c>InEncoding</c> is <c>latin1</c>, an error occurs whenever an integer greater than 255 is found in the lists. If <c>InEncoding</c> is - of a Unicode type, error occurs whenever an integer greater than - <c>16#10FFFF</c> (the maximum unicode character) or in the - range <c>16#D800</c> to <c>16#DFFF</c> (invalid unicode - range) is found.</item> + of a Unicode type, an error occurs whenever an integer + <list type="bulleted"> + <item>greater than <c>16#10FFFF</c> + (the maximum unicode character),</item> + <item>in the range <c>16#D800</c> to <c>16#DFFF</c> + (invalid unicode range)</item> + <item>or equal to 16#FFFE or 16#FFFF (non characters)</item> + </list> + is found. + </item> <item>UTF encoding incorrect - If <c>InEncoding</c> is one of the UTF types, the bytes in any binaries have to be valid diff --git a/lib/stdlib/src/gen.erl b/lib/stdlib/src/gen.erl index 43df6f621d..574146b1cd 100644 --- a/lib/stdlib/src/gen.erl +++ b/lib/stdlib/src/gen.erl @@ -29,6 +29,8 @@ -export([init_it/6, init_it/7]). +-export([format_status_header/2]). + -define(default_timeout, 5000). %%----------------------------------------------------------------- @@ -315,3 +317,10 @@ debug_options(Opts) -> {ok, Options} -> sys:debug_options(Options); _ -> [] end. + +format_status_header(TagLine, Pid) when is_pid(Pid) -> + lists:concat([TagLine, " ", pid_to_list(Pid)]); +format_status_header(TagLine, RegName) when is_atom(RegName) -> + lists:concat([TagLine, " ", RegName]); +format_status_header(TagLine, Name) -> + {TagLine, Name}. diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl index b1e9e3a02f..b00910771f 100644 --- a/lib/stdlib/src/gen_event.erl +++ b/lib/stdlib/src/gen_event.erl @@ -724,7 +724,8 @@ get_modules(MSL) -> %%----------------------------------------------------------------- format_status(Opt, StatusData) -> [PDict, SysState, Parent, _Debug, [ServerName, MSL, _Hib]] = StatusData, - Header = lists:concat(["Status for event handler ", ServerName]), + Header = gen:format_status_header("Status for event handler", + ServerName), FmtMSL = [case erlang:function_exported(Mod, format_status, 2) of true -> Args = [PDict, State], diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl index 7d9960b912..f2f1365d3d 100644 --- a/lib/stdlib/src/gen_fsm.erl +++ b/lib/stdlib/src/gen_fsm.erl @@ -614,15 +614,8 @@ get_msg(Msg) -> Msg. format_status(Opt, StatusData) -> [PDict, SysState, Parent, Debug, [Name, StateName, StateData, Mod, _Time]] = StatusData, - StatusHdr = "Status for state machine", - Header = if - is_pid(Name) -> - lists:concat([StatusHdr, " ", pid_to_list(Name)]); - is_atom(Name); is_list(Name) -> - lists:concat([StatusHdr, " ", Name]); - true -> - {StatusHdr, Name} - end, + Header = gen:format_status_header("Status for state machine", + Name), Log = sys:get_debug(log, Debug, []), DefaultStatus = [{data, [{"StateData", StateData}]}], Specfic = diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl index ac81df9cab..09d94a9c40 100644 --- a/lib/stdlib/src/gen_server.erl +++ b/lib/stdlib/src/gen_server.erl @@ -840,15 +840,8 @@ name_to_pid(Name) -> %%----------------------------------------------------------------- format_status(Opt, StatusData) -> [PDict, SysState, Parent, Debug, [Name, State, Mod, _Time]] = StatusData, - StatusHdr = "Status for generic server", - Header = if - is_pid(Name) -> - lists:concat([StatusHdr, " ", pid_to_list(Name)]); - is_atom(Name); is_list(Name) -> - lists:concat([StatusHdr, " ", Name]); - true -> - {StatusHdr, Name} - end, + Header = gen:format_status_header("Status for generic server", + Name), Log = sys:get_debug(log, Debug, []), DefaultStatus = [{data, [{"State", State}]}], Specfic = diff --git a/lib/stdlib/src/pool.erl b/lib/stdlib/src/pool.erl index 7f5f23e26d..a3c9927ee9 100644 --- a/lib/stdlib/src/pool.erl +++ b/lib/stdlib/src/pool.erl @@ -95,6 +95,9 @@ pspawn_link(M, F, A) -> start_nodes([], _, _) -> []; start_nodes([Host|Tail], Name, Args) -> case slave:start(Host, Name, Args) of + {error, {already_running, Node}} -> + io:format("Can't start node on host ~w due to ~w~n",[Host, {already_running, Node}]), + [Node | start_nodes(Tail, Name, Args)]; {error, R} -> io:format("Can't start node on host ~w due to ~w~n",[Host, R]), start_nodes(Tail, Name, Args); diff --git a/lib/stdlib/src/supervisor.erl b/lib/stdlib/src/supervisor.erl index 3c5800effa..4fd7f1d47c 100644 --- a/lib/stdlib/src/supervisor.erl +++ b/lib/stdlib/src/supervisor.erl @@ -138,7 +138,7 @@ delete_child(Supervisor, Name) -> %%----------------------------------------------------------------- -type term_err() :: 'not_found' | 'simple_one_for_one'. --spec terminate_child(sup_ref(), term()) -> 'ok' | {'error', term_err()}. +-spec terminate_child(sup_ref(), pid() | term()) -> 'ok' | {'error', term_err()}. terminate_child(Supervisor, Name) -> call(Supervisor, {terminate_child, Name}). @@ -297,8 +297,26 @@ handle_call({start_child, EArgs}, _From, State) when ?is_simple(State) -> {reply, What, State} end; -%%% The requests terminate_child, delete_child and restart_child are -%%% invalid for simple_one_for_one supervisors. +%% terminate_child for simple_one_for_one can only be done with pid +handle_call({terminate_child, Name}, _From, State) when not is_pid(Name), + ?is_simple(State) -> + {reply, {error, simple_one_for_one}, State}; + +handle_call({terminate_child, Name}, _From, State) -> + case get_child(Name, State, ?is_simple(State)) of + {value, Child} -> + case do_terminate(Child, State#state.name) of + #child{restart_type=RT} when RT=:=temporary; ?is_simple(State) -> + {reply, ok, state_del_child(Child, State)}; + NChild -> + {reply, ok, replace_child(NChild, State)} + end; + false -> + {reply, {error, not_found}, State} + end; + +%%% The requests delete_child and restart_child are invalid for +%%% simple_one_for_one supervisors. handle_call({_Req, _Data}, _From, State) when ?is_simple(State) -> {reply, {error, simple_one_for_one}, State}; @@ -341,15 +359,6 @@ handle_call({delete_child, Name}, _From, State) -> {reply, {error, not_found}, State} end; -handle_call({terminate_child, Name}, _From, State) -> - case get_child(Name, State) of - {value, Child} -> - NChild = do_terminate(Child, State#state.name), - {reply, ok, replace_child(NChild, State)}; - _ -> - {reply, {error, not_found}, State} - end; - handle_call(which_children, _From, #state{children = [#child{restart_type = temporary, child_type = CT, modules = Mods}]} = @@ -817,8 +826,12 @@ state_del_child(Child, State) -> NChildren = del_child(Child#child.name, State#state.children), State#state{children = NChildren}. +del_child(Name, [Ch|Chs]) when Ch#child.name =:= Name, Ch#child.restart_type =:= temporary -> + Chs; del_child(Name, [Ch|Chs]) when Ch#child.name =:= Name -> [Ch#child{pid = undefined} | Chs]; +del_child(Pid, [Ch|Chs]) when Ch#child.pid =:= Pid, Ch#child.restart_type =:= temporary -> + Chs; del_child(Pid, [Ch|Chs]) when Ch#child.pid =:= Pid -> [Ch#child{pid = undefined} | Chs]; del_child(Name, [Ch|Chs]) -> @@ -841,7 +854,28 @@ split_child(_, [], After) -> {lists:reverse(After), []}. get_child(Name, State) -> + get_child(Name, State, false). +get_child(Pid, State, AllowPid) when AllowPid, is_pid(Pid) -> + get_dynamic_child(Pid, State); +get_child(Name, State, _) -> lists:keysearch(Name, #child.name, State#state.children). + +get_dynamic_child(Pid, #state{children=[Child], dynamics=Dynamics}) -> + case is_dynamic_pid(Pid, dynamics_db(Child#child.restart_type, Dynamics)) of + true -> + {value, Child#child{pid=Pid}}; + false -> + case erlang:is_process_alive(Pid) of + true -> false; + false -> {value, Child} + end + end. + +is_dynamic_pid(Pid, Dynamics) when is_list(Dynamics) -> + lists:member(Pid, Dynamics); +is_dynamic_pid(Pid, Dynamics) -> + dict:is_key(Pid, Dynamics). + replace_child(Child, State) -> Chs = do_replace_child(Child, State#state.children), State#state{children = Chs}. diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 3dd0a91870..5502c69fa5 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -135,7 +135,7 @@ release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) stdlib.spec $(EMAKEFILE) \ $(ERL_FILES) $(COVERFILE) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl index 9e3e717e7d..b3a7edc140 100644 --- a/lib/stdlib/test/gen_event_SUITE.erl +++ b/lib/stdlib/test/gen_event_SUITE.erl @@ -25,13 +25,14 @@ -export([start/1, add_handler/1, add_sup_handler/1, delete_handler/1, swap_handler/1, swap_sup_handler/1, notify/1, sync_notify/1, call/1, info/1, hibernate/1, - call_format_status/1, error_format_status/1]). + call_format_status/1, call_format_status_anon/1, + error_format_status/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> [start, {group, test_all}, hibernate, - call_format_status, error_format_status]. + call_format_status, call_format_status_anon, error_format_status]. groups() -> [{test_all, [], @@ -888,6 +889,22 @@ call_format_status(Config) when is_list(Config) -> ?line {"Installed handlers", [{_,dummy1_h,_,FmtState,_}]} = HandlerInfo2, ok. +call_format_status_anon(suite) -> + []; +call_format_status_anon(doc) -> + ["Test that sys:get_status/1,2 calls format_status/2 for anonymous gen_event processes"]; +call_format_status_anon(Config) when is_list(Config) -> + ?line {ok, Pid} = gen_event:start(), + %% The 'Name' of the gen_event process will be a pid() here, so + %% the next line will crash if format_status can't string-ify pids. + ?line Status1 = sys:get_status(Pid), + ?line ok = gen_event:stop(Pid), + Header = "Status for event handler " ++ pid_to_list(Pid), + ?line {status, Pid, _, [_, _, Pid, [], Data1]} = Status1, + ?line Header = proplists:get_value(header, Data1), + ok. + + error_format_status(suite) -> []; error_format_status(doc) -> diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index 6e927da2ab..cc271bd047 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -20,7 +20,8 @@ -module(supervisor_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). +-define(TIMEOUT, 1000). %% Testserver specific export -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, @@ -32,33 +33,34 @@ %% API tests -export([ sup_start_normal/1, sup_start_ignore_init/1, - sup_start_ignore_child/1, sup_start_error_return/1, - sup_start_fail/1, sup_stop_infinity/1, - sup_stop_timeout/1, sup_stop_brutal_kill/1, child_adm/1, - child_adm_simple/1, child_specs/1, extra_return/1]). + sup_start_ignore_child/1, sup_start_error_return/1, + sup_start_fail/1, sup_stop_infinity/1, + sup_stop_timeout/1, sup_stop_brutal_kill/1, child_adm/1, + child_adm_simple/1, child_specs/1, extra_return/1]). %% Tests concept permanent, transient and temporary -export([ permanent_normal/1, transient_normal/1, - temporary_normal/1, - permanent_abnormal/1, transient_abnormal/1, - temporary_abnormal/1]). + temporary_normal/1, + permanent_abnormal/1, transient_abnormal/1, + temporary_abnormal/1]). %% Restart strategy tests -export([ one_for_one/1, - one_for_one_escalation/1, one_for_all/1, - one_for_all_escalation/1, - simple_one_for_one/1, simple_one_for_one_escalation/1, - rest_for_one/1, rest_for_one_escalation/1, - simple_one_for_one_extra/1]). + one_for_one_escalation/1, one_for_all/1, + one_for_all_escalation/1, + simple_one_for_one/1, simple_one_for_one_escalation/1, + rest_for_one/1, rest_for_one_escalation/1, + simple_one_for_one_extra/1]). %% Misc tests -export([child_unlink/1, tree/1, count_children_memory/1, - do_not_save_start_parameters_for_temporary_children/1]). + do_not_save_start_parameters_for_temporary_children/1, + do_not_save_child_specs_for_temporary_children/1]). -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}]. all() -> [{group, sup_start}, {group, sup_stop}, child_adm, @@ -69,7 +71,8 @@ all() -> {group, restart_rest_for_one}, {group, normal_termination}, {group, abnormal_termination}, child_unlink, tree, - count_children_memory, do_not_save_start_parameters_for_temporary_children]. + count_children_memory, do_not_save_start_parameters_for_temporary_children, + do_not_save_child_specs_for_temporary_children]. groups() -> [{sup_start, [], @@ -94,8 +97,10 @@ groups() -> {restart_rest_for_one, [], [rest_for_one, rest_for_one_escalation]}]. -init_per_suite(Config) -> - Config. +init_per_suite(Config0) -> + Config = lists:keydelete(watchdog, 1, Config0), + Dog = test_server:timetrap(?TIMEOUT), + [{watchdog, Dog} | Config]. end_per_suite(_Config) -> ok. @@ -114,12 +119,13 @@ init_per_testcase(count_children_memory, Config) -> {skip, "+Meamin used during test; erlang:memory/1 not available"} end; init_per_testcase(_Case, Config) -> + erlang:display(_Case), Config. end_per_testcase(_Case, _Config) -> ok. -start(InitResult) -> +start_link(InitResult) -> supervisor:start_link({local, sup_test}, ?MODULE, InitResult). %% Simulate different supervisors callback. @@ -136,145 +142,87 @@ get_child_counts(Supervisor) -> proplists:get_value(supervisors, Counts), proplists:get_value(workers, Counts)]. -%------------------------------------------------------------------------- -% Test cases starts here. -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- +%% Test cases starts here. +%%------------------------------------------------------------------------- sup_start_normal(doc) -> ["Tests that the supervisor process starts correctly and that it " - "can be terminated gracefully."]; + "can be terminated gracefully."]; sup_start_normal(suite) -> []; sup_start_normal(Config) when is_list(Config) -> process_flag(trap_exit, true), - ?line {ok, Pid} = start({ok, {{one_for_one, 2, 3600}, []}}), - ?line exit(Pid, shutdown), - receive - {'EXIT', Pid, shutdown} -> - ok; - {'EXIT', Pid, Else} -> - ?line test_server:fail({bad_exit_reason, Else}) - after - 2000 -> - ?line test_server:fail(no_exit_reason) - end, - ok. -%------------------------------------------------------------------------- + {ok, Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), + terminate(Pid, shutdown). + +%%------------------------------------------------------------------------- sup_start_ignore_init(doc) -> ["Tests what happens if init-callback returns ignore"]; sup_start_ignore_init(suite) -> []; sup_start_ignore_init(Config) when is_list(Config) -> process_flag(trap_exit, true), - ?line ignore = start(ignore), + ignore = start_link(ignore), + check_exit_reason(normal). - receive - {'EXIT', _Pid, normal} -> - ok; - {'EXIT', _Pid, Else} -> - ?line test_server:fail({bad_exit_reason, Else}) - after - 2000 -> - ?line test_server:fail(no_exit_reason) - end, - ok. - - -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- sup_start_ignore_child(doc) -> ["Tests what happens if init-callback returns ignore"]; sup_start_ignore_child(suite) -> []; sup_start_ignore_child(Config) when is_list(Config) -> process_flag(trap_exit, true), - ?line {ok, _Pid} = start({ok, {{one_for_one, 2, 3600}, []}}), + {ok, _Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, [ignore]}, permanent, 1000, worker, []}, Child2 = {child2, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, - - ?line {ok, undefined} = supervisor:start_child(sup_test, Child1), - ?line {ok, CPid2} = supervisor:start_child(sup_test, Child2), - ?line [{child2, CPid2, worker, []},{child1, undefined, worker, []}] - = supervisor:which_children(sup_test), - ?line [2,1,0,2] = get_child_counts(sup_test), + {ok, undefined} = supervisor:start_child(sup_test, Child1), + {ok, CPid2} = supervisor:start_child(sup_test, Child2), - ok. + [{child2, CPid2, worker, []},{child1, undefined, worker, []}] + = supervisor:which_children(sup_test), + [2,1,0,2] = get_child_counts(sup_test). -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- sup_start_error_return(doc) -> ["Tests what happens if init-callback returns a invalid value"]; sup_start_error_return(suite) -> []; sup_start_error_return(Config) when is_list(Config) -> process_flag(trap_exit, true), - ?line {error, Term} = start(invalid), + {error, Term} = start_link(invalid), + check_exit_reason(Term). - receive - {'EXIT', _Pid, Term} -> - ok; - {'EXIT', _Pid, Else} -> - ?line test_server:fail({bad_exit_reason, Else}) - after - 2000 -> - ?line test_server:fail(no_exit_reason) - end, - ok. - -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- sup_start_fail(doc) -> ["Tests what happens if init-callback fails"]; sup_start_fail(suite) -> []; sup_start_fail(Config) when is_list(Config) -> process_flag(trap_exit, true), - ?line {error, Term} = start(fail), + {error, Term} = start_link(fail), + check_exit_reason(Term). - receive - {'EXIT', _Pid, Term} -> - ok; - {'EXIT', _Pid, Else} -> - ?line test_server:fail({bad_exit_reason, Else}) - after - 2000 -> - ?line test_server:fail(no_exit_reason) - end, - ok. -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- sup_stop_infinity(doc) -> ["See sup_stop/1 when Shutdown = infinity, this walue is only allowed " - "for children of type supervisor"]; + "for children of type supervisor"]; sup_stop_infinity(suite) -> []; sup_stop_infinity(Config) when is_list(Config) -> process_flag(trap_exit, true), - ?line {ok, Pid} = start({ok, {{one_for_one, 2, 3600}, []}}), + {ok, Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, permanent, infinity, supervisor, []}, Child2 = {child2, {supervisor_1, start_child, []}, permanent, - infinity, worker, []}, - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), + infinity, worker, []}, + {ok, CPid1} = supervisor:start_child(sup_test, Child1), link(CPid1), - ?line {error, {invalid_shutdown,infinity}} = - supervisor:start_child(sup_test, Child2), + {error, {invalid_shutdown,infinity}} = + supervisor:start_child(sup_test, Child2), - ?line exit(Pid, shutdown), - - receive - {'EXIT', Pid, shutdown} -> - ok; - {'EXIT', Pid, Else} -> - ?line test_server:fail({bad_exit_reason, Else}) - after - 5000 -> - ?line test_server:fail(no_exit_reason) - end, - receive - {'EXIT', CPid1, shutdown} -> ok; - {'EXIT', CPid1, Reason} -> - ?line test_server:fail({bad_exit_reason, Reason}) - after - 2000 -> ?line test_server:fail(no_exit_reason) - end, - ok. + terminate(Pid, shutdown), + check_exit_reason(CPid1, shutdown). -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- sup_stop_timeout(doc) -> ["See sup_stop/1 when Shutdown = 1000"]; @@ -282,93 +230,47 @@ sup_stop_timeout(suite) -> []; sup_stop_timeout(Config) when is_list(Config) -> process_flag(trap_exit, true), - ?line {ok, Pid} = start({ok, {{one_for_one, 2, 3600}, []}}), + {ok, Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, Child2 = {child2, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), + {ok, CPid1} = supervisor:start_child(sup_test, Child1), link(CPid1), - ?line {ok, CPid2} = supervisor:start_child(sup_test, Child2), + {ok, CPid2} = supervisor:start_child(sup_test, Child2), link(CPid2), - + CPid2 ! {sleep, 200000}, - ?line exit(Pid, shutdown), + terminate(Pid, shutdown), - receive - {'EXIT', Pid, shutdown} -> - ok; - {'EXIT', Pid, Else} -> - ?line test_server:fail({bad_exit_reason, Else}) - after - 5000 -> - ?line test_server:fail(no_exit_reason) - end, + check_exit_reason(CPid1, shutdown), + check_exit_reason(CPid2, killed). - receive - {'EXIT', CPid1, shutdown} -> ok; - {'EXIT', CPid1, Reason} -> - ?line test_server:fail({bad_exit_reason,Reason}) - after - 2000 -> ?line test_server:fail(no_exit_reason) - end, - - receive - {'EXIT', CPid2, killed} -> ok; - {'EXIT', CPid2, Reason2} -> - ?line test_server:fail({bad_exit_reason, Reason2}) - after - 2000 -> ?line test_server:fail(no_exit_reason) - end, - ok. -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- sup_stop_brutal_kill(doc) -> ["See sup_stop/1 when Shutdown = brutal_kill"]; sup_stop_brutal_kill(suite) -> []; sup_stop_brutal_kill(Config) when is_list(Config) -> process_flag(trap_exit, true), - ?line {ok, Pid} = start({ok, {{one_for_one, 2, 3600}, []}}), + {ok, Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, Child2 = {child2, {supervisor_1, start_child, []}, permanent, brutal_kill, worker, []}, - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), + {ok, CPid1} = supervisor:start_child(sup_test, Child1), link(CPid1), - ?line {ok, CPid2} = supervisor:start_child(sup_test, Child2), + {ok, CPid2} = supervisor:start_child(sup_test, Child2), link(CPid2), - ?line exit(Pid, shutdown), - - receive - {'EXIT', Pid, shutdown} -> - ok; - {'EXIT', Pid, Else} -> - ?line test_server:fail({bad_exit_reason, Else}) - after - 5000 -> - ?line test_server:fail(no_exit_reason) - end, + terminate(Pid, shutdown), - receive - {'EXIT', CPid1, shutdown} -> ok; - {'EXIT', CPid1, Reason} -> - ?line test_server:fail({bad_exit_reason, Reason}) - after - 2000 -> ?line test_server:fail(no_exit_reason) - end, - receive - {'EXIT', CPid2, killed} -> ok; - {'EXIT', CPid2, Reason2} -> - ?line test_server:fail({bad_exit_reason, Reason2}) - after - 2000 -> ?line test_server:fail(no_exit_reason) - end, - ok. + check_exit_reason(CPid1, shutdown), + check_exit_reason(CPid2, killed). -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- extra_return(doc) -> ["The start function provided to start a child may " "return {ok, Pid} or {ok, Pid, Info}, if it returns " @@ -382,46 +284,40 @@ extra_return(Config) when is_list(Config) -> Child = {child1, {supervisor_1, start_child, [extra_return]}, permanent, 1000, worker, []}, - ?line {ok, _Pid} = start({ok, {{one_for_one, 2, 3600}, [Child]}}), - ?line [{child1, CPid, worker, []}] = supervisor:which_children(sup_test), + {ok, _Pid} = start_link({ok, {{one_for_one, 2, 3600}, [Child]}}), + [{child1, CPid, worker, []}] = supervisor:which_children(sup_test), link(CPid), - ?line {error, not_found} = supervisor:terminate_child(sup_test, hej), - ?line {error, not_found} = supervisor:delete_child(sup_test, hej), - ?line {error, not_found} = supervisor:restart_child(sup_test, hej), - ?line {error, running} = supervisor:delete_child(sup_test, child1), - ?line {error, running} = supervisor:restart_child(sup_test, child1), - ?line [{child1, CPid, worker, []}] = supervisor:which_children(sup_test), - ?line [1,1,0,1] = get_child_counts(sup_test), - - ?line ok = supervisor:terminate_child(sup_test, child1), - receive - {'EXIT', CPid, shutdown} -> ok; - {'EXIT', CPid, Reason} -> - ?line test_server:fail({bad_reason, Reason}) - after 1000 -> - ?line test_server:fail(no_child_termination) - end, - ?line [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test), - ?line [1,0,0,1] = get_child_counts(sup_test), - - ?line {ok, CPid2,extra_return} = + {error, not_found} = supervisor:terminate_child(sup_test, hej), + {error, not_found} = supervisor:delete_child(sup_test, hej), + {error, not_found} = supervisor:restart_child(sup_test, hej), + {error, running} = supervisor:delete_child(sup_test, child1), + {error, running} = supervisor:restart_child(sup_test, child1), + [{child1, CPid, worker, []}] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + + ok = supervisor:terminate_child(sup_test, child1), + check_exit_reason(CPid, shutdown), + [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test), + [1,0,0,1] = get_child_counts(sup_test), + + {ok, CPid2,extra_return} = supervisor:restart_child(sup_test, child1), - ?line [{child1, CPid2, worker, []}] = supervisor:which_children(sup_test), - ?line [1,1,0,1] = get_child_counts(sup_test), + [{child1, CPid2, worker, []}] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), - ?line ok = supervisor:terminate_child(sup_test, child1), - ?line ok = supervisor:terminate_child(sup_test, child1), - ?line ok = supervisor:delete_child(sup_test, child1), - ?line {error, not_found} = supervisor:restart_child(sup_test, child1), - ?line [] = supervisor:which_children(sup_test), - ?line [0,0,0,0] = get_child_counts(sup_test), + ok = supervisor:terminate_child(sup_test, child1), + ok = supervisor:terminate_child(sup_test, child1), + ok = supervisor:delete_child(sup_test, child1), + {error, not_found} = supervisor:restart_child(sup_test, child1), + [] = supervisor:which_children(sup_test), + [0,0,0,0] = get_child_counts(sup_test), - ?line {ok, CPid3, extra_return} = supervisor:start_child(sup_test, Child), - ?line [{child1, CPid3, worker, []}] = supervisor:which_children(sup_test), - ?line [1,1,0,1] = get_child_counts(sup_test), + {ok, CPid3, extra_return} = supervisor:start_child(sup_test, Child), + [{child1, CPid3, worker, []}] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), ok. -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- child_adm(doc)-> ["Test API functions start_child/2, terminate_child/2, delete_child/2 " "restart_child/2, which_children/1, count_children/1. Only correct " @@ -432,116 +328,124 @@ child_adm(Config) when is_list(Config) -> process_flag(trap_exit, true), Child = {child1, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, - ?line {ok, _Pid} = start({ok, {{one_for_one, 2, 3600}, [Child]}}), - ?line [{child1, CPid, worker, []}] = supervisor:which_children(sup_test), - ?line [1,1,0,1] = get_child_counts(sup_test), + {ok, _Pid} = start_link({ok, {{one_for_one, 2, 3600}, [Child]}}), + [{child1, CPid, worker, []}] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), link(CPid), %% Start of an already runnig process - ?line {error,{already_started, CPid}} = + {error,{already_started, CPid}} = supervisor:start_child(sup_test, Child), - + %% Termination - ?line {error, not_found} = supervisor:terminate_child(sup_test, hej), - ?line {'EXIT',{noproc,{gen_server,call, _}}} = + {error, not_found} = supervisor:terminate_child(sup_test, hej), + {'EXIT',{noproc,{gen_server,call, _}}} = (catch supervisor:terminate_child(foo, child1)), - ?line ok = supervisor:terminate_child(sup_test, child1), - receive - {'EXIT', CPid, shutdown} -> ok; - {'EXIT', CPid, Reason} -> - ?line test_server:fail({bad_reason, Reason}) - after 1000 -> - ?line test_server:fail(no_child_termination) - end, - ?line [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test), - ?line [1,0,0,1] = get_child_counts(sup_test), + ok = supervisor:terminate_child(sup_test, child1), + check_exit_reason(CPid, shutdown), + [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test), + [1,0,0,1] = get_child_counts(sup_test), %% Like deleting something that does not exist, it will succeed! - ?line ok = supervisor:terminate_child(sup_test, child1), + ok = supervisor:terminate_child(sup_test, child1), %% Start of already existing but not running process - ?line {error,already_present} = - supervisor:start_child(sup_test, Child), + {error,already_present} = supervisor:start_child(sup_test, Child), %% Restart - ?line {ok, CPid2} = supervisor:restart_child(sup_test, child1), - ?line [{child1, CPid2, worker, []}] = supervisor:which_children(sup_test), - ?line [1,1,0,1] = get_child_counts(sup_test), - ?line {error, running} = supervisor:restart_child(sup_test, child1), - ?line {error, not_found} = supervisor:restart_child(sup_test, child2), - + {ok, CPid2} = supervisor:restart_child(sup_test, child1), + [{child1, CPid2, worker, []}] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + {error, running} = supervisor:restart_child(sup_test, child1), + {error, not_found} = supervisor:restart_child(sup_test, child2), + %% Deletion - ?line {error, running} = supervisor:delete_child(sup_test, child1), - ?line {error, not_found} = supervisor:delete_child(sup_test, hej), - ?line {'EXIT',{noproc,{gen_server,call, _}}} = + {error, running} = supervisor:delete_child(sup_test, child1), + {error, not_found} = supervisor:delete_child(sup_test, hej), + {'EXIT',{noproc,{gen_server,call, _}}} = (catch supervisor:delete_child(foo, child1)), - ?line ok = supervisor:terminate_child(sup_test, child1), - ?line ok = supervisor:delete_child(sup_test, child1), - ?line {error, not_found} = supervisor:restart_child(sup_test, child1), - ?line [] = supervisor:which_children(sup_test), - ?line [0,0,0,0] = get_child_counts(sup_test), - + ok = supervisor:terminate_child(sup_test, child1), + ok = supervisor:delete_child(sup_test, child1), + {error, not_found} = supervisor:restart_child(sup_test, child1), + [] = supervisor:which_children(sup_test), + [0,0,0,0] = get_child_counts(sup_test), + %% Start - ?line {'EXIT',{noproc,{gen_server,call, _}}} = + {'EXIT',{noproc,{gen_server,call, _}}} = (catch supervisor:start_child(foo, Child)), - ?line {ok, CPid3} = supervisor:start_child(sup_test, Child), - ?line [{child1, CPid3, worker, []}] = supervisor:which_children(sup_test), - ?line [1,1,0,1] = get_child_counts(sup_test), + {ok, CPid3} = supervisor:start_child(sup_test, Child), + [{child1, CPid3, worker, []}] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + + %% Terminate with Pid not allowed when not simple_one_for_one + {error,not_found} = supervisor:terminate_child(sup_test, CPid3), + [{child1, CPid3, worker, []}] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), - ?line {'EXIT',{noproc,{gen_server,call,[foo,which_children,infinity]}}} + {'EXIT',{noproc,{gen_server,call,[foo,which_children,infinity]}}} = (catch supervisor:which_children(foo)), - ?line {'EXIT',{noproc,{gen_server,call,[foo,count_children,infinity]}}} + {'EXIT',{noproc,{gen_server,call,[foo,count_children,infinity]}}} = (catch supervisor:count_children(foo)), ok. -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- child_adm_simple(doc) -> ["The API functions terminate_child/2, delete_child/2 " "restart_child/2 are not valid for a simple_one_for_one supervisor " - "check that the correct error message is returned."]; + "check that the correct error message is returned."]; child_adm_simple(suite) -> []; child_adm_simple(Config) when is_list(Config) -> Child = {child, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, - ?line {ok, _Pid} = start({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), + {ok, _Pid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), %% In simple_one_for_one all children are added dynamically - ?line [] = supervisor:which_children(sup_test), - ?line [1,0,0,0] = get_child_counts(sup_test), - + [] = supervisor:which_children(sup_test), + [1,0,0,0] = get_child_counts(sup_test), + %% Start - ?line {'EXIT',{noproc,{gen_server,call, _}}} = + {'EXIT',{noproc,{gen_server,call, _}}} = (catch supervisor:start_child(foo, [])), - ?line {ok, CPid1} = supervisor:start_child(sup_test, []), - ?line [{undefined, CPid1, worker, []}] = + {ok, CPid1} = supervisor:start_child(sup_test, []), + [{undefined, CPid1, worker, []}] = supervisor:which_children(sup_test), - ?line [1,1,0,1] = get_child_counts(sup_test), - - ?line {ok, CPid2} = supervisor:start_child(sup_test, []), - ?line Children = supervisor:which_children(sup_test), - ?line 2 = length(Children), - ?line true = lists:member({undefined, CPid2, worker, []}, Children), - ?line true = lists:member({undefined, CPid1, worker, []}, Children), - ?line [1,2,0,2] = get_child_counts(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + + {ok, CPid2} = supervisor:start_child(sup_test, []), + Children = supervisor:which_children(sup_test), + 2 = length(Children), + true = lists:member({undefined, CPid2, worker, []}, Children), + true = lists:member({undefined, CPid1, worker, []}, Children), + [1,2,0,2] = get_child_counts(sup_test), %% Termination - ?line {error, simple_one_for_one} = - supervisor:terminate_child(sup_test, child1), + {error, simple_one_for_one} = supervisor:terminate_child(sup_test, child1), + [1,2,0,2] = get_child_counts(sup_test), + ok = supervisor:terminate_child(sup_test,CPid1), + [_] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + false = erlang:is_process_alive(CPid1), + %% Terminate non-existing proccess is ok + ok = supervisor:terminate_child(sup_test,CPid1), + [_] = supervisor:which_children(sup_test), + [1,1,0,1] = get_child_counts(sup_test), + %% Terminate pid which is not a child of this supervisor is not ok + NoChildPid = spawn_link(fun() -> receive after infinity -> ok end end), + {error, not_found} = supervisor:terminate_child(sup_test, NoChildPid), + true = erlang:is_process_alive(NoChildPid), %% Restart - ?line {error, simple_one_for_one} = - supervisor:restart_child(sup_test, child1), - + {error, simple_one_for_one} = supervisor:restart_child(sup_test, child1), + %% Deletion - ?line {error, simple_one_for_one} = - supervisor:delete_child(sup_test, child1), + {error, simple_one_for_one} = supervisor:delete_child(sup_test, child1), ok. - -%------------------------------------------------------------------------- + +%%------------------------------------------------------------------------- child_specs(doc) -> ["Tests child specs, invalid formats should be rejected."]; child_specs(suite) -> []; child_specs(Config) when is_list(Config) -> process_flag(trap_exit, true), - ?line {ok, _Pid} = start({ok, {{one_for_one, 2, 3600}, []}}), - ?line {error, _} = supervisor:start_child(sup_test, hej), + {ok, _Pid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), + {error, _} = supervisor:start_child(sup_test, hej), %% Bad child specs B1 = {child, mfa, permanent, 1000, worker, []}, @@ -551,7 +455,7 @@ child_specs(Config) when is_list(Config) -> B5 = {child, {m,f,[a]}, permanent, infinity, worker, []}, B6 = {child, {m,f,[a]}, permanent, 1000, worker, dy}, B7 = {child, {m,f,[a]}, permanent, 1000, worker, [1,2,3]}, - + %% Correct child specs! %% <Modules> (last parameter in a child spec) can be [] as we do %% not test code upgrade here. @@ -560,327 +464,261 @@ child_specs(Config) when is_list(Config) -> C3 = {child, {m,f,[a]}, temporary, 1000, worker, dynamic}, C4 = {child, {m,f,[a]}, transient, 1000, worker, [m]}, - ?line {error, {invalid_mfa,mfa}} = supervisor:start_child(sup_test, B1), - ?line {error, {invalid_restart_type, prmanent}} = + {error, {invalid_mfa,mfa}} = supervisor:start_child(sup_test, B1), + {error, {invalid_restart_type, prmanent}} = supervisor:start_child(sup_test, B2), - ?line {error, {invalid_shutdown,-10}} - = supervisor:start_child(sup_test, B3), - ?line {error, {invalid_child_type,wrker}} + {error, {invalid_shutdown,-10}} + = supervisor:start_child(sup_test, B3), + {error, {invalid_child_type,wrker}} = supervisor:start_child(sup_test, B4), - ?line {error, _} = supervisor:start_child(sup_test, B5), - ?line {error, {invalid_modules,dy}} + {error, _} = supervisor:start_child(sup_test, B5), + {error, {invalid_modules,dy}} = supervisor:start_child(sup_test, B6), - - ?line {error, {invalid_mfa,mfa}} = supervisor:check_childspecs([B1]), - ?line {error, {invalid_restart_type,prmanent}} = + + {error, {invalid_mfa,mfa}} = supervisor:check_childspecs([B1]), + {error, {invalid_restart_type,prmanent}} = supervisor:check_childspecs([B2]), - ?line {error, {invalid_shutdown,-10}} = supervisor:check_childspecs([B3]), - ?line {error, {invalid_child_type,wrker}} + {error, {invalid_shutdown,-10}} = supervisor:check_childspecs([B3]), + {error, {invalid_child_type,wrker}} = supervisor:check_childspecs([B4]), - ?line {error, _} = supervisor:check_childspecs([B5]), - ?line {error, {invalid_modules,dy}} = supervisor:check_childspecs([B6]), - ?line {error, {invalid_module, 1}} = + {error, _} = supervisor:check_childspecs([B5]), + {error, {invalid_modules,dy}} = supervisor:check_childspecs([B6]), + {error, {invalid_module, 1}} = supervisor:check_childspecs([B7]), - ?line ok = supervisor:check_childspecs([C1]), - ?line ok = supervisor:check_childspecs([C2]), - ?line ok = supervisor:check_childspecs([C3]), - ?line ok = supervisor:check_childspecs([C4]), + ok = supervisor:check_childspecs([C1]), + ok = supervisor:check_childspecs([C2]), + ok = supervisor:check_childspecs([C3]), + ok = supervisor:check_childspecs([C4]), ok. -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- permanent_normal(doc) -> ["A permanent child should always be restarted"]; permanent_normal(suite) -> []; permanent_normal(Config) when is_list(Config) -> - ?line {ok, _SupPid} = start({ok, {{one_for_one, 2, 3600}, []}}), + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, - - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), - - CPid1 ! stop, - test_server:sleep(100), - ?line [{child1, Pid ,worker,[]}] = supervisor:which_children(sup_test), + + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + + terminate(SupPid, CPid1, child1, normal), + + [{child1, Pid ,worker,[]}] = supervisor:which_children(sup_test), case is_pid(Pid) of true -> ok; false -> - ?line test_server:fail({permanent_child_not_restarted, Child1}) + test_server:fail({permanent_child_not_restarted, Child1}) end, - ?line [1,1,0,1] = get_child_counts(sup_test), + [1,1,0,1] = get_child_counts(sup_test). - ok. -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- transient_normal(doc) -> ["A transient child should not be restarted if it exits with " "reason normal"]; transient_normal(suite) -> []; transient_normal(Config) when is_list(Config) -> - ?line {ok, _SupPid} = start({ok, {{one_for_one, 2, 3600}, []}}), + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, transient, 1000, worker, []}, - - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), - - CPid1 ! stop, - test_server:sleep(100), - - ?line [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test), - ?line [1,0,0,1] = get_child_counts(sup_test), - ok. -%------------------------------------------------------------------------- + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + + terminate(SupPid, CPid1, child1, normal), + + [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test), + [1,0,0,1] = get_child_counts(sup_test). + +%%------------------------------------------------------------------------- temporary_normal(doc) -> ["A temporary process should never be restarted"]; temporary_normal(suite) -> []; temporary_normal(Config) when is_list(Config) -> - ?line {ok, _SupPid} = start({ok, {{one_for_one, 2, 3600}, []}}), + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, temporary, 1000, worker, []}, - - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), - - CPid1 ! stop, - test_server:sleep(100), - - ?line [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test), - ?line [1,0,0,1] = get_child_counts(sup_test), - ok. + {ok, CPid1} = supervisor:start_child(sup_test, Child1), -%------------------------------------------------------------------------- + terminate(SupPid, CPid1, child1, normal), + + [] = supervisor:which_children(sup_test), + [0,0,0,0] = get_child_counts(sup_test). + +%%------------------------------------------------------------------------- permanent_abnormal(doc) -> ["A permanent child should always be restarted"]; permanent_abnormal(suite) -> []; permanent_abnormal(Config) when is_list(Config) -> - ?line {ok, _SupPid} = start({ok, {{one_for_one, 2, 3600}, []}}), + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, - - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), - - CPid1 ! die, - test_server:sleep(100), - ?line [{child1, Pid ,worker,[]}] = supervisor:which_children(sup_test), + + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + terminate(SupPid, CPid1, child1, abnormal), + + [{child1, Pid ,worker,[]}] = supervisor:which_children(sup_test), case is_pid(Pid) of true -> ok; false -> - ?line test_server:fail({permanent_child_not_restarted, Child1}) + test_server:fail({permanent_child_not_restarted, Child1}) end, - ?line [1,1,0,1] = get_child_counts(sup_test), + [1,1,0,1] = get_child_counts(sup_test). - ok. -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- transient_abnormal(doc) -> ["A transient child should be restarted if it exits with " "reason abnormal"]; transient_abnormal(suite) -> []; transient_abnormal(Config) when is_list(Config) -> - ?line {ok, _SupPid} = start({ok, {{one_for_one, 2, 3600}, []}}), + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, transient, 1000, worker, []}, - - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), - - CPid1 ! die, - test_server:sleep(100), - - ?line [{child1, Pid ,worker,[]}] = supervisor:which_children(sup_test), + + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + terminate(SupPid, CPid1, child1, abnormal), + + [{child1, Pid ,worker,[]}] = supervisor:which_children(sup_test), case is_pid(Pid) of true -> ok; false -> - ?line test_server:fail({transient_child_not_restarted, Child1}) + test_server:fail({transient_child_not_restarted, Child1}) end, - ?line [1,1,0,1] = get_child_counts(sup_test), + [1,1,0,1] = get_child_counts(sup_test). - ok. -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- temporary_abnormal(doc) -> ["A temporary process should never be restarted"]; temporary_abnormal(suite) -> []; temporary_abnormal(Config) when is_list(Config) -> - ?line {ok, _SupPid} = start({ok, {{one_for_one, 2, 3600}, []}}), + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), Child1 = {child1, {supervisor_1, start_child, []}, temporary, 1000, worker, []}, - - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), - - CPid1 ! die, - test_server:sleep(100), - - ?line [{child1,undefined,worker,[]}] = supervisor:which_children(sup_test), - ?line [1,0,0,1] = get_child_counts(sup_test), - ok. -%------------------------------------------------------------------------- + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + terminate(SupPid, CPid1, child1, abnormal), + + [] = supervisor:which_children(sup_test), + [0,0,0,0] = get_child_counts(sup_test). + +%%------------------------------------------------------------------------- one_for_one(doc) -> ["Test the one_for_one base case."]; one_for_one(suite) -> []; one_for_one(Config) when is_list(Config) -> process_flag(trap_exit, true), Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, - worker, []}, + worker, []}, Child2 = {child2, {supervisor_1, start_child, []}, permanent, 1000, - worker, []}, - ?line {ok, Pid} = start({ok, {{one_for_one, 2, 3600}, []}}), - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), - link(CPid1), - ?line {ok, CPid2} = supervisor:start_child(sup_test, Child2), - link(CPid2), - CPid1 ! die, - receive - {'EXIT', CPid1, died} -> ok; - {'EXIT', CPid1, Reason} -> - ?line test_server:fail({bad_exit_reason, Reason}) - end, - test_server:sleep(100), + worker, []}, + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + {ok, CPid2} = supervisor:start_child(sup_test, Child2), + + terminate(SupPid, CPid1, child1, abnormal), Children = supervisor:which_children(sup_test), if length(Children) == 2 -> case lists:keysearch(CPid2, 2, Children) of {value, _} -> ok; - _ -> ?line test_server:fail(bad_child) + _ -> test_server:fail(bad_child) end; - true -> ?line test_server:fail({bad_child_list, Children}) + true -> test_server:fail({bad_child_list, Children}) end, - ?line [2,2,0,2] = get_child_counts(sup_test), - + [2,2,0,2] = get_child_counts(sup_test), + %% Test restart frequency property - CPid2 ! die, - receive - {'EXIT', CPid2, _} -> ok - end, - test_server:sleep(100), - [{_, Pid4, _, _}|_] = supervisor:which_children(sup_test), - Pid4 ! die, - receive - {'EXIT', Pid, _} -> ok - after 3000 -> ?line test_server:fail(restart_failed) - end, - ok. -%------------------------------------------------------------------------- + terminate(SupPid, CPid2, child2, abnormal), + + [{Id4, Pid4, _, _}|_] = supervisor:which_children(sup_test), + terminate(SupPid, Pid4, Id4, abnormal), + check_exit([SupPid]). + +%%------------------------------------------------------------------------- one_for_one_escalation(doc) -> ["Test restart escalation on a one_for_one supervisor."]; one_for_one_escalation(suite) -> []; one_for_one_escalation(Config) when is_list(Config) -> process_flag(trap_exit, true), + Child1 = {child1, {supervisor_1, start_child, [error]}, permanent, 1000, - worker, []}, + worker, []}, Child2 = {child2, {supervisor_1, start_child, []}, permanent, 1000, - worker, []}, - ?line {ok, Pid} = start({ok, {{one_for_one, 4, 3600}, []}}), - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), - link(CPid1), - ?line {ok, CPid2} = supervisor:start_child(sup_test, Child2), + worker, []}, + + {ok, SupPid} = start_link({ok, {{one_for_one, 4, 3600}, []}}), + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + {ok, CPid2} = supervisor:start_child(sup_test, Child2), link(CPid2), - CPid1 ! die, - receive - {'EXIT', CPid1, died} -> ok; - {'EXIT', CPid1, Reason} -> - ?line test_server:fail({bad_exit_reason, Reason}) - end, - receive - {'EXIT', Pid, _} -> ok - after - 2000 -> ?line test_server:fail(supervisor_alive) - end, - receive - {'EXIT', CPid2, _} -> ok - after - 4000 -> ?line test_server:fail(all_not_terminated) - end, - ok. -%------------------------------------------------------------------------- + + terminate(SupPid, CPid1, child1, abnormal), + check_exit([SupPid, CPid2]). + + +%%------------------------------------------------------------------------- one_for_all(doc) -> ["Test the one_for_all base case."]; one_for_all(suite) -> []; one_for_all(Config) when is_list(Config) -> process_flag(trap_exit, true), + Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, Child2 = {child2, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, - ?line {ok, Pid} = start({ok, {{one_for_all, 2, 3600}, []}}), - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), - link(CPid1), - ?line {ok, CPid2} = supervisor:start_child(sup_test, Child2), + {ok, SupPid} = start_link({ok, {{one_for_all, 2, 3600}, []}}), + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + {ok, CPid2} = supervisor:start_child(sup_test, Child2), link(CPid2), - CPid1 ! die, - receive - {'EXIT', CPid1, died} -> ok; - {'EXIT', CPid1, Reason} -> - ?line test_server:fail({bad_exit_reason, Reason}) - end, - receive - {'EXIT', CPid2, _} -> ok - end, - test_server:sleep(100), + + terminate(SupPid, CPid1, child1, abnormal), + check_exit([CPid2]), + Children = supervisor:which_children(sup_test), if length(Children) == 2 -> ok; - true -> ?line test_server:fail({bad_child_list, Children}) + true -> + test_server:fail({bad_child_list, Children}) end, + %% Test that no old children is still alive - SCh = lists:map(fun({_,P,_,_}) -> P end, Children), - case lists:member(CPid1, SCh) of - true -> ?line test_server:fail(bad_child); - false -> ok - end, - case lists:member(CPid2, SCh) of - true -> ?line test_server:fail(bad_child); - false -> ok - end, - ?line [2,2,0,2] = get_child_counts(sup_test), + not_in_child_list([CPid1, CPid2], lists:map(fun({_,P,_,_}) -> P end, Children)), + + [2,2,0,2] = get_child_counts(sup_test), %%% Test restart frequency property - [{_, Pid3, _, _}|_] = supervisor:which_children(sup_test), - Pid3 ! die, - test_server:sleep(100), - [{_, Pid4, _, _}|_] = supervisor:which_children(sup_test), - Pid4 ! die, - receive - {'EXIT', Pid, _} -> ok - after 3000 -> ?line test_server:fail(restart_failed) - end, - exit(Pid, shutdown). + [{Id3, Pid3, _, _}|_] = supervisor:which_children(sup_test), + terminate(SupPid, Pid3, Id3, abnormal), + [{Id4, Pid4, _, _}|_] = supervisor:which_children(sup_test), + terminate(SupPid, Pid4, Id4, abnormal), + check_exit([SupPid]). + -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- one_for_all_escalation(doc) -> ["Test restart escalation on a one_for_all supervisor."]; one_for_all_escalation(suite) -> []; one_for_all_escalation(Config) when is_list(Config) -> process_flag(trap_exit, true), + Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, Child2 = {child2, {supervisor_1, start_child, [error]}, permanent, 1000, worker, []}, - ?line {ok, Pid} = start({ok, {{one_for_all, 4, 3600}, []}}), - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), - link(CPid1), - ?line {ok, CPid2} = supervisor:start_child(sup_test, Child2), + {ok, SupPid} = start_link({ok, {{one_for_all, 4, 3600}, []}}), + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + {ok, CPid2} = supervisor:start_child(sup_test, Child2), link(CPid2), - CPid1 ! die, - receive - {'EXIT', CPid1, died} -> ok; - {'EXIT', CPid1, Reason} -> - ?line test_server:fail({bad_exit_reason, Reason}) - end, - receive - {'EXIT', CPid2, _} -> ok - after - 2000 -> ?line test_server:fail(all_not_terminated) - end, - receive - {'EXIT', Pid, _} -> ok - after - 4000 -> ?line test_server:fail(supervisor_alive) - end, - ok. -%------------------------------------------------------------------------- + terminate(SupPid, CPid1, child1, abnormal), + check_exit([CPid2, SupPid]). + + +%%------------------------------------------------------------------------- simple_one_for_one(doc) -> ["Test the simple_one_for_one base case."]; simple_one_for_one(suite) -> []; @@ -888,42 +726,31 @@ simple_one_for_one(Config) when is_list(Config) -> process_flag(trap_exit, true), Child = {child, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, - ?line {ok, Pid} = start({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), - ?line {ok, CPid1} = supervisor:start_child(sup_test, []), - link(CPid1), - ?line {ok, CPid2} = supervisor:start_child(sup_test, []), - link(CPid2), - CPid1 ! die, - receive - {'EXIT', CPid1, died} -> ok; - {'EXIT', CPid1, Reason} -> - ?line test_server:fail({bad_exit_reason, Reason}) - end, - test_server:sleep(100), + {ok, SupPid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), + {ok, CPid1} = supervisor:start_child(sup_test, []), + {ok, CPid2} = supervisor:start_child(sup_test, []), + + terminate(SupPid, CPid1, child1, abnormal), + Children = supervisor:which_children(sup_test), if length(Children) == 2 -> case lists:keysearch(CPid2, 2, Children) of {value, _} -> ok; - _ -> ?line test_server:fail(bad_child) + _ -> test_server:fail(bad_child) end; - true -> ?line test_server:fail({bad_child_list, Children}) + true -> test_server:fail({bad_child_list, Children}) end, - ?line [1,2,0,2] = get_child_counts(sup_test), + [1,2,0,2] = get_child_counts(sup_test), %% Test restart frequency property - CPid2 ! die, - receive - {'EXIT', CPid2, _} -> ok - end, - test_server:sleep(100), - [{_, Pid4, _, _}|_] = supervisor:which_children(sup_test), - Pid4 ! die, - receive - {'EXIT', Pid, _} -> ok - after 3000 -> ?line test_server:fail(restart_failed) - end, - ok. -%------------------------------------------------------------------------- + terminate(SupPid, CPid2, child2, abnormal), + + [{Id4, Pid4, _, _}|_] = supervisor:which_children(sup_test), + + terminate(SupPid, Pid4, Id4, abnormal), + check_exit([SupPid]). + +%%------------------------------------------------------------------------- simple_one_for_one_extra(doc) -> ["Tests automatic restart of children " "who's start function return extra info."]; @@ -932,41 +759,26 @@ simple_one_for_one_extra(Config) when is_list(Config) -> process_flag(trap_exit, true), Child = {child, {supervisor_1, start_child, [extra_info]}, permanent, 1000, worker, []}, - ?line {ok, Pid} = start({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), - ?line {ok, CPid1, extra_info} = supervisor:start_child(sup_test, []), - link(CPid1), - ?line {ok, CPid2, extra_info} = supervisor:start_child(sup_test, []), + {ok, SupPid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), + {ok, CPid1, extra_info} = supervisor:start_child(sup_test, []), + {ok, CPid2, extra_info} = supervisor:start_child(sup_test, []), link(CPid2), - CPid1 ! die, - receive - {'EXIT', CPid1, died} -> ok; - {'EXIT', CPid1, Reason} -> - ?line test_server:fail({bad_exit_reason, Reason}) - end, - test_server:sleep(100), + terminate(SupPid, CPid1, child1, abnormal), Children = supervisor:which_children(sup_test), if length(Children) == 2 -> case lists:keysearch(CPid2, 2, Children) of {value, _} -> ok; - _ -> ?line test_server:fail(bad_child) + _ -> test_server:fail(bad_child) end; - true -> ?line test_server:fail({bad_child_list, Children}) + true -> test_server:fail({bad_child_list, Children}) end, - ?line [1,2,0,2] = get_child_counts(sup_test), + [1,2,0,2] = get_child_counts(sup_test), + terminate(SupPid, CPid2, child2, abnormal), + [{Id4, Pid4, _, _}|_] = supervisor:which_children(sup_test), + terminate(SupPid, Pid4, Id4, abnormal), + check_exit([SupPid]). - CPid2 ! die, - receive - {'EXIT', CPid2, _} -> ok - end, - test_server:sleep(100), - [{_, Pid4, _, _}|_] = supervisor:which_children(sup_test), - Pid4 ! die, - receive - {'EXIT', Pid, _} -> ok - after 3000 -> ?line test_server:fail(restart_failed) - end, - ok. -%------------------------------------------------------------------------- +%%------------------------------------------------------------------------- simple_one_for_one_escalation(doc) -> ["Test restart escalation on a simple_one_for_one supervisor."]; simple_one_for_one_escalation(suite) -> []; @@ -974,29 +786,16 @@ simple_one_for_one_escalation(Config) when is_list(Config) -> process_flag(trap_exit, true), Child = {child, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, - ?line {ok, Pid} = start({ok, {{simple_one_for_one, 4, 3600}, [Child]}}), - ?line {ok, CPid1} = supervisor:start_child(sup_test, [error]), + {ok, SupPid} = start_link({ok, {{simple_one_for_one, 4, 3600}, [Child]}}), + {ok, CPid1} = supervisor:start_child(sup_test, [error]), link(CPid1), - ?line {ok, CPid2} = supervisor:start_child(sup_test, []), + {ok, CPid2} = supervisor:start_child(sup_test, []), link(CPid2), - CPid1 ! die, - receive - {'EXIT', CPid1, died} -> ok; - {'EXIT', CPid1, Reason} -> - ?line test_server:fail({bad_exit_reason, Reason}) - end, - receive - {'EXIT', Pid, _} -> ok - after - 2000 -> ?line test_server:fail(supervisor_alive) - end, - receive - {'EXIT', CPid2, _} -> ok - after - 2000 -> ?line test_server:fail(all_not_terminated) - end, - ok. -%------------------------------------------------------------------------- + + terminate(SupPid, CPid1, child, abnormal), + check_exit([SupPid, CPid2]). + +%%------------------------------------------------------------------------- rest_for_one(doc) -> ["Test the rest_for_one base case."]; rest_for_one(suite) -> []; @@ -1008,70 +807,45 @@ rest_for_one(Config) when is_list(Config) -> worker, []}, Child3 = {child3, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, - ?line {ok, Pid} = start({ok, {{rest_for_one, 2, 3600}, []}}), - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), + {ok, SupPid} = start_link({ok, {{rest_for_one, 2, 3600}, []}}), + {ok, CPid1} = supervisor:start_child(sup_test, Child1), link(CPid1), - ?line {ok, CPid2} = supervisor:start_child(sup_test, Child2), - link(CPid2), - ?line {ok, CPid3} = supervisor:start_child(sup_test, Child3), + {ok, CPid2} = supervisor:start_child(sup_test, Child2), + {ok, CPid3} = supervisor:start_child(sup_test, Child3), link(CPid3), - ?line [3,3,0,3] = get_child_counts(sup_test), + [3,3,0,3] = get_child_counts(sup_test), + + terminate(SupPid, CPid2, child2, abnormal), - CPid2 ! die, - receive - {'EXIT', CPid2, died} -> ok; - {'EXIT', CPid2, Reason} -> - ?line test_server:fail({bad_exit_reason, Reason}) - after 2000 -> - ?line test_server:fail(no_exit) - end, %% Check that Cpid3 did die - receive - {'EXIT', CPid3, _} -> ok - after 2000 -> - ?line test_server:fail(no_exit) - end, - %% Check that Cpid1 didn't die - receive - {'EXIT', CPid1, _} -> - ?line test_server:fail(bad_exit) - after - 100 -> ok - end, + check_exit([CPid3]), + Children = supervisor:which_children(sup_test), - if length(Children) == 3 -> ok; - true -> ?line test_server:fail({bad_child_list, Children}) + is_in_child_list([CPid1], Children), + + if length(Children) == 3 -> + ok; + true -> + test_server:fail({bad_child_list, Children}) end, - ?line [3,3,0,3] = get_child_counts(sup_test), + [3,3,0,3] = get_child_counts(sup_test), %% Test that no old children is still alive - SCh = lists:map(fun({_,P,_,_}) -> P end, Children), - case lists:member(CPid1, SCh) of - true -> ok; - false -> ?line test_server:fail(bad_child) - end, - case lists:member(CPid2, SCh) of - true -> ?line test_server:fail(bad_child); - false -> ok - end, - case lists:member(CPid3, SCh) of - true -> ?line test_server:fail(bad_child); - false -> ok - end, - + Pids = lists:map(fun({_,P,_,_}) -> P end, Children), + not_in_child_list([CPid2, CPid3], Pids), + in_child_list([CPid1], Pids), + %% Test restart frequency property [{child3, Pid3, _, _}|_] = supervisor:which_children(sup_test), - Pid3 ! die, - test_server:sleep(100), + + terminate(SupPid, Pid3, child3, abnormal), + [_,{child2, Pid4, _, _}|_] = supervisor:which_children(sup_test), - Pid4 ! die, - receive - {'EXIT', Pid, _} -> ok - after 3000 -> ?line test_server:fail(restart_failed) - end, - exit(Pid, shutdown). -%------------------------------------------------------------------------- + terminate(SupPid, Pid4, child2, abnormal), + check_exit([SupPid]). + +%%------------------------------------------------------------------------- rest_for_one_escalation(doc) -> ["Test restart escalation on a rest_for_one supervisor."]; rest_for_one_escalation(suite) -> []; @@ -1082,42 +856,29 @@ rest_for_one_escalation(Config) when is_list(Config) -> Child2 = {child2, {supervisor_1, start_child, [error]}, permanent, 1000, worker, []}, - ?line {ok, Pid} = start({ok, {{rest_for_one, 4, 3600}, []}}), - ?line {ok, CPid1} = supervisor:start_child(sup_test, Child1), - link(CPid1), - ?line {ok, CPid2} = supervisor:start_child(sup_test, Child2), + {ok, SupPid} = start_link({ok, {{rest_for_one, 4, 3600}, []}}), + {ok, CPid1} = supervisor:start_child(sup_test, Child1), + {ok, CPid2} = supervisor:start_child(sup_test, Child2), link(CPid2), - CPid1 ! die, - receive - {'EXIT', CPid1, died} -> ok; - {'EXIT', CPid1, Reason} -> - ?line test_server:fail({bad_exit_reason, Reason}) - end, - receive - {'EXIT', CPid2, _} -> ok - after - 2000 -> ?line test_server:fail(not_terminated) - end, - receive - {'EXIT', Pid, _} -> ok - after - 4000 -> ?line test_server:fail(supervisor_alive) - end, - ok. -%------------------------------------------------------------------------- -child_unlink(doc)-> ["Test that the supervisor does not hang forever if " - "the child unliks and then is terminated by the supervisor."]; -child_unlink(suite) -> []; + terminate(SupPid, CPid1, child1, abnormal), + check_exit([CPid2, SupPid]). + +%%------------------------------------------------------------------------- +child_unlink(doc)-> + ["Test that the supervisor does not hang forever if " + "the child unliks and then is terminated by the supervisor."]; +child_unlink(suite) -> + []; child_unlink(Config) when is_list(Config) -> - - ?line {ok, SupPid} = start({ok, {{one_for_one, 2, 3600}, []}}), - + + {ok, SupPid} = start_link({ok, {{one_for_one, 2, 3600}, []}}), + Child = {naughty_child, {naughty_child, start_link, [SupPid]}, permanent, 1000, worker, [supervisor_SUITE]}, - - ?line {ok, _ChildPid} = supervisor:start_child(sup_test, Child), + + {ok, _ChildPid} = supervisor:start_child(sup_test, Child), Pid = spawn(supervisor, terminate_child, [SupPid, naughty_child]), @@ -1130,17 +891,16 @@ child_unlink(Config) when is_list(Config) -> ok; _ -> exit(Pid, kill), - ?line test_server:fail(supervisor_hangs) + test_server:fail(supervisor_hangs) end. -%------------------------------------------------------------------------- - +%%------------------------------------------------------------------------- tree(doc) -> ["Test a basic supervison tree."]; tree(suite) -> []; tree(Config) when is_list(Config) -> process_flag(trap_exit, true), - + Child1 = {child1, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, @@ -1166,109 +926,54 @@ tree(Config) when is_list(Config) -> supervisor, []}, %% Top supervisor - ?line {ok, Pid} = start({ok, {{one_for_all, 4, 3600}, []}}), - + {ok, SupPid} = start_link({ok, {{one_for_all, 4, 3600}, []}}), + %% Child supervisors - ?line {ok, Sup1} = supervisor:start_child(Pid, ChildSup1), - ?line {ok, Sup2} = supervisor:start_child(Pid, ChildSup2), - ?line [2,2,2,0] = get_child_counts(Pid), - + {ok, Sup1} = supervisor:start_child(SupPid, ChildSup1), + {ok, Sup2} = supervisor:start_child(SupPid, ChildSup2), + [2,2,2,0] = get_child_counts(SupPid), + %% Workers - ?line [{_, CPid2, _, _},{_, CPid1, _, _}] = + [{_, CPid2, _, _},{_, CPid1, _, _}] = supervisor:which_children(Sup1), - ?line [2,2,0,2] = get_child_counts(Sup1), - ?line [0,0,0,0] = get_child_counts(Sup2), - + [2,2,0,2] = get_child_counts(Sup1), + [0,0,0,0] = get_child_counts(Sup2), + %% Dynamic children - ?line {ok, CPid3} = supervisor:start_child(Sup2, Child3), - ?line {ok, CPid4} = supervisor:start_child(Sup2, Child4), - ?line [2,2,0,2] = get_child_counts(Sup1), - ?line [2,2,0,2] = get_child_counts(Sup2), - - link(Sup1), - link(Sup2), - link(CPid1), - link(CPid2), - link(CPid3), - link(CPid4), - + {ok, CPid3} = supervisor:start_child(Sup2, Child3), + {ok, CPid4} = supervisor:start_child(Sup2, Child4), + [2,2,0,2] = get_child_counts(Sup1), + [2,2,0,2] = get_child_counts(Sup2), + %% Test that the only the process that dies is restarted - CPid4 ! die, - - receive - {'EXIT', CPid4, _} -> ?line ok - after 10000 -> - ?line test_server:fail(child_was_not_killed) - end, - - test_server:sleep(100), - - ?line [{_, CPid2, _, _},{_, CPid1, _, _}] = + terminate(Sup2, CPid4, child4, abnormal), + + [{_, CPid2, _, _},{_, CPid1, _, _}] = supervisor:which_children(Sup1), - ?line [2,2,0,2] = get_child_counts(Sup1), - - ?line [{_, NewCPid4, _, _},{_, CPid3, _, _}] = + [2,2,0,2] = get_child_counts(Sup1), + + [{_, NewCPid4, _, _},{_, CPid3, _, _}] = supervisor:which_children(Sup2), - ?line [2,2,0,2] = get_child_counts(Sup2), - - link(NewCPid4), + [2,2,0,2] = get_child_counts(Sup2), + + false = NewCPid4 == CPid4, %% Test that supervisor tree is restarted, but not dynamic children. - CPid3 ! die, + terminate(Sup2, CPid3, child3, abnormal), - receive - {'EXIT', CPid3, died} -> ?line ok; - {'EXIT', CPid3, Reason} -> - ?line test_server:fail({bad_exit_reason, Reason}) - after 1000 -> - ?line test_server:fail(child_was_not_killed) - end, + timer:sleep(1000), - test_server:sleep(1000), + [{supchild2, NewSup2, _, _},{supchild1, NewSup1, _, _}] = + supervisor:which_children(SupPid), + [2,2,2,0] = get_child_counts(SupPid), - receive - {'EXIT', NewCPid4, _} -> ?line ok - after 1000 -> - ?line test_server:fail(child_was_not_killed) - end, - - receive - {'EXIT', Sup2, _} -> ?line ok - after 1000 -> - ?line test_server:fail(child_was_not_killed) - end, - - receive - {'EXIT', CPid1, _} -> ?line ok - after 1000 -> - ?line test_server:fail(child_was_not_killed) - end, - - receive - {'EXIT', CPid2, _} -> ?line ok - after 1000 -> - ?line test_server:fail(child_was_not_killed) - end, - - receive - {'EXIT', Sup1, _} -> ?line ok - after 1000 -> - ?line test_server:fail(child_was_not_killed) - end, - - ?line [{supchild2, NewSup2, _, _},{supchild1, NewSup1, _, _}] = - supervisor:which_children(Pid), - ?line [2,2,2,0] = get_child_counts(Pid), - - ?line [{child2, _, _, _},{child1, _, _, _}] = + [{child2, _, _, _},{child1, _, _, _}] = supervisor:which_children(NewSup1), - ?line [2,2,0,2] = get_child_counts(NewSup1), + [2,2,0,2] = get_child_counts(NewSup1), - ?line [] = supervisor:which_children(NewSup2), - ?line [0,0,0,0] = get_child_counts(NewSup2), - - ok. -%------------------------------------------------------------------------- + [] = supervisor:which_children(NewSup2), + [0,0,0,0] = get_child_counts(NewSup2). +%%------------------------------------------------------------------------- count_children_memory(doc) -> ["Test that count_children does not eat memory."]; count_children_memory(suite) -> @@ -1277,7 +982,7 @@ count_children_memory(Config) when is_list(Config) -> process_flag(trap_exit, true), Child = {child, {supervisor_1, start_child, []}, temporary, 1000, worker, []}, - ?line {ok, _Pid} = start({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), + {ok, SupPid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), [supervisor:start_child(sup_test, []) || _Ignore <- lists:seq(1,1000)], garbage_collect(), @@ -1301,12 +1006,12 @@ count_children_memory(Config) when is_list(Config) -> ChildCount3 = get_child_counts(sup_test), Size7 = erlang:memory(processes_used), - ?line 1000 = length(Children), - ?line [1,1000,0,1000] = ChildCount, - ?line 2000 = length(Children2), - ?line [1,2000,0,2000] = ChildCount2, - ?line Children3 = Children2, - ?line ChildCount3 = ChildCount2, + 1000 = length(Children), + [1,1000,0,1000] = ChildCount, + 2000 = length(Children2), + [1,2000,0,2000] = ChildCount2, + Children3 = Children2, + ChildCount3 = ChildCount2, %% count_children consumes memory using an accumulator function, %% but the space can be reclaimed incrementally, @@ -1314,18 +1019,17 @@ count_children_memory(Config) when is_list(Config) -> case (Size5 =< Size4) of true -> ok; false -> - ?line test_server:fail({count_children, used_more_memory}) + test_server:fail({count_children, used_more_memory}) end, case Size7 =< Size6 of true -> ok; false -> - ?line test_server:fail({count_children, used_more_memory}) + test_server:fail({count_children, used_more_memory}) end, - [exit(Pid, kill) || {undefined, Pid, worker, _Modules} <- Children3], - test_server:sleep(100), - ?line [1,0,0,0] = get_child_counts(sup_test), - ok. + [terminate(SupPid, Pid, child, kill) || {undefined, Pid, worker, _Modules} <- Children3], + [1,0,0,0] = get_child_counts(sup_test). + count_children_allocator_test(MemoryState) -> Allocators = [temp_alloc, eheap_alloc, binary_alloc, ets_alloc, driver_alloc, sl_alloc, ll_alloc, fix_alloc, std_alloc, @@ -1336,7 +1040,8 @@ count_children_allocator_test(MemoryState) -> AllocStates = [lists:keyfind(e, 1, AllocValue) || {_Type, AllocValue} <- AllocTypes], lists:all(fun(State) -> State == {e, true} end, AllocStates). -%------------------------------------------------------------------------- + +%%------------------------------------------------------------------------- do_not_save_start_parameters_for_temporary_children(doc) -> ["Temporary children shall not be restarted so they should not " "save start parameters, as it potentially can " @@ -1350,6 +1055,44 @@ do_not_save_start_parameters_for_temporary_children(Config) when is_list(Config) dont_save_start_parameters_for_temporary_children(rest_for_one), dont_save_start_parameters_for_temporary_children(simple_one_for_one). +start_children(_,_, 0) -> + ok; +start_children(Sup, Args, N) -> + Spec = child_spec(Args, N), + {ok, _, _} = supervisor:start_child(Sup, Spec), + start_children(Sup, Args, N-1). + +child_spec([_|_] = SimpleOneForOneArgs, _) -> + SimpleOneForOneArgs; +child_spec({Name, MFA, RestartType, Shutdown, Type, Modules}, N) -> + NewName = list_to_atom((atom_to_list(Name) ++ integer_to_list(N))), + {NewName, MFA, RestartType, Shutdown, Type, Modules}. + +%%------------------------------------------------------------------------- +do_not_save_child_specs_for_temporary_children(doc) -> + ["Temporary children shall not be restarted so supervisors should " + "not save their spec when they terminate"]; +do_not_save_child_specs_for_temporary_children(suite) -> + []; +do_not_save_child_specs_for_temporary_children(Config) when is_list(Config) -> + process_flag(trap_exit, true), + dont_save_child_specs_for_temporary_children(one_for_all, kill), + dont_save_child_specs_for_temporary_children(one_for_one, kill), + dont_save_child_specs_for_temporary_children(rest_for_one, kill), + + dont_save_child_specs_for_temporary_children(one_for_all, normal), + dont_save_child_specs_for_temporary_children(one_for_one, normal), + dont_save_child_specs_for_temporary_children(rest_for_one, normal), + + dont_save_child_specs_for_temporary_children(one_for_all, abnormal), + dont_save_child_specs_for_temporary_children(one_for_one, abnormal), + dont_save_child_specs_for_temporary_children(rest_for_one, abnormal), + + dont_save_child_specs_for_temporary_children(one_for_all, supervisor), + dont_save_child_specs_for_temporary_children(one_for_one, supervisor), + dont_save_child_specs_for_temporary_children(rest_for_one, supervisor). + +%%------------------------------------------------------------------------- dont_save_start_parameters_for_temporary_children(simple_one_for_one = Type) -> Permanent = {child, {supervisor_1, start_child, []}, permanent, 1000, worker, []}, @@ -1373,9 +1116,9 @@ dont_save_start_parameters_for_temporary_children(simple_one_for_one = Type) -> true = (Mem3 < Mem1) and (Mem3 < Mem2), - exit(Sup1, shutdown), - exit(Sup2, shutdown), - exit(Sup3, shutdown); + terminate(Sup1, shutdown), + terminate(Sup2, shutdown), + terminate(Sup3, shutdown); dont_save_start_parameters_for_temporary_children(Type) -> {ok, Sup1} = supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, []}}), @@ -1401,19 +1144,139 @@ dont_save_start_parameters_for_temporary_children(Type) -> true = (Mem3 < Mem1) and (Mem3 < Mem2), - exit(Sup1, shutdown), - exit(Sup2, shutdown), - exit(Sup3, shutdown). + terminate(Sup1, shutdown), + terminate(Sup2, shutdown), + terminate(Sup3, shutdown). -start_children(_,_, 0) -> +dont_save_child_specs_for_temporary_children(Type, TerminateHow)-> + {ok, Sup} = + supervisor:start_link(?MODULE, {ok, {{Type, 2, 3600}, []}}), + + Permanent = {child1, {supervisor_1, start_child, []}, + permanent, 1000, worker, []}, + Transient = {child2, {supervisor_1, start_child, []}, + transient, 1000, worker, []}, + Temporary = {child3, {supervisor_1, start_child, []}, + temporary, 1000, worker, []}, + + permanent_child_spec_saved(Permanent, Sup, TerminateHow), + + transient_child_spec_saved(Transient, Sup, TerminateHow), + + temporary_child_spec_not_saved(Temporary, Sup, TerminateHow), + + terminate(Sup, shutdown). + +permanent_child_spec_saved(ChildSpec, Sup, supervisor = TerminateHow) -> + already_present(Sup, ChildSpec, TerminateHow); + +permanent_child_spec_saved(ChildSpec, Sup, TerminateHow) -> + restarted(Sup, ChildSpec, TerminateHow). + +transient_child_spec_saved(ChildSpec, Sup, supervisor = TerminateHow) -> + already_present(Sup, ChildSpec, TerminateHow); + +transient_child_spec_saved(ChildSpec, Sup, normal = TerminateHow) -> + already_present(Sup, ChildSpec, TerminateHow); + +transient_child_spec_saved(ChildSpec, Sup, TerminateHow) -> + restarted(Sup, ChildSpec, TerminateHow). + +temporary_child_spec_not_saved({Id, _,_,_,_,_} = ChildSpec, Sup, TerminateHow) -> + {ok, Pid} = supervisor:start_child(Sup, ChildSpec), + terminate(Sup, Pid, Id, TerminateHow), + {ok, _} = supervisor:start_child(Sup, ChildSpec). + +already_present(Sup, {Id,_,_,_,_,_} = ChildSpec, TerminateHow) -> + {ok, Pid} = supervisor:start_child(Sup, ChildSpec), + terminate(Sup, Pid, Id, TerminateHow), + {error, already_present} = supervisor:start_child(Sup, ChildSpec), + {ok, _} = supervisor:restart_child(Sup, Id). + +restarted(Sup, {Id,_,_,_,_,_} = ChildSpec, TerminateHow) -> + {ok, Pid} = supervisor:start_child(Sup, ChildSpec), + terminate(Sup, Pid, Id, TerminateHow), + %% Permanent processes will be restarted by the supervisor + %% when not terminated by api + {error, {already_started, _}} = supervisor:start_child(Sup, ChildSpec). + + +terminate(Pid, Reason) when Reason =/= supervisor -> + terminate(dummy, Pid, dummy, Reason). + +terminate(Sup, _, ChildId, supervisor) -> + ok = supervisor:terminate_child(Sup, ChildId); +terminate(_, ChildPid, _, kill) -> + Ref = erlang:monitor(process, ChildPid), + exit(ChildPid, kill), + receive + {'DOWN', Ref, process, ChildPid, killed} -> + ok + end; +terminate(_, ChildPid, _, shutdown) -> + Ref = erlang:monitor(process, ChildPid), + exit(ChildPid, shutdown), + receive + {'DOWN', Ref, process, ChildPid, shutdown} -> + ok + end; +terminate(_, ChildPid, _, normal) -> + Ref = erlang:monitor(process, ChildPid), + ChildPid ! stop, + receive + {'DOWN', Ref, process, ChildPid, normal} -> + ok + end; +terminate(_, ChildPid, _,abnormal) -> + Ref = erlang:monitor(process, ChildPid), + ChildPid ! die, + receive + {'DOWN', Ref, process, ChildPid, died} -> + ok + end. + +in_child_list([], _) -> + true; +in_child_list([Pid | Rest], Pids) -> + case is_in_child_list(Pid, Pids) of + true -> + in_child_list(Rest, Pids); + false -> + test_server:fail(child_should_be_alive) + end. +not_in_child_list([], _) -> + true; +not_in_child_list([Pid | Rest], Pids) -> + case is_in_child_list(Pid, Pids) of + true -> + test_server:fail(child_should_not_be_alive); + false -> + not_in_child_list(Rest, Pids) + end. + +is_in_child_list(Pid, ChildPids) -> + lists:member(Pid, ChildPids). + +check_exit([]) -> ok; -start_children(Sup, Args, N) -> - Spec = child_spec(Args, N), - {ok, _, _} = supervisor:start_child(Sup, Spec), - start_children(Sup, Args, N-1). +check_exit([Pid | Pids]) -> + receive + {'EXIT', Pid, _} -> + check_exit(Pids) + end. -child_spec([_|_] = SimpleOneForOneArgs, _) -> - SimpleOneForOneArgs; -child_spec({Name, MFA, RestartType, Shutdown, Type, Modules}, N) -> - NewName = list_to_atom((atom_to_list(Name) ++ integer_to_list(N))), - {NewName, MFA, RestartType, Shutdown, Type, Modules}. +check_exit_reason(Reason) -> + receive + {'EXIT', _, Reason} -> + ok; + {'EXIT', _, Else} -> + test_server:fail({bad_exit_reason, Else}) + end. + +check_exit_reason(Pid, Reason) -> + receive + {'EXIT', Pid, Reason} -> + ok; + {'EXIT', Pid, Else} -> + test_server:fail({bad_exit_reason, Else}) + end. diff --git a/lib/syntax_tools/src/erl_recomment.erl b/lib/syntax_tools/src/erl_recomment.erl index 919e9cfc5d..fc7c515700 100644 --- a/lib/syntax_tools/src/erl_recomment.erl +++ b/lib/syntax_tools/src/erl_recomment.erl @@ -163,7 +163,7 @@ recomment_forms_2(C, [N | Ns] = Nodes, Insert) -> Trailing = case Ns of [] -> true; - [Next | _] -> L < node_min(Next) - 2 + [Next | _] -> L + Delta < node_min(Next) - 2 end, if L > Max + 1 ; L =:= Max + 1, not Trailing -> [N | recomment_forms_2(C, Ns, Insert)]; diff --git a/lib/syntax_tools/test/Makefile b/lib/syntax_tools/test/Makefile index e793dec566..3e31bdbd50 100644 --- a/lib/syntax_tools/test/Makefile +++ b/lib/syntax_tools/test/Makefile @@ -60,6 +60,6 @@ release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(RELSYSDIR) $(INSTALL_DATA) syntax_tools.spec syntax_tools.cover $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) release_docs_spec: diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl index 7f0011bd68..591329b361 100644 --- a/lib/test_server/src/test_server.erl +++ b/lib/test_server/src/test_server.erl @@ -36,7 +36,7 @@ -export([capture_start/0,capture_stop/0,capture_get/0]). -export([messages_get/0]). -export([hours/1,minutes/1,seconds/1,sleep/1,adjusted_sleep/1,timecall/3]). --export([timetrap_scale_factor/0,timetrap/1,timetrap_cancel/1]). +-export([timetrap_scale_factor/0,timetrap/1,timetrap_cancel/1,timetrap_cancel/0]). -export([m_out_of_n/3,do_times/4,do_times/2]). -export([call_crash/3,call_crash/4,call_crash/5]). -export([temp_name/1]). @@ -1077,7 +1077,7 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, {{Time,Value},Loc,Opts} = case test_server_sup:framework_call(init_tc,[?pl2a(Mod),Func,Args0], - {ok, Args0}) of + {ok,Args0}) of {ok,Args} -> run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback); Error = {error,_Reason} -> @@ -1085,18 +1085,17 @@ run_test_case_eval(Mod, Func, Args0, Name, Ref, RunInit, {skip,{failed,Error}}), {{0,NewResult},{Mod,Func},[]}; {fail,Reason} -> - [Conf] = Args0, - Conf1 = [{tc_status,{failed,Reason}} | Conf], + Conf = [{tc_status,{failed,Reason}} | hd(Args0)], fw_error_notify(Mod, Func, Conf, Reason), - NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf1]}, - {fail, Reason}), + NewResult = do_end_tc_call(Mod,Func, {{error,Reason},[Conf]}, + {fail,Reason}), {{0,NewResult},{Mod,Func},[]}; Skip = {skip,_Reason} -> NewResult = do_end_tc_call(Mod,Func,{Skip,Args0},Skip), {{0,NewResult},{Mod,Func},[]}; {auto_skip,Reason} -> NewResult = do_end_tc_call(Mod, Func, {{skip,Reason},Args0}, - {skip, {fw_auto_skip,Reason}}), + {skip,{fw_auto_skip,Reason}}), {{0,NewResult},{Mod,Func},[]} end, exit({Ref,Time,Value,Loc,Opts}). @@ -1116,9 +1115,15 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> {skip_and_save,Reason,SaveCfg} -> Line = get_loc(), Conf = [{tc_status,{skipped,Reason}},{save_config,SaveCfg}], - NewRes = do_end_tc_call(Mod, Func, {{skip, Reason}, [Conf]}, + NewRes = do_end_tc_call(Mod, Func, {{skip,Reason},[Conf]}, {skip, Reason}), {{0,NewRes},Line,[]}; + FailTC = {fail,Reason} -> % user fails the testcase + EndConf = [{tc_status,{failed,Reason}} | hd(Args)], + fw_error_notify(Mod, Func, EndConf, Reason), + NewRes = do_end_tc_call(Mod, Func, {{error,Reason},[EndConf]}, + FailTC), + {{0,NewRes},{Mod,Func},[]}; {ok,NewConf} -> put(test_server_init_or_end_conf,undefined), %% call user callback function if defined @@ -1153,8 +1158,9 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> {FWReturn1,TSReturn1,EndConf2} = case end_per_testcase(Mod, Func, EndConf1) of SaveCfg1={save_config,_} -> - {FWReturn,TSReturn,[SaveCfg1|lists:keydelete(save_config, 1, EndConf1)]}; - {fail,ReasonToFail} -> % user has failed the testcase + {FWReturn,TSReturn,[SaveCfg1|lists:keydelete(save_config,1, + EndConf1)]}; + {fail,ReasonToFail} -> % user has failed the testcase fw_error_notify(Mod, Func, EndConf1, ReasonToFail), {{error,ReasonToFail},{failed,ReasonToFail},EndConf1}; {failed,{_,end_per_testcase,_}} = Failure -> % unexpected termination @@ -1193,11 +1199,10 @@ run_test_case_eval1(Mod, Func, Args, Name, RunInit, TCCallback) -> do_end_tc_call(M,F,Res,Return) -> Ref = make_ref(), - case test_server_sup:framework_call( - end_tc, [?pl2a(M),F,Res], Ref) of - {fail,FWReason} -> - {failed,FWReason}; - Ref -> + case os:getenv("TEST_SERVER_FRAMEWORK") of + FW when FW == "ct_framework"; + FW == "undefined"; + FW == false -> case test_server_sup:framework_call( end_tc, [?pl2a(M),F,Res, Return], ok) of {fail,FWReason} -> @@ -1212,8 +1217,14 @@ do_end_tc_call(M,F,Res,Return) -> NewReturn -> NewReturn end; - _ -> - Return + Other -> + case test_server_sup:framework_call( + end_tc, [Other,F,Res], Ref) of + {fail,FWReason} -> + {failed,FWReason}; + _Else -> + Return + end end. %% the return value is a list and we have to check if it contains @@ -1296,7 +1307,7 @@ init_per_testcase(Mod, Func, Args) -> false -> code:load_file(Mod); _ -> ok end, -%% init_per_testcase defined, returns new configuration + %% init_per_testcase defined, returns new configuration case erlang:function_exported(Mod,init_per_testcase,2) of true -> case catch my_apply(Mod, init_per_testcase, [Func|Args]) of @@ -1316,6 +1327,8 @@ init_per_testcase(Mod, Func, Args) -> "bad elements in Config: ~p\n",[Bad]}, {skip,{failed,{Mod,init_per_testcase,bad_return}}} end; + {'$test_server_ok',Res={fail,_Reason}} -> + Res; {'$test_server_ok',_Other} -> group_leader() ! {printout,12, "ERROR! init_per_testcase did not return " @@ -1690,7 +1703,7 @@ fail() -> break(Comment) -> case erase(test_server_timetraps) of undefined -> ok; - List -> lists:foreach(fun(Ref) -> timetrap_cancel(Ref) end,List) + List -> lists:foreach(fun({Ref,_}) -> timetrap_cancel(Ref) end, List) end, io:format(user, "\n\n\n--- SEMIAUTOMATIC TESTING ---" @@ -1771,14 +1784,16 @@ timetrap(Timeout0) -> {undefined,false} -> timetrap1(Timeout, false); {undefined,_} -> timetrap1(Timeout, true); {infinity,_} -> infinity; + {_Int,_Scale} when Timeout == infinity -> infinity; {Int,Scale} -> timetrap1(Timeout*Int, Scale) end. timetrap1(Timeout, Scale) -> - Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,self()]), + TCPid = self(), + Ref = spawn_link(test_server_sup,timetrap,[Timeout,Scale,TCPid]), case get(test_server_timetraps) of - undefined -> put(test_server_timetraps,[Ref]); - List -> put(test_server_timetraps,[Ref|List]) + undefined -> put(test_server_timetraps,[{Ref,TCPid}]); + List -> put(test_server_timetraps,[{Ref,TCPid}|List]) end, Ref. @@ -1791,14 +1806,16 @@ ensure_timetrap(Config) -> undefined -> ok; Garbage -> erase(test_server_default_timetrap), - format("=== WARNING: garbage in test_server_default_timetrap: ~p~n", + format("=== WARNING: garbage in " + "test_server_default_timetrap: ~p~n", [Garbage]) end, DTmo = case lists:keysearch(default_timeout,1,Config) of {value,{default_timeout,Tmo}} -> Tmo; _ -> ?DEFAULT_TIMETRAP_SECS end, - format("=== test_server setting default timetrap of ~p seconds~n", + format("=== test_server setting default " + "timetrap of ~p seconds~n", [DTmo]), put(test_server_default_timetrap, timetrap(seconds(DTmo))) end. @@ -1810,11 +1827,13 @@ cancel_default_timetrap() -> TimeTrap when is_pid(TimeTrap) -> timetrap_cancel(TimeTrap), erase(test_server_default_timetrap), - format("=== test_server canceled default timetrap since another timetrap was set~n"), + format("=== test_server canceled default timetrap " + "since another timetrap was set~n"), ok; Garbage -> erase(test_server_default_timetrap), - format("=== WARNING: garbage in test_server_default_timetrap: ~p~n", + format("=== WARNING: garbage in " + "test_server_default_timetrap: ~p~n", [Garbage]), error end. @@ -1828,6 +1847,7 @@ time_ms({Other,_N}) -> "Should be seconds, minutes, or hours.~n", [Other]), exit({invalid_time_spec,Other}); time_ms(Ms) when is_integer(Ms) -> Ms; +time_ms(infinity) -> infinity; time_ms(Other) -> exit({invalid_time_spec,Other}). @@ -1841,11 +1861,29 @@ timetrap_cancel(infinity) -> timetrap_cancel(Handle) -> case get(test_server_timetraps) of undefined -> ok; - [Handle] -> erase(test_server_timetraps); - List -> put(test_server_timetraps,lists:delete(Handle,List)) + [{Handle,_}] -> erase(test_server_timetraps); + Timers -> put(test_server_timetraps, + lists:keydelete(Handle, 1, Timers)) end, test_server_sup:timetrap_cancel(Handle). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% timetrap_cancel() -> ok +%% +%% Cancels timetrap for current test case. +timetrap_cancel() -> + case get(test_server_timetraps) of + undefined -> + ok; + Timers -> + case lists:keysearch(self(), 2, Timers) of + {value,{Handle,_}} -> + timetrap_cancel(Handle); + _ -> + ok + end + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% hours(N) -> Milliseconds %% minutes(N) -> Milliseconds diff --git a/lib/test_server/src/test_server_ctrl.erl b/lib/test_server/src/test_server_ctrl.erl index 30d7314058..de9b962dfc 100644 --- a/lib/test_server/src/test_server_ctrl.erl +++ b/lib/test_server/src/test_server_ctrl.erl @@ -1812,6 +1812,9 @@ start_log_file() -> ok = file:make_dir(PrivDir), put(test_server_priv_dir,PrivDir++"/"), print_timestamp(13,"Suite started at "), + + LogInfo = [{topdir,Dir},{rundir,lists:flatten(TestDir)}], + test_server_sup:framework_call(report, [loginfo,LogInfo]), ok. make_html_link(LinkName, Target, Explanation) -> @@ -1925,7 +1928,6 @@ html_convert_modules(TestSpec, _Config) -> copy_html_files(get(test_server_dir), get(test_server_log_dir_base)). %% Retrieve a list of modules out of the test spec. - html_isolate_modules(List) -> html_isolate_modules(List, sets:new()). html_isolate_modules([], Set) -> sets:to_list(Set); @@ -1939,37 +1941,56 @@ html_isolate_modules([{Mod,_Case,_Args}|Cases], Set) -> html_isolate_modules(Cases, sets:add_element(Mod, Set)). %% Given a list of modules, convert each module's source code to HTML. - html_convert_modules([Mod|Mods]) -> case code:which(Mod) of Path when is_list(Path) -> SrcFile = filename:rootname(Path) ++ ".erl", - DestDir = get(test_server_dir), - Name = atom_to_list(Mod), - DestFile = filename:join(DestDir, downcase(Name) ++ ?src_listing_ext), - html_possibly_convert(SrcFile, DestFile), - html_convert_modules(Mods); - _Other -> ok + FoundSrcFile = + case file:read_file_info(SrcFile) of + {ok,SInfo} -> + {SrcFile,SInfo}; + {error,_} -> + ModInfo = Mod:module_info(compile), + case proplists:get_value(source, ModInfo) of + undefined -> + undefined; + OtherSrcFile -> + case file:read_file_info(OtherSrcFile) of + {ok,SInfo} -> + {OtherSrcFile,SInfo}; + {error,_} -> + undefined + end + end + end, + case FoundSrcFile of + undefined -> + html_convert_modules(Mods); + {SrcFile1,SrcFileInfo} -> + DestDir = get(test_server_dir), + Name = atom_to_list(Mod), + DestFile = filename:join(DestDir, + downcase(Name)++?src_listing_ext), + html_possibly_convert(SrcFile1, SrcFileInfo, DestFile), + html_convert_modules(Mods) + end; + _Other -> + html_convert_modules(Mods) end; html_convert_modules([]) -> ok. %% Convert source code to HTML if possible and needed. - -html_possibly_convert(Src, Dest) -> - case file:read_file_info(Src) of - {ok,SInfo} -> - case file:read_file_info(Dest) of - {error,_Reason} -> % no dest file - erl2html2:convert(Src, Dest); - {ok,DInfo} when DInfo#file_info.mtime < SInfo#file_info.mtime -> - erl2html2:convert(Src, Dest); - {ok,_DInfo} -> ok % dest file up to date - end; - {error,_Reason} -> ok % no source code found +html_possibly_convert(Src, SrcInfo, Dest) -> + case file:read_file_info(Dest) of + {error,_Reason} -> % no dest file + erl2html2:convert(Src, Dest); + {ok,DestInfo} when DestInfo#file_info.mtime < SrcInfo#file_info.mtime -> + erl2html2:convert(Src, Dest); + {ok,_DestInfo} -> + ok % dest file up to date end. %% Copy all HTML files in InDir to OutDir. - copy_html_files(InDir, OutDir) -> Files = filelib:wildcard(filename:join(InDir, "*" ++ ?src_listing_ext)), lists:foreach(fun (Src) -> copy_html_file(Src, OutDir) end, Files). diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl index 1a614d74d5..53dfb45e3a 100644 --- a/lib/test_server/src/test_server_sup.erl +++ b/lib/test_server/src/test_server_sup.erl @@ -83,13 +83,13 @@ timetrap(Timeout0, Scale, Pid) -> %% Handle = term() %% %% Cancels a time trap. - timetrap_cancel(Handle) -> unlink(Handle), MonRef = erlang:monitor(process, Handle), exit(Handle, kill), receive {'DOWN',MonRef,_,_,_} -> ok after 2000 -> ok end. + capture_get(Msgs) -> receive {captured,Msg} -> diff --git a/lib/test_server/src/ts_install.erl b/lib/test_server/src/ts_install.erl index 2ddffccf5b..8332ccfb40 100644 --- a/lib/test_server/src/ts_install.erl +++ b/lib/test_server/src/ts_install.erl @@ -22,6 +22,7 @@ -export([install/2, platform_id/1]). -include("ts.hrl"). +-include_lib("kernel/include/file.hrl"). install(install_local, Options) -> install(os:type(), Options); @@ -150,11 +151,17 @@ add_vars(Vars0, Opts0) -> end, {PlatformId, PlatformLabel, PlatformFilename, Version} = platform([{longnames, LongNames}|Vars0]), + NetDir = lists:concat(["/net", hostname()]), + Mounted = case file:read_file_info(NetDir) of + {ok, #file_info{type = directory}} -> NetDir; + _ -> "" + end, {Opts, [{longnames, LongNames}, {platform_id, PlatformId}, {platform_filename, PlatformFilename}, {rsh_name, get_rsh_name()}, {platform_label, PlatformLabel}, + {ts_net_dir, Mounted}, {erl_flags, []}, {erl_release, Version}, {ts_testcase_callback, get_testcase_callback()} | Vars0]}. diff --git a/lib/test_server/src/ts_run.erl b/lib/test_server/src/ts_run.erl index 067961a216..d145290820 100644 --- a/lib/test_server/src/ts_run.erl +++ b/lib/test_server/src/ts_run.erl @@ -212,6 +212,12 @@ make_command(Vars, Spec, State) -> false -> ok end, + + %% If Common Test specific variables are needed, add them here + %% on form: "{key1,value1}" "{key2,value2}" ... + NetDir = ts_lib:var(ts_net_dir, Vars), + TestVars = [ "\"{net_dir,\\\"",NetDir,"\\\"}\"" ], + %% NOTE: Do not use ' in these commands as it wont work on windows Cmd = [Erl, Naming, "test_server" " -rsh ", ts_lib:var(rsh_name, Vars), @@ -224,6 +230,7 @@ make_command(Vars, Spec, State) -> %% " -test_server_format_exception false", " -boot start_sasl -sasl errlog_type error", " -pz ",Cwd, + " -ct_test_vars ",TestVars, " -eval \"file:set_cwd(\\\"",TestDir,"\\\")\" " " -eval \"ct:run_test(", backslashify(lists:flatten(State#state.test_server_args)),")\"" @@ -369,7 +376,6 @@ make_common_test_args(Args0, Options, _Vars) -> end, ConfigFiles = [{config,[filename:join(ConfigPath,File) || File <- get_config_files()]}], - io_lib:format("~100000p",[Args0++Trace++Cover++Logdir++ ConfigFiles++Options]). diff --git a/lib/test_server/test/Makefile b/lib/test_server/test/Makefile index 34c55c595d..ab72a9d579 100644 --- a/lib/test_server/test/Makefile +++ b/lib/test_server/test/Makefile @@ -86,7 +86,7 @@ release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(EMAKEFILE) $(ERL_FILES) $(COVERFILE) $(RELSYSDIR) $(INSTALL_DATA) test_server.spec test_server.cover $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/tools/emacs/erlang.el b/lib/tools/emacs/erlang.el index e1c0d31371..6728bef2a4 100644 --- a/lib/tools/emacs/erlang.el +++ b/lib/tools/emacs/erlang.el @@ -386,7 +386,8 @@ then no prototype is inserted. The test is performed by the function `erlang-test-criteria-list'.") (defvar erlang-electric-arrow-criteria - '(erlang-next-lines-empty-p + '(erlang-stop-when-in-type-spec + erlang-next-lines-empty-p erlang-at-end-of-function-p) "*List of functions controlling the arrow aspect of `erlang-electric-gt'. The functions in this list are called, in order, whenever a `>' @@ -4045,6 +4046,16 @@ This function is designed to be a member of a criteria list." nil))) +(defun erlang-stop-when-in-type-spec () + "Return `stop' when in a type spec line. + +This function is designed to be a member of a criteria list." + (save-excursion + (beginning-of-line) + (when (save-match-data (looking-at "-\\(spec\\|type\\)")) + 'stop))) + + (defun erlang-next-lines-empty-p () "Return non-nil if next lines are empty. diff --git a/lib/tools/src/cover.erl b/lib/tools/src/cover.erl index 230f0e9428..73a736f0e8 100644 --- a/lib/tools/src/cover.erl +++ b/lib/tools/src/cover.erl @@ -253,6 +253,7 @@ compile_modules(Files,Options) -> {i, Dir} when is_list(Dir) -> true; {d, _Macro} -> true; {d, _Macro, _Value} -> true; + export_all -> true; _ -> false end end, @@ -625,7 +626,7 @@ main_process_loop(State) -> case get_beam_file(Module,BeamFile0,Compiled0) of {ok,BeamFile} -> {Reply,Compiled} = - case do_compile_beam(Module,BeamFile) of + case do_compile_beam(Module,BeamFile,[]) of {ok, Module} -> remote_load_compiled(State#main_state.nodes, [{Module,BeamFile}]), @@ -1258,13 +1259,13 @@ do_compile(File, UserOptions) -> Options = [debug_info,binary,report_errors,report_warnings] ++ UserOptions, case compile:file(File, Options) of {ok, Module, Binary} -> - do_compile_beam(Module,Binary); + do_compile_beam(Module,Binary,UserOptions); error -> error end. %% Beam is a binary or a .beam file name -do_compile_beam(Module,Beam) -> +do_compile_beam(Module,Beam,UserOptions) -> %% Clear database do_clear(Module), @@ -1284,7 +1285,7 @@ do_compile_beam(Module,Beam) -> %% Compile and load the result %% It's necessary to check the result of loading since it may %% fail, for example if Module resides in a sticky directory - {ok, Module, Binary} = compile:forms(Forms, []), + {ok, Module, Binary} = compile:forms(Forms, UserOptions), case code:load_binary(Module, ?TAG, Binary) of {module, Module} -> diff --git a/lib/tools/src/make.erl b/lib/tools/src/make.erl index 77c354651b..e78e2a43a4 100644 --- a/lib/tools/src/make.erl +++ b/lib/tools/src/make.erl @@ -222,12 +222,7 @@ recompilep(File, NoExec, Load, Opts) -> recompilep1(File, NoExec, Load, Opts, ObjFile) -> {ok, Erl} = file:read_file_info(lists:append(File, ".erl")), {ok, Obj} = file:read_file_info(ObjFile), - case {readable(Erl), writable(Obj)} of - {true, true} -> - recompilep1(Erl, Obj, File, NoExec, Load, Opts); - _ -> - error - end. + recompilep1(Erl, Obj, File, NoExec, Load, Opts). recompilep1(#file_info{mtime=Te}, #file_info{mtime=To}, File, NoExec, Load, Opts) when Te>To -> @@ -277,14 +272,6 @@ exists(File) -> false end. -readable(#file_info{access=read_write}) -> true; -readable(#file_info{access=read}) -> true; -readable(_) -> false. - -writable(#file_info{access=read_write}) -> true; -writable(#file_info{access=write}) -> true; -writable(_) -> false. - coerce_2_list(X) when is_atom(X) -> atom_to_list(X); coerce_2_list(X) -> diff --git a/lib/tools/test/Makefile b/lib/tools/test/Makefile index 63f96520fd..8019b7269f 100644 --- a/lib/tools/test/Makefile +++ b/lib/tools/test/Makefile @@ -87,7 +87,7 @@ release_tests_spec: make_emakefile $(INSTALL_DIR) $(RELSYSDIR) $(INSTALL_DATA) $(SPEC_FILES) $(COVER_FILE) $(EMAKEFILE) \ $(ERL_FILES) $(RELSYSDIR) - chmod -f -R u+w $(RELSYSDIR) + chmod -R u+w $(RELSYSDIR) @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) release_docs_spec: diff --git a/lib/typer/src/typer.erl b/lib/typer/src/typer.erl index fc8caa4f21..e40c4f39cd 100644 --- a/lib/typer/src/typer.erl +++ b/lib/typer/src/typer.erl @@ -628,6 +628,8 @@ cl(["-T"|Opts]) -> cl(["-r"|Opts]) -> {Files, RestOpts} = dialyzer_cl_parse:collect_args(Opts), {{files_r, Files}, RestOpts}; +cl(["-pa",Dir|Opts]) -> {{pa,Dir}, Opts}; +cl(["-pz",Dir|Opts]) -> {{pz,Dir}, Opts}; cl(["-"++H|_]) -> fatal_error("unknown option -"++H); cl(Opts) -> {Files, RestOpts} = dialyzer_cl_parse:collect_args(Opts), @@ -672,7 +674,13 @@ analyze_result({plt, Plt}, Args, Analysis) -> analyze_result(show_succ, Args, Analysis) -> {Args, Analysis#analysis{show_succ = true}}; analyze_result(no_spec, Args, Analysis) -> - {Args, Analysis#analysis{no_spec = true}}. + {Args, Analysis#analysis{no_spec = true}}; +analyze_result({pa, Dir}, Args, Analysis) -> + code:add_patha(Dir), + {Args, Analysis}; +analyze_result({pz, Dir}, Args, Analysis) -> + code:add_pathz(Dir), + {Args, Analysis}. %%-------------------------------------------------------------------- %% File processing. @@ -1009,7 +1017,8 @@ version_message() -> help_message() -> S = <<" Usage: typer [--help] [--version] [--plt PLT] [--edoc] [--show | --show-exported | --annotate | --annotate-inc-files] - [-Ddefine]* [-I include_dir]* [-T application]* [-r] file* + [-Ddefine]* [-I include_dir]* [-pa dir]* [-pz dir]* + [-T application]* [-r] file* Options: -r dir* @@ -1039,6 +1048,10 @@ help_message() -> -I include_dir pass the include_dir to TypEr (The syntax of includes is the same as that used by \"erlc\".) + -pa dir + -pz dir + Set code path options to TypEr + (This is useful for files that use parse tranforms.) --version (or -v) prints the Typer version and exits --help (or -h) diff --git a/lib/webtool/doc/src/webtool_chapter.xml b/lib/webtool/doc/src/webtool_chapter.xml index f72a255b0a..305fbcb8ee 100644 --- a/lib/webtool/doc/src/webtool_chapter.xml +++ b/lib/webtool/doc/src/webtool_chapter.xml @@ -151,7 +151,7 @@ http://Servername:Port/ErlScriptAlias/Mod/Func<?QueryString> ]]></code> <p>An <c>alias</c> parameter in the configuration function can be an ErlScriptAlias as used in the above URL. The definition of - an ErlScripAlias shall be like this:</p> + an ErlScriptAlias shall be like this:</p> <p><c>{alias,{erl_alias,Path,[Modules]}}</c>, e.g.</p> <p><c>{alias,{erl_alias,"/testtool",[helloworld]}}</c></p> <p>The following URL will then cause a call to the function @@ -184,7 +184,7 @@ http://Servername:Port/ErlScriptAlias/Mod/Func<?QueryString> ]]></code> directory <c>/usr/local/otp/lib/myapp-1.0/priv</c>:</p> <p><c>{alias,{"/mytool_home","/usr/local/otp/lib/myapp-1.0/priv"}}</c></p> <p>See the INETS documentation, especially the module - <c>mod_esi</c>, for a more in depht coverage of Erl Scheme.</p> + <c>mod_esi</c>, for a more in depth coverage of the Erl Scheme.</p> </section> <section> diff --git a/lib/xmerl/src/xmerl_xpath.erl b/lib/xmerl/src/xmerl_xpath.erl index e654a8ef1d..c803af3631 100644 --- a/lib/xmerl/src/xmerl_xpath.erl +++ b/lib/xmerl/src/xmerl_xpath.erl @@ -19,8 +19,8 @@ %% Description : Implements a search engine based on XPath -%% @doc The xmerl_xpath module handles the entire XPath 1.0 spec -%% XPath expressions typically occurs in XML attributes and are used to addres +%% @doc The xmerl_xpath module handles the entire XPath 1.0 spec. +%% XPath expressions typically occur in XML attributes and are used to address %% parts of an XML document. % The grammar is defined in <code>xmerl_xpath_parse.yrl</code>. % The core functions are defined in <code>xmerl_xpath_pred.erl</code>. |