diff options
Diffstat (limited to 'lib/stdlib/test')
26 files changed, 633 insertions, 264 deletions
diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile index 5502c69fa5..aa6a660c34 100644 --- a/lib/stdlib/test/Makefile +++ b/lib/stdlib/test/Makefile @@ -65,6 +65,7 @@ MODULES= \ stdlib_SUITE \ string_SUITE \ supervisor_1 \ + supervisor_2 \ naughty_child \ shell_SUITE \ supervisor_SUITE \ diff --git a/lib/stdlib/test/beam_lib_SUITE.erl b/lib/stdlib/test/beam_lib_SUITE.erl index 4ccc863795..5df19ca7f1 100644 --- a/lib/stdlib/test/beam_lib_SUITE.erl +++ b/lib/stdlib/test/beam_lib_SUITE.erl @@ -181,7 +181,8 @@ error(Conf) when is_list(Conf) -> ?line verify(not_a_beam_file, beam_lib:info(<<"short">>)), ?line {Binary1, _} = split_binary(Binary, byte_size(Binary)-10), - ?line verify(chunk_too_big, beam_lib:chunks(Binary1, ["Abst"])), + LastChunk = last_chunk(Binary), + ?line verify(chunk_too_big, beam_lib:chunks(Binary1, [LastChunk])), ?line Chunks = chunk_info(Binary), ?line {value, {_, AbstractStart, _}} = lists:keysearch("Abst", 1, Chunks), ?line {Binary2, _} = split_binary(Binary, AbstractStart), @@ -205,6 +206,12 @@ error(Conf) when is_list(Conf) -> ?line file:delete(ACopy), ok. +last_chunk(Bin) -> + L = beam_lib:info(Bin), + {chunks,Chunks} = lists:keyfind(chunks, 1, L), + {Last,_,_} = lists:last(Chunks), + Last. + do_error(BeamFile, ACopy) -> % evil tests ?line Chunks = chunk_info(BeamFile), @@ -242,8 +249,8 @@ cmp(doc) -> ["Compare contents of BEAM files and directories"]; cmp(Conf) when is_list(Conf) -> ?line PrivDir = ?privdir, - ?line Dir1 = filename:join(PrivDir, dir1), - ?line Dir2 = filename:join(PrivDir, dir2), + ?line Dir1 = filename:join(PrivDir, "dir1"), + ?line Dir2 = filename:join(PrivDir, "dir2"), ok = file:make_dir(Dir1), ok = file:make_dir(Dir2), @@ -292,8 +299,8 @@ cmp_literals(doc) -> ["Compare contents of BEAM files having literals"]; cmp_literals(Conf) when is_list(Conf) -> ?line PrivDir = ?privdir, - ?line Dir1 = filename:join(PrivDir, dir1), - ?line Dir2 = filename:join(PrivDir, dir2), + ?line Dir1 = filename:join(PrivDir, "dir1"), + ?line Dir2 = filename:join(PrivDir, "dir2"), ok = file:make_dir(Dir1), ok = file:make_dir(Dir2), @@ -330,6 +337,7 @@ strip(Conf) when is_list(Conf) -> ?line {Source2D1, BeamFile2D1} = make_beam(PrivDir, simple2, concat), ?line {Source3D1, BeamFile3D1} = make_beam(PrivDir, make_fun, make_fun), ?line {Source4D1, BeamFile4D1} = make_beam(PrivDir, constant, constant), + ?line {Source5D1, BeamFile5D1} = make_beam(PrivDir, lines, lines), ?line NoOfTables = length(ets:all()), ?line P0 = pps(), @@ -360,13 +368,25 @@ strip(Conf) when is_list(Conf) -> ?line {module, make_fun} = code:load_abs(filename:rootname(BeamFile3D1)), ?line {module, constant} = code:load_abs(filename:rootname(BeamFile4D1)), + %% check that line number information is still present after stripping + ?line {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)), + ?line {'EXIT',{badarith,[{lines,t,1,Info}|_]}} = + (catch lines:t(atom)), + ?line true = code:delete(lines), + ?line false = code:purge(lines), + ?line {ok, {lines,BeamFile5D1}} = beam_lib:strip(BeamFile5D1), + ?line {module, lines} = code:load_abs(filename:rootname(BeamFile5D1)), + ?line {'EXIT',{badarith,[{lines,t,1,Info}|_]}} = + (catch lines:t(atom)), + ?line true = (P0 == pps()), ?line NoOfTables = length(ets:all()), ?line delete_files([SourceD1, BeamFileD1, Source2D1, BeamFile2D1, Source3D1, BeamFile3D1, - Source4D1, BeamFile4D1]), + Source4D1, BeamFile4D1, + Source5D1, BeamFile5D1]), ok. @@ -381,7 +401,7 @@ otp_6711(Conf) when is_list(Conf) -> (catch {a, beam_lib:strip_files([3])}), ?line PrivDir = ?privdir, - ?line Dir = filename:join(PrivDir, dir), + ?line Dir = filename:join(PrivDir, "dir"), ?line Lib = filename:join(Dir, "lib"), ?line App = filename:join(Lib, "app"), ?line EBin = filename:join(App, "ebin"), @@ -417,8 +437,8 @@ building(doc) -> "Testing building of BEAM files."; building(Conf) when is_list(Conf) -> ?line PrivDir = ?privdir, - ?line Dir1 = filename:join(PrivDir, b_dir1), - ?line Dir2 = filename:join(PrivDir, b_dir2), + ?line Dir1 = filename:join(PrivDir, "b_dir1"), + ?line Dir2 = filename:join(PrivDir, "b_dir2"), ok = file:make_dir(Dir1), ok = file:make_dir(Dir2), @@ -571,8 +591,18 @@ do_encrypted_abstr(Beam, Key) -> ?line {ok,{simple,[{"Abst",Abst}]}} = beam_lib:chunks(Beam, ["Abst"]), ?line {ok,cleared} = beam_lib:clear_crypto_key_fun(), + + %% Try to force a stop/start race. + ?line start_stop_race(10000), + ok. +start_stop_race(0) -> + ok; +start_stop_race(N) -> + {error,_} = beam_lib:crypto_key_fun(bad_fun), + undefined = beam_lib:clear_crypto_key_fun(), + start_stop_race(N-1). bad_fun(F) -> {error,E} = beam_lib:crypto_key_fun(F), @@ -688,7 +718,7 @@ chunk_info(File) -> Chunks. make_beam(Dir, Module, F) -> - ?line FileBase = filename:join(Dir, Module), + ?line FileBase = filename:join(Dir, atom_to_list(Module)), ?line Source = FileBase ++ ".erl", ?line BeamFile = FileBase ++ ".beam", ?line simple_file(Source, Module, F), @@ -773,6 +803,12 @@ simple_file(File, Module, constant2) -> "t(A) -> " " {a,b,[2,3],x,y}. "]), ok = file:write_file(File, B); +simple_file(File, Module, lines) -> + B = list_to_binary(["-module(", atom_to_list(Module), ").\n" + "-export([t/1]).\n" + "t(A) ->\n" + " A+1.\n"]), + ok = file:write_file(File, B); simple_file(File, Module, F) -> B = list_to_binary(["-module(", atom_to_list(Module), "). " "-export([t/0]). " diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index 698070368f..6f77cff2b9 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -34,6 +34,8 @@ -define(datadir(Conf), ?config(data_dir, Conf)). -endif. +-compile(r13). % OTP-9607 + -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, not_run/1, newly_started/1, basic_v8/1, basic_v9/1, @@ -53,7 +55,7 @@ simultaneous_open/1, insert_new/1, repair_continuation/1, otp_5487/1, otp_6206/1, otp_6359/1, otp_4738/1, otp_7146/1, otp_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1, - otp_8923/1, otp_9282/1]). + otp_8923/1, otp_9282/1, otp_9607/1]). -export([dets_dirty_loop/0]). @@ -112,7 +114,7 @@ all() -> many_clients, otp_4906, otp_5402, simultaneous_open, insert_new, repair_continuation, otp_5487, otp_6206, otp_6359, otp_4738, otp_7146, otp_8070, otp_8856, otp_8898, - otp_8899, otp_8903, otp_8923, otp_9282] + otp_8899, otp_8903, otp_8923, otp_9282, otp_9607] end. groups() -> @@ -554,7 +556,11 @@ dets_dirty_loop() -> {From, [write, Name, Value]} -> Ret = dets:insert(Name, Value), From ! {self(), Ret}, - dets_dirty_loop() + dets_dirty_loop(); + {From, [close, Name]} -> + Ret = dets:close(Name), + From ! {self(), Ret}, + dets_dirty_loop() end. @@ -1516,7 +1522,7 @@ repair(Config, V) -> if V =:= 8 -> %% first estimated number of objects is wrong, repair once more - ?line {ok, Fd} = file:open(Fname, read_write), + ?line {ok, Fd} = file:open(Fname, [read,write]), NoPos = HeadSize - 8, % no_objects ?line file:pwrite(Fd, NoPos, <<0:32>>), % NoItems ok = file:close(Fd), @@ -1568,8 +1574,10 @@ repair(Config, V) -> ?line FileSize = dets:info(TabRef, memory), ?line ok = dets:close(TabRef), crash(Fname, FileSize+20), - ?line {error, {bad_freelists, Fname}} = + %% Used to return bad_freelists, but that changed in OTP-9622 + ?line {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]), + ?line ok = dets:close(TabRef), ?line file:delete(Fname), %% File not closed, opening with read and read_write access tried. @@ -1857,10 +1865,10 @@ fixtable(Config, Version) when is_list(Config) -> ?line {ok, _} = dets:open_file(T, Args), %% badarg - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:safe_fixtable(no_table,true)), - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[T,undefined]}|_]}} = - (catch dets:safe_fixtable(T,undefined)), + ?line check_badarg(catch dets:safe_fixtable(no_table,true), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:safe_fixtable(T,undefined), + dets, safe_fixtable, [T,undefined]), %% The table is not allowed to grow while the elements are inserted: @@ -1940,22 +1948,22 @@ match(Config, Version) -> %% match, badarg MSpec = [{'_',[],['$_']}], - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:match(no_table, '_')), - ?line {'EXIT', {badarg, [{dets,match,[T,'_',not_a_number]}|_]}} = - (catch dets:match(T, '_', not_a_number)), + ?line check_badarg(catch dets:match(no_table, '_'), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:match(T, '_', not_a_number), + dets, match, [T,'_',not_a_number]), ?line {EC1, _} = dets:select(T, MSpec, 1), - ?line {'EXIT', {badarg, [{dets,match,[EC1]}|_]}} = - (catch dets:match(EC1)), + ?line check_badarg(catch dets:match(EC1), + dets, match, [EC1]), %% match_object, badarg - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:match_object(no_table, '_')), - ?line {'EXIT', {badarg, [{dets,match_object,[T,'_',not_a_number]}|_]}} = - (catch dets:match_object(T, '_', not_a_number)), + ?line check_badarg(catch dets:match_object(no_table, '_'), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:match_object(T, '_', not_a_number), + dets, match_object, [T,'_',not_a_number]), ?line {EC2, _} = dets:select(T, MSpec, 1), - ?line {'EXIT', {badarg, [{dets,match_object,[EC2]}|_]}} = - (catch dets:match_object(EC2)), + ?line check_badarg(catch dets:match_object(EC2), + dets, match_object, [EC2]), dets:safe_fixtable(T, true), ?line {[_, _], C1} = dets:match_object(T, '_', 2), @@ -2118,17 +2126,17 @@ select(Config, Version) -> %% badarg MSpec = [{'_',[],['$_']}], - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:select(no_table, MSpec)), - ?line {'EXIT', {badarg, [{dets,select,[T,<<17>>]}|_]}} = - (catch dets:select(T, <<17>>)), - ?line {'EXIT', {badarg, [{dets,select,[T,[]]}|_]}} = - (catch dets:select(T, [])), - ?line {'EXIT', {badarg, [{dets,select,[T,MSpec,not_a_number]}|_]}} = - (catch dets:select(T, MSpec, not_a_number)), + ?line check_badarg(catch dets:select(no_table, MSpec), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:select(T, <<17>>), + dets, select, [T,<<17>>]), + ?line check_badarg(catch dets:select(T, []), + dets, select, [T,[]]), + ?line check_badarg(catch dets:select(T, MSpec, not_a_number), + dets, select, [T,MSpec,not_a_number]), ?line {EC, _} = dets:match(T, '_', 1), - ?line {'EXIT', {badarg, [{dets,select,[EC]}|_]}} = - (catch dets:select(EC)), + ?line check_badarg(catch dets:select(EC), + dets, select, [EC]), AllSpec = [{'_',[],['$_']}], @@ -2210,8 +2218,8 @@ update_counter(Config) when is_list(Config) -> ?line file:delete(Fname), P0 = pps(), - ?line {'EXIT', {badarg, [{dets,update_counter,[no_table,1,1]}|_]}} = - (catch dets:update_counter(no_table, 1, 1)), + ?line check_badarg(catch dets:update_counter(no_table, 1, 1), + dets, update_counter, [no_table,1,1]), Args = [{file,Fname},{keypos,2}], ?line {ok, _} = dets:open_file(T, [{type,set} | Args]), @@ -2254,66 +2262,66 @@ badarg(Config) when is_list(Config) -> %% badargs are tested in match, select and fixtable too. %% open - ?line {'EXIT', {badarg, [{dets,open_file,[{a,tuple},[]]}|_]}} = - (catch dets:open_file({a,tuple},[])), - ?line {'EXIT', {badarg, [{dets,open_file,[{a,tuple}]}|_]}} = - (catch dets:open_file({a,tuple})), - ?line {'EXIT', {badarg, [{dets,open_file,[file,[foo]]}|_]}} = - (catch dets:open_file(file,[foo])), - ?line {'EXIT', {badarg,[{dets,open_file,[{hej,san},[{type,set}|3]]}|_]}} = - (catch dets:open_file({hej,san},[{type,set}|3])), + ?line check_badarg(catch dets:open_file({a,tuple},[]), + dets, open_file, [{a,tuple},[]]), + ?line check_badarg(catch dets:open_file({a,tuple}), + dets, open_file,[{a,tuple}]), + ?line check_badarg(catch dets:open_file(file,[foo]), + dets, open_file, [file,[foo]]), + ?line check_badarg(catch dets:open_file({hej,san},[{type,set}|3]), + dets, open_file, [{hej,san},[{type,set}|3]]), %% insert - ?line {'EXIT', {badarg, [{dets,insert,[no_table,{1,2}]}|_]}} = - (catch dets:insert(no_table, {1,2})), - ?line {'EXIT', {badarg, [{dets,insert,[no_table,[{1,2}]]}|_]}} = - (catch dets:insert(no_table, [{1,2}])), - ?line {'EXIT', {badarg, [{dets,insert,[T,{1,2}]}|_]}} = - (catch dets:insert(T, {1,2})), - ?line {'EXIT', {badarg, [{dets,insert,[T,[{1,2}]]}|_]}} = - (catch dets:insert(T, [{1,2}])), - ?line {'EXIT', {badarg, [{dets,insert,[T,[{1,2,3}|3]]}|_]}} = - (catch dets:insert(T, [{1,2,3} | 3])), + ?line check_badarg(catch dets:insert(no_table, {1,2}), + dets, insert, [no_table,{1,2}]), + ?line check_badarg(catch dets:insert(no_table, [{1,2}]), + dets, insert, [no_table,[{1,2}]]), + ?line check_badarg(catch dets:insert(T, {1,2}), + dets, insert, [T,{1,2}]), + ?line check_badarg(catch dets:insert(T, [{1,2}]), + dets, insert, [T,[{1,2}]]), + ?line check_badarg(catch dets:insert(T, [{1,2,3} | 3]), + dets, insert, [T,[{1,2,3}|3]]), %% lookup{_keys} - ?line {'EXIT', {badarg, [{dets,lookup_keys,[badarg,[]]}|_]}} = - (catch dets:lookup_keys(T, [])), - ?line {'EXIT', {badarg, [{dets,lookup,[no_table,1]}|_]}} = - (catch dets:lookup(no_table, 1)), - ?line {'EXIT', {badarg, [{dets,lookup_keys,[T,[1|2]]}|_]}} = - (catch dets:lookup_keys(T, [1 | 2])), + ?line check_badarg(catch dets:lookup_keys(T, []), + dets, lookup_keys, [badarg,[]]), + ?line check_badarg(catch dets:lookup(no_table, 1), + dets, lookup, [no_table,1]), + ?line check_badarg(catch dets:lookup_keys(T, [1 | 2]), + dets, lookup_keys, [T,[1|2]]), %% member - ?line {'EXIT', {badarg, [{dets,member,[no_table,1]}|_]}} = - (catch dets:member(no_table, 1)), + ?line check_badarg(catch dets:member(no_table, 1), + dets, member, [no_table,1]), %% sync - ?line {'EXIT', {badarg, [{dets,sync,[no_table]}|_]}} = - (catch dets:sync(no_table)), + ?line check_badarg(catch dets:sync(no_table), + dets, sync, [no_table]), %% delete{_keys} - ?line {'EXIT', {badarg, [{dets,delete,[no_table,1]}|_]}} = - (catch dets:delete(no_table, 1)), + ?line check_badarg(catch dets:delete(no_table, 1), + dets, delete, [no_table,1]), %% delete_object - ?line {'EXIT', {badarg, [{dets,delete_object,[no_table,{1,2,3}]}|_]}} = - (catch dets:delete_object(no_table, {1,2,3})), - ?line {'EXIT', {badarg, [{dets,delete_object,[T,{1,2}]}|_]}} = - (catch dets:delete_object(T, {1,2})), - ?line {'EXIT', {badarg, [{dets,delete_object,[no_table,[{1,2,3}]]}|_]}} = - (catch dets:delete_object(no_table, [{1,2,3}])), - ?line {'EXIT', {badarg, [{dets,delete_object,[T,[{1,2}]]}|_]}} = - (catch dets:delete_object(T, [{1,2}])), - ?line {'EXIT', {badarg, [{dets,delete_object,[T,[{1,2,3}|3]]}|_]}} = - (catch dets:delete_object(T, [{1,2,3} | 3])), + ?line check_badarg(catch dets:delete_object(no_table, {1,2,3}), + dets, delete_object, [no_table,{1,2,3}]), + ?line check_badarg(catch dets:delete_object(T, {1,2}), + dets, delete_object, [T,{1,2}]), + ?line check_badarg(catch dets:delete_object(no_table, [{1,2,3}]), + dets, delete_object, [no_table,[{1,2,3}]]), + ?line check_badarg(catch dets:delete_object(T, [{1,2}]), + dets, delete_object, [T,[{1,2}]]), + ?line check_badarg(catch dets:delete_object(T, [{1,2,3} | 3]), + dets, delete_object, [T,[{1,2,3}|3]]), %% first,next,slot - ?line {'EXIT', {badarg, [{dets,first,[no_table]}|_]}} = - (catch dets:first(no_table)), - ?line {'EXIT', {badarg, [{dets,next,[no_table,1]}|_]}} = - (catch dets:next(no_table, 1)), - ?line {'EXIT', {badarg, [{dets,slot,[no_table,0]}|_]}} = - (catch dets:slot(no_table, 0)), + ?line check_badarg(catch dets:first(no_table), + dets, first, [no_table]), + ?line check_badarg(catch dets:next(no_table, 1), + dets, next, [no_table,1]), + ?line check_badarg(catch dets:slot(no_table, 0), + dets, slot, [no_table,0]), %% info ?line undefined = dets:info(no_table), @@ -2321,27 +2329,27 @@ badarg(Config) when is_list(Config) -> ?line undefined = dets:info(T, foo), %% match_delete - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:match_delete(no_table, '_')), + ?line check_badarg(catch dets:match_delete(no_table, '_'), + dets, safe_fixtable, [no_table,true]), %% delete_all_objects - ?line {'EXIT', {badarg, [{dets,delete_all_objects,[no_table]}|_]}} = - (catch dets:delete_all_objects(no_table)), + ?line check_badarg(catch dets:delete_all_objects(no_table), + dets, delete_all_objects, [no_table]), %% select_delete MSpec = [{'_',[],['$_']}], - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:select_delete(no_table, MSpec)), - ?line {'EXIT', {badarg, [{dets,select_delete,[T, <<17>>]}|_]}} = - (catch dets:select_delete(T, <<17>>)), + ?line check_badarg(catch dets:select_delete(no_table, MSpec), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:select_delete(T, <<17>>), + dets, select_delete, [T, <<17>>]), %% traverse, fold - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:traverse(no_table, fun(_) -> continue end)), - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:foldl(fun(_, A) -> A end, [], no_table)), - ?line {'EXIT', {badarg, [{dets,safe_fixtable,[no_table,true]}|_]}} = - (catch dets:foldr(fun(_, A) -> A end, [], no_table)), + ?line check_badarg(catch dets:traverse(no_table, fun(_) -> continue end), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:foldl(fun(_, A) -> A end, [], no_table), + dets, safe_fixtable, [no_table,true]), + ?line check_badarg(catch dets:foldr(fun(_, A) -> A end, [], no_table), + dets, safe_fixtable, [no_table,true]), %% close ?line ok = dets:close(T), @@ -2349,15 +2357,16 @@ badarg(Config) when is_list(Config) -> ?line {error, not_owner} = dets:close(T), %% init_table - ?line {'EXIT', {badarg,[{dets,init_table,[no_table,_,[]]}|_]}} = - (catch dets:init_table(no_table, fun(X) -> X end)), - ?line {'EXIT', {badarg,[{dets,init_table,[no_table,_,[]]}|_]}} = - (catch dets:init_table(no_table, fun(X) -> X end, [])), + IF = fun(X) -> X end, + ?line check_badarg(catch dets:init_table(no_table, IF), + dets, init_table, [no_table,IF,[]]), + ?line check_badarg(catch dets:init_table(no_table, IF, []), + dets, init_table, [no_table,IF,[]]), %% from_ets Ets = ets:new(ets,[]), - ?line {'EXIT', {badarg,[{dets,from_ets,[no_table,_]}|_]}} = - (catch dets:from_ets(no_table, Ets)), + ?line check_badarg(catch dets:from_ets(no_table, Ets), + dets, from_ets, [no_table,Ets]), ets:delete(Ets), ?line {ok, T} = dets:open_file(T, Args), @@ -3247,7 +3256,7 @@ otp_5402(suite) -> []; otp_5402(Config) when is_list(Config) -> Tab = otp_5402, - ?line File = filename:join([cannot, write, this, file]), + ?line File = filename:join(["cannot", "write", "this", "file"]), %% close ?line{ok, T} = dets:open_file(Tab, [{ram_file,true}, @@ -3879,15 +3888,96 @@ some_calls(Tab, Config) -> ?line ok = dets:close(T), file:delete(File). +otp_9607(doc) -> + ["OTP-9607. Test downgrading the slightly changed format."]; +otp_9607(suite) -> + []; +otp_9607(Config) when is_list(Config) -> + %% Note: the bug is about almost full tables. The fix of that + %% problem is *not* tested here. + Version = r13b, + case ?t:is_release_available(atom_to_list(Version)) of + true -> + T = otp_9607, + File = filename(T, Config), + Key = a, + Value = 1, + Args = [{file,File}], + ?line {ok, T} = dets:open_file(T, Args), + ?line ok = dets:insert(T, {Key, Value}), + ?line ok = dets:close(T), + + ?line Call = fun(P, A) -> + P ! {self(), A}, + receive + {P, Ans} -> + Ans + after 5000 -> + exit(other_process_dead) + end + end, + %% Create a file on the modified format, read the file + %% with an emulator that doesn't know about the modified + %% format. + ?line {ok, Node} = start_node_rel(Version, Version, slave), + ?line Pid = rpc:call(Node, erlang, spawn, + [?MODULE, dets_dirty_loop, []]), + ?line {error,{needs_repair, File}} = + Call(Pid, [open, T, Args++[{repair,false}]]), + io:format("Expect repair:~n"), + ?line {ok, T} = Call(Pid, [open, T, Args]), + ?line [{Key,Value}] = Call(Pid, [read, T, Key]), + ?line ok = Call(Pid, [close, T]), + file:delete(File), + + %% Create a file on the unmodified format. Modify the file + %% using an emulator that must not turn the file into the + %% modified format. Read the file and make sure it is not + %% repaired. + ?line {ok, T} = Call(Pid, [open, T, Args]), + ?line ok = Call(Pid, [write, T, {Key,Value}]), + ?line [{Key,Value}] = Call(Pid, [read, T, Key]), + ?line ok = Call(Pid, [close, T]), + + Key2 = b, + Value2 = 2, + + ?line {ok, T} = dets:open_file(T, Args), + ?line [{Key,Value}] = dets:lookup(T, Key), + ?line ok = dets:insert(T, {Key2,Value2}), + ?line ok = dets:close(T), + + ?line {ok, T} = Call(Pid, [open, T, Args++[{repair,false}]]), + ?line [{Key2,Value2}] = Call(Pid, [read, T, Key2]), + ?line ok = Call(Pid, [close, T]), + + ?t:stop_node(Node), + file:delete(File), + ok; + false -> + {skipped, "No support for old node"} + end. + + + %% %% Parts common to several test cases %% +start_node_rel(Name, Rel, How) -> + Release = [{release, atom_to_list(Rel)}], + ?line Pa = filename:dirname(code:which(?MODULE)), + ?line test_server:start_node(Name, How, + [{args, + " -kernel net_setuptime 100 " + " -pa " ++ Pa}, + {erl, Release}]). + crash(File, Where) -> crash(File, Where, 10). crash(File, Where, What) when is_integer(What) -> - ?line {ok, Fd} = file:open(File, read_write), + ?line {ok, Fd} = file:open(File, [read,write]), ?line file:position(Fd, Where), ?line ok = file:write(Fd, [What]), ?line ok = file:close(Fd). @@ -4031,7 +4121,7 @@ writable(Fname) -> ?line file:write_file_info(Fname, Info#file_info{mode = Mode}). truncate(File, Where) -> - ?line {ok, Fd} = file:open(File, read_write), + ?line {ok, Fd} = file:open(File, [read,write]), ?line file:position(Fd, Where), ?line ok = file:truncate(Fd), ?line ok = file:close(Fd). @@ -4268,6 +4358,11 @@ bad_object({error,{{bad_object,_}, FileName}}, FileName) -> bad_object({error,{{{bad_object,_,_},_,_,_}, FileName}}, FileName) -> ok. % Debug. +check_badarg({'EXIT', {badarg, [{M,F,Args,_} | _]}}, M, F, Args) -> + true; +check_badarg({'EXIT', {badarg, [{M,F,A,_} | _]}}, M, F, Args) -> + true = test_server:is_native(M) andalso length(Args) =:= A. + check_pps(P0) -> case pps() of P0 -> diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl index 9b024a5b49..f79414db49 100644 --- a/lib/stdlib/test/epp_SUITE.erl +++ b/lib/stdlib/test/epp_SUITE.erl @@ -20,7 +20,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]). --export([rec_1/1, predef_mac/1, +-export([rec_1/1, include_local/1, predef_mac/1, upcase_mac_1/1, upcase_mac_2/1, variable_1/1, otp_4870/1, otp_4871/1, otp_5362/1, pmod/1, not_circular/1, skip_header/1, otp_6277/1, otp_7702/1, @@ -63,7 +63,7 @@ end_per_testcase(_, Config) -> suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [rec_1, {group, upcase_mac}, predef_mac, + [rec_1, {group, upcase_mac}, include_local, predef_mac, {group, variable}, otp_4870, otp_4871, otp_5362, pmod, not_circular, skip_header, otp_6277, otp_7702, otp_8130, overload_mac, otp_8388, otp_8470, otp_8503, otp_8562, @@ -97,6 +97,22 @@ rec_1(Config) when is_list(Config) -> ?line check_errors(List), ok. +include_local(doc) -> + []; +include_local(suite) -> + []; +include_local(Config) when is_list(Config) -> + ?line DataDir = ?config(data_dir, Config), + ?line File = filename:join(DataDir, "include_local.erl"), + %% include_local.erl includes include/foo.hrl which + %% includes bar.hrl (also in include/) without requiring + %% any additional include path, and overriding any file + %% of the same name that the path points to + ?line {ok, List} = epp:parse_file(File, [DataDir], []), + ?line {value, {attribute,_,a,{true,true}}} = + lists:keysearch(a,3,List), + ok. + %%% Here is a little reimplementation of epp:parse_file, which times out %%% after 4 seconds if the epp server doesn't respond. If we use the %%% regular epp:parse_file, the test case will time out, and then epp @@ -234,16 +250,23 @@ otp_4871(Config) when is_list(Config) -> %% so there are some sanity checks before killing. ?line {ok,Epp} = epp:open(File, []), timer:sleep(1), - ?line {current_function,{epp,_,_}} = process_info(Epp, current_function), + ?line true = current_module(Epp, epp), ?line {monitored_by,[Io]} = process_info(Epp, monitored_by), - ?line {current_function,{file_io_server,_,_}} = - process_info(Io, current_function), + ?line true = current_module(Io, file_io_server), ?line exit(Io, emulate_crash), timer:sleep(1), ?line {error,{_Line,epp,cannot_parse}} = otp_4871_parse_file(Epp), ?line epp:close(Epp), ok. +current_module(Pid, Mod) -> + case process_info(Pid, current_function) of + {current_function, undefined} -> + true = test_server:is_native(Mod); + {current_function, {Mod, _, _}} -> + true + end. + otp_4871_parse_file(Epp) -> case epp:parse_erl_form(Epp) of {ok,_} -> otp_4871_parse_file(Epp); @@ -1280,7 +1303,7 @@ eval_tests(Config, Fun, Tests) -> check_test(Config, Test) -> - Filename = 'epp_test.erl', + Filename = "epp_test.erl", ?line PrivDir = ?config(priv_dir, Config), ?line File = filename:join(PrivDir, Filename), ?line ok = file:write_file(File, Test), @@ -1293,7 +1316,7 @@ check_test(Config, Test) -> compile_test(Config, Test0) -> Test = [<<"-module(epp_test). -compile(export_all). ">>, Test0], - Filename = 'epp_test.erl', + Filename = "epp_test.erl", ?line PrivDir = ?config(priv_dir, Config), ?line File = filename:join(PrivDir, Filename), ?line ok = file:write_file(File, Test), diff --git a/lib/stdlib/test/epp_SUITE_data/bar.hrl b/lib/stdlib/test/epp_SUITE_data/bar.hrl new file mode 100644 index 0000000000..01c527d549 --- /dev/null +++ b/lib/stdlib/test/epp_SUITE_data/bar.hrl @@ -0,0 +1,4 @@ +%% should not be included from include/foo.hrl even though the +%% include path points here - include/bar.hrl overrides it + +-define(BAR_HRL, false). diff --git a/lib/stdlib/test/epp_SUITE_data/include/bar.hrl b/lib/stdlib/test/epp_SUITE_data/include/bar.hrl new file mode 100644 index 0000000000..038d3c900e --- /dev/null +++ b/lib/stdlib/test/epp_SUITE_data/include/bar.hrl @@ -0,0 +1,3 @@ +%% included from foo.hrl in same directory + +-define(BAR_HRL, true). diff --git a/lib/stdlib/test/epp_SUITE_data/include/foo.hrl b/lib/stdlib/test/epp_SUITE_data/include/foo.hrl new file mode 100644 index 0000000000..a6dfa3d18a --- /dev/null +++ b/lib/stdlib/test/epp_SUITE_data/include/foo.hrl @@ -0,0 +1,4 @@ +%% includes bar.hrl in same directory + +-define(FOO_HRL, true). +-include("bar.hrl"). diff --git a/lib/stdlib/test/epp_SUITE_data/include_local.erl b/lib/stdlib/test/epp_SUITE_data/include_local.erl new file mode 100644 index 0000000000..c8e155a064 --- /dev/null +++ b/lib/stdlib/test/epp_SUITE_data/include_local.erl @@ -0,0 +1,6 @@ + +-module(include_local). + +-include("include/foo.hrl"). + +-a({?FOO_HRL, ?BAR_HRL}). diff --git a/lib/stdlib/test/erl_eval_SUITE.erl b/lib/stdlib/test/erl_eval_SUITE.erl index 0bcf3c5b71..784c7cb86e 100644 --- a/lib/stdlib/test/erl_eval_SUITE.erl +++ b/lib/stdlib/test/erl_eval_SUITE.erl @@ -1189,7 +1189,7 @@ lfh() -> {eval, fun(F, As, Bs) -> local_func(F, As, Bs) end}. local_func(F, As0, Bs0) when is_atom(F) -> - {As,Bs} = erl_eval:expr_list(As0, Bs0, {eval,lfh()}), + {As,Bs} = erl_eval:expr_list(As0, Bs0, lfh()), case erlang:function_exported(?MODULE, F, length(As)) of true -> {value,apply(?MODULE, F, As),Bs}; diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index f980d52e4e..9041adbe5c 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -2981,7 +2981,7 @@ run_test(Conf, Test0, Warnings0) -> run_test2(Conf, Test, Warnings0). run_test2(Conf, Test, Warnings0) -> - Filename = 'lint_test.erl', + Filename = "lint_test.erl", DataDir = ?privdir, File = filename:join(DataDir, Filename), Opts = case Warnings0 of diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl index 9341300f90..2f4958760b 100644 --- a/lib/stdlib/test/ets_SUITE.erl +++ b/lib/stdlib/test/ets_SUITE.erl @@ -795,21 +795,26 @@ t_ets_dets(Config, Opts) -> ?line true = ets:from_dets(ETab,DTab), ?line 3000 = ets:info(ETab,size), ?line ets:delete(ETab), - ?line {'EXIT',{badarg,[{ets,to_dets,[ETab,DTab]}|_]}} = - (catch ets:to_dets(ETab,DTab)), - ?line {'EXIT',{badarg,[{ets,from_dets,[ETab,DTab]}|_]}} = - (catch ets:from_dets(ETab,DTab)), + ?line check_badarg(catch ets:to_dets(ETab,DTab), + ets, to_dets, [ETab,DTab]), + ?line check_badarg(catch ets:from_dets(ETab,DTab), + ets, from_dets, [ETab,DTab]), ?line ETab2 = ets_new(x,Opts), ?line filltabint(ETab2,3000), ?line dets:close(DTab), - ?line {'EXIT',{badarg,[{ets,to_dets,[ETab2,DTab]}|_]}} = - (catch ets:to_dets(ETab2,DTab)), - ?line {'EXIT',{badarg,[{ets,from_dets,[ETab2,DTab]}|_]}} = - (catch ets:from_dets(ETab2,DTab)), + ?line check_badarg(catch ets:to_dets(ETab2,DTab), + ets, to_dets, [ETab2,DTab]), + ?line check_badarg(catch ets:from_dets(ETab2,DTab), + ets, from_dets, [ETab2,DTab]), ?line ets:delete(ETab2), ?line (catch file:delete(Fname)), ok. +check_badarg({'EXIT', {badarg, [{M,F,Args,_} | _]}}, M, F, Args) -> + true; +check_badarg({'EXIT', {badarg, [{M,F,A,_} | _]}}, M, F, Args) -> + true = test_server:is_native(M) andalso length(Args) =:= A. + t_delete_all_objects(doc) -> ["Test ets:delete_all_objects/1"]; t_delete_all_objects(suite) -> @@ -819,6 +824,14 @@ t_delete_all_objects(Config) when is_list(Config) -> repeat_for_opts(t_delete_all_objects_do), ?line verify_etsmem(EtsMem). +get_kept_objects(T) -> + case ets:info(T,stats) of + false -> + 0; + {_,_,_,_,_,_,KO} -> + KO + end. + t_delete_all_objects_do(Opts) -> ?line T=ets_new(x,Opts), ?line filltabint(T,4000), @@ -828,10 +841,10 @@ t_delete_all_objects_do(Opts) -> ?line true = ets:delete_all_objects(T), ?line '$end_of_table' = ets:next(T,O), ?line 0 = ets:info(T,size), - ?line 4000 = ets:info(T,kept_objects), + ?line 4000 = get_kept_objects(T), ?line ets:safe_fixtable(T,false), ?line 0 = ets:info(T,size), - ?line 0 = ets:info(T,kept_objects), + ?line 0 = get_kept_objects(T), ?line filltabint(T,4000), ?line 4000 = ets:info(T,size), ?line true = ets:delete_all_objects(T), @@ -861,10 +874,10 @@ t_delete_object_do(Opts) -> ?line ets:delete_object(T,{First, integer_to_list(First)}), ?line Next = ets:next(T,First), ?line 3999 = ets:info(T,size), - ?line 1 = ets:info(T,kept_objects), + ?line 1 = get_kept_objects(T), ?line ets:safe_fixtable(T,false), ?line 3999 = ets:info(T,size), - ?line 0 = ets:info(T,kept_objects), + ?line 0 = get_kept_objects(T), ?line ets:delete(T), ?line T1 = ets_new(x,[ordered_set | Opts]), ?line filltabint(T1,4000), @@ -2644,7 +2657,7 @@ maybe_sort(L) when is_list(L) -> %maybe_sort({'EXIT',{Reason, [{Module, Function, _}|_]}}) -> % {'EXIT',{Reason, [{Module, Function, '_'}]}}; maybe_sort({'EXIT',{Reason, List}}) when is_list(List) -> - {'EXIT',{Reason, lists:map(fun({Module, Function, _}) -> + {'EXIT',{Reason, lists:map(fun({Module, Function, _, _}) -> {Module, Function, '_'} end, List)}}; @@ -2717,7 +2730,8 @@ ordered_do(Opts) -> 9,10,11,12, 1,2,3,4, 17,18,19,20, - 13,14,15,16 + 13,14,15,16, + 1 bsl 33 ], ?line lists:foreach(fun(X) -> ets:insert(T,{X,integer_to_list(X)}) @@ -2732,13 +2746,14 @@ ordered_do(Opts) -> ?line S2 = L2, ?line [{1,"1"}] = ets:slot(T,0), ?line [{28,"28"}] = ets:slot(T,27), + ?line [{1 bsl 33,_}] = ets:slot(T,28), ?line 27 = ets:prev(T,28), ?line [{7,"7"}] = ets:slot(T,6), - ?line '$end_of_table' = ets:next(T,28), + ?line '$end_of_table' = ets:next(T,1 bsl 33), ?line [{12,"12"}] = ets:slot(T,11), - ?line '$end_of_table' = ets:slot(T,28), + ?line '$end_of_table' = ets:slot(T,29), ?line [{1,"1"}] = ets:slot(T,0), - ?line 28 = ets:prev(T,29), + ?line 28 = ets:prev(T,1 bsl 33), ?line 1 = ets:next(T,0), ?line pick_all_forward(T), ?line [{7,"7"}] = ets:slot(T,6), @@ -4969,7 +4984,7 @@ grow_pseudo_deleted_do(Type) -> [true]}]), Left = Mult*(Mod-1), ?line Left = ets:info(T,size), - ?line Mult = ets:info(T,kept_objects), + ?line Mult = get_kept_objects(T), filltabstr(T,Mult), spawn_opt(fun()-> ?line true = ets:info(T,fixed), Self ! start, @@ -4983,7 +4998,7 @@ grow_pseudo_deleted_do(Type) -> ?line true = ets:safe_fixtable(T,false), io:format("Unfix table done. ~p nitems=~p\n",[now(),ets:info(T,size)]), ?line false = ets:info(T,fixed), - ?line 0 = ets:info(T,kept_objects), + ?line 0 = get_kept_objects(T), ?line done = receive_any(), %%verify_table_load(T), % may fail if concurrency is poor (genny) ets:delete(T), @@ -5010,7 +5025,7 @@ shrink_pseudo_deleted_do(Type) -> [{'>', '$1', Half}], [true]}]), ?line Half = ets:info(T,size), - ?line Half = ets:info(T,kept_objects), + ?line Half = get_kept_objects(T), spawn_opt(fun()-> ?line true = ets:info(T,fixed), Self ! start, io:format("Starting to delete... ~p\n",[now()]), @@ -5023,7 +5038,7 @@ shrink_pseudo_deleted_do(Type) -> ?line true = ets:safe_fixtable(T,false), io:format("Unfix table done. ~p nitems=~p\n",[now(),ets:info(T,size)]), ?line false = ets:info(T,fixed), - ?line 0 = ets:info(T,kept_objects), + ?line 0 = get_kept_objects(T), ?line done = receive_any(), %%verify_table_load(T), % may fail if concurrency is poor (genny) ets:delete(T), @@ -5139,7 +5154,7 @@ smp_fixed_delete_do() -> ?line 0 = ets:info(T,size), ?line true = ets:info(T,fixed), ?line Buckets = num_of_buckets(T), - ?line NumOfObjs = ets:info(T,kept_objects), + ?line NumOfObjs = get_kept_objects(T), ets:safe_fixtable(T,false), %% Will fail as unfix does not shrink the table: %%?line Mem = ets:info(T,memory), @@ -5171,7 +5186,7 @@ smp_unfix_fix_do() -> Left = NumOfObjs - Deleted, ?line Left = ets:info(T,size), ?line true = ets:info(T,fixed), - ?line Deleted = ets:info(T,kept_objects), + ?line Deleted = get_kept_objects(T), {Child, Mref} = spawn_opt(fun()-> ?line true = ets:info(T,fixed), @@ -5188,7 +5203,7 @@ smp_unfix_fix_do() -> end, Deleted), ?line 0 = ets:info(T,size), - ?line true = ets:info(T,kept_objects) >= Left, + ?line true = get_kept_objects(T) >= Left, ?line done = receive_any() end, [link, monitor, {scheduler,2}]), @@ -5201,7 +5216,7 @@ smp_unfix_fix_do() -> Child ! done, {'DOWN', Mref, process, Child, normal} = receive_any(), ?line false = ets:info(T,fixed), - ?line 0 = ets:info(T,kept_objects), + ?line 0 = get_kept_objects(T), %%verify_table_load(T), ets:delete(T), process_flag(scheduler,0). @@ -5239,7 +5254,7 @@ otp_8166_do(WC) -> ZombieCrPid ! quit, {'DOWN', ZombieCrMref, process, ZombieCrPid, normal} = receive_any(), ?line false = ets:info(T,fixed), - ?line 0 = ets:info(T,kept_objects), + ?line 0 = get_kept_objects(T), %%verify_table_load(T), ets:delete(T), process_flag(scheduler,0). @@ -5306,7 +5321,7 @@ otp_8166_zombie_creator(T,Deleted) -> verify_table_load(T) -> ?line Stats = ets:info(T,stats), - ?line {Buckets,AvgLen,StdDev,ExpSD,_MinLen,_MaxLen} = Stats, + ?line {Buckets,AvgLen,StdDev,ExpSD,_MinLen,_MaxLen,_} = Stats, ?line ok = if AvgLen > 7 -> io:format("Table overloaded: Stats=~p\n~p\n", @@ -5918,7 +5933,7 @@ very_big_num(0, Result) -> ?line Result. make_port() -> - ?line open_port({spawn, efile}, [eof]). + ?line open_port({spawn, "efile"}, [eof]). make_pid() -> ?line spawn_link(?MODULE, sleeper, []). diff --git a/lib/stdlib/test/file_sorter_SUITE.erl b/lib/stdlib/test/file_sorter_SUITE.erl index 80d4ea5fdc..74c08912be 100644 --- a/lib/stdlib/test/file_sorter_SUITE.erl +++ b/lib/stdlib/test/file_sorter_SUITE.erl @@ -89,7 +89,7 @@ basic(suite) -> basic(Config) when is_list(Config) -> Fmt = binary, Arg = {format,Fmt}, - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), P0 = pps(), ?line F1s = [F1] = to_files([[]], Fmt, Config), @@ -455,7 +455,7 @@ inout(suite) -> []; inout(Config) when is_list(Config) -> BTF = {format, binary_term}, - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), %% Input is fun. End = fun(read) -> end_of_input end, @@ -522,7 +522,7 @@ many(doc) -> many(suite) -> []; many(Config) when is_list(Config) -> - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), PrivDir = ?privdir(Config), P0 = pps(), @@ -587,7 +587,7 @@ misc(suite) -> []; misc(Config) when is_list(Config) -> BTF = {format, binary_term}, - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), FFoo = filename:absname(Foo), P0 = pps(), @@ -704,7 +704,7 @@ misc(Config) when is_list(Config) -> sort(Fmt, XArgs, Config) -> Args = make_args(Fmt, [{size,5} | XArgs]), TmpArgs = [{tmpdir,?privdir(Config)} | Args], - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), %% Input is a fun. Output is a fun. ?line [] = file_sorter:sort(input([], 2, Fmt), output([], Fmt), Args), @@ -777,7 +777,7 @@ sort(Fmt, XArgs, Config) -> keysort(Fmt, XArgs, Config) -> Args = make_args(Fmt, [{size,50}, {no_files, 2} | XArgs]), TmpArgs = Args ++ [{tmpdir,?privdir(Config)}], - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), %% Input is files. Output is a file. ?line ok = file_sorter:keysort(2, [], Foo, Args), @@ -836,7 +836,7 @@ keysort(Fmt, XArgs, Config) -> merge(Fmt, XArgs, Config) -> Args = make_args(Fmt, [{size,5} | XArgs]), - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), %% Input is a file. Output is a fun. ?line [] = file_sorter:merge([], output([], Fmt), Args), @@ -873,7 +873,7 @@ merge(Fmt, XArgs, Config) -> keymerge(Fmt, XArgs, Config) -> Args = make_args(Fmt, [{size,50}, {no_files, 2} | XArgs]), - Foo = outfile(foo, Config), + Foo = outfile("foo", Config), %% Input is files. Output is a file. ?line ok = file_sorter:keymerge(2, [], Foo, Args), diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index a355097fe2..1de639a166 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -97,11 +97,12 @@ wildcard_errors(Config) when is_list(Config) -> wcc(Wc, Error) -> {'EXIT',{{badpattern,Error}, - [{filelib,compile_wildcard,1}|_]}} = (catch filelib:compile_wildcard(Wc)), + [{filelib,compile_wildcard,1,_}|_]}} = + (catch filelib:compile_wildcard(Wc)), {'EXIT',{{badpattern,Error}, - [{filelib,wildcard,1}|_]}} = (catch filelib:wildcard(Wc)), + [{filelib,wildcard,1,_}|_]}} = (catch filelib:wildcard(Wc)), {'EXIT',{{badpattern,Error}, - [{filelib,wildcard,2}|_]}} = (catch filelib:wildcard(Wc, ".")). + [{filelib,wildcard,2,_}|_]}} = (catch filelib:wildcard(Wc, ".")). do_wildcard_1(Dir, Wcf0) -> do_wildcard_2(Dir, Wcf0), @@ -243,7 +244,7 @@ otp_5960(doc) -> ["Test that filelib:ensure_dir/1 returns ok or {error,Reason}"]; otp_5960(Config) when is_list(Config) -> ?line PrivDir = ?config(priv_dir, Config), - ?line Dir = filename:join(PrivDir, otp_5960_dir), + ?line Dir = filename:join(PrivDir, "otp_5960_dir"), ?line Name1 = filename:join(Dir, name1), ?line Name2 = filename:join(Dir, name2), ?line ok = filelib:ensure_dir(Name1), % parent is created @@ -268,7 +269,7 @@ otp_5960(Config) when is_list(Config) -> ensure_dir_eexist(Config) when is_list(Config) -> ?line PrivDir = ?config(priv_dir, Config), - ?line Dir = filename:join(PrivDir, ensure_dir_eexist), + ?line Dir = filename:join(PrivDir, "ensure_dir_eexist"), ?line Name = filename:join(Dir, "same_name_as_file_and_dir"), ?line ok = filelib:ensure_dir(Name), ?line ok = file:write_file(Name, <<"some string\n">>), diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl index 4e5df12798..c9688354b1 100644 --- a/lib/stdlib/test/ms_transform_SUITE.erl +++ b/lib/stdlib/test/ms_transform_SUITE.erl @@ -39,6 +39,7 @@ -export([float_1_function/1]). -export([action_function/1]). -export([warnings/1]). +-export([no_warnings/1]). -export([init_per_testcase/2, end_per_testcase/2]). init_per_testcase(_Func, Config) -> @@ -55,7 +56,7 @@ all() -> [from_shell, basic_ets, basic_dbg, records, record_index, multipass, bitsyntax, record_defaults, andalso_orelse, float_1_function, action_function, - warnings, top_match, old_guards, autoimported, + warnings, no_warnings, top_match, old_guards, autoimported, semicolon]. groups() -> @@ -155,6 +156,34 @@ warnings(Config) when is_list(Config) -> compile_ww(Prog7), ok. +no_warnings(suite) -> + []; +no_warnings(doc) -> + ["Check that variables bound in other function clauses don't generate " + "warning"]; +no_warnings(Config) when is_list(Config) -> + ?line setup(Config), + Prog = <<"tmp(X) when X > 100 ->\n", + " Y=X,\n" + " Y;\n" + "tmp(X) ->\n" + " ets:fun2ms(fun(Y) ->\n" + " {X, 3*Y}\n" + " end)">>, + ?line [] = compile_no_ww(Prog), + + Prog2 = <<"tmp(X) when X > 100 ->\n", + " Y=X,\n" + " Y;\n" + "tmp(X) when X < 200 ->\n" + " ok;\n" + "tmp(X) ->\n" + " ets:fun2ms(fun(Y) ->\n" + " {X, 3*Y}\n" + " end)">>, + ?line [] = compile_no_ww(Prog2), + ok. + andalso_orelse(suite) -> []; andalso_orelse(doc) -> @@ -842,6 +871,20 @@ compile_ww(Records,Expr) -> nowarn_unused_record]), Wlist. +compile_no_ww(Expr) -> + Prog = << + "-module(tmp).\n", + "-include_lib(\"stdlib/include/ms_transform.hrl\").\n", + "-export([tmp/1]).\n\n", + Expr/binary,".\n">>, + FN=temp_name(), + file:write_file(FN,Prog), + {ok,Forms} = epp:parse_file(FN,"",""), + {ok,tmp,_Bin,Wlist} = compile:forms(Forms,[return_warnings, + nowarn_unused_vars, + nowarn_unused_record]), + Wlist. + do_eval(String) -> {done,{ok,T,_},[]} = erl_scan:tokens( [], diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl index 1565aa9bba..c95089117c 100644 --- a/lib/stdlib/test/proc_lib_SUITE.erl +++ b/lib/stdlib/test/proc_lib_SUITE.erl @@ -328,7 +328,7 @@ otp_6345(doc) -> ["'monitor' spawn_opt option"]; otp_6345(Config) when is_list(Config) -> Opts = [link,monitor], - {'EXIT', {badarg,[{proc_lib,check_for_monitor,_}|_Stack]}} = + {'EXIT', {badarg,[{proc_lib,check_for_monitor,_,_}|_Stack]}} = (catch proc_lib:start(?MODULE, otp_6345_init, [self()], 1000, Opts)), ok. diff --git a/lib/stdlib/test/re_SUITE.erl b/lib/stdlib/test/re_SUITE.erl index c4817c0d38..3b2e637c84 100644 --- a/lib/stdlib/test/re_SUITE.erl +++ b/lib/stdlib/test/re_SUITE.erl @@ -454,115 +454,115 @@ error_handling(Config) when is_list(Config) -> % The malformed precomiled RE is detected after % the trap to re:grun from grun, in the grun function clause % that handles precompiled expressions - ?line {'EXIT',{badarg,[{re,run,["apa",{1,2,3,4},[global]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,run,["apa",{1,2,3,4},[global]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:run("apa",{1,2,3,4},[global])), % An invalid capture list will also cause a badarg late, % but with a non pre compiled RE, the exception should be thrown by the % grun function clause that handles RE's compiled implicitly by % the run/3 BIF before trapping. - ?line {'EXIT',{badarg,[{re,run,["apa","p",[{capture,[1,{a}]},global]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,run,["apa","p",[{capture,[1,{a}]},global]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:run("apa","p",[{capture,[1,{a}]},global])), % And so the case of a precompiled expression together with % a compile-option (binary and list subject): ?line {ok,RE} = re:compile("(p)"), ?line {match,[[{1,1},{1,1}]]} = re:run(<<"apa">>,RE,[global]), ?line {match,[[{1,1},{1,1}]]} = re:run("apa",RE,[global]), - {'EXIT',{badarg,[{re,run, - [<<"apa">>, - {re_pattern,1,0,_}, - [global,unicode]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,run, + [<<"apa">>, + {re_pattern,1,0,_}, + [global,unicode]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:run(<<"apa">>,RE,[global,unicode])), - {'EXIT',{badarg,[{re,run, - ["apa", - {re_pattern,1,0,_}, - [global,unicode]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,run, + ["apa", + {re_pattern,1,0,_}, + [global,unicode]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:run("apa",RE,[global,unicode])), ?line {'EXIT',{badarg,_}} = (catch re:run("apa","(p",[])), ?line {'EXIT',{badarg,_}} = (catch re:run("apa","(p",[global])), % The replace errors: - ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:replace("apa",{1,2,3,4},"X",[])), - ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[global]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,replace,["apa",{1,2,3,4},"X",[global]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:replace("apa",{1,2,3,4},"X",[global])), ?line {'EXIT',{badarg,[{re,replace, ["apa", {re_pattern,1,0,_}, "X", - [unicode]]}, - {?MODULE, error_handling,1} | _]}} = + [unicode]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:replace("apa",RE,"X",[unicode])), ?line <<"aXa">> = iolist_to_binary(re:replace("apa","p","X",[])), ?line {'EXIT',{badarg,[{re,replace, - ["apa","p","X",[{capture,all,binary}]]}, - {?MODULE, error_handling,1} | _]}} = + ["apa","p","X",[{capture,all,binary}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch iolist_to_binary(re:replace("apa","p","X", [{capture,all,binary}]))), ?line {'EXIT',{badarg,[{re,replace, - ["apa","p","X",[{capture,all}]]}, - {?MODULE, error_handling,1} | _]}} = + ["apa","p","X",[{capture,all}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch iolist_to_binary(re:replace("apa","p","X", [{capture,all}]))), ?line {'EXIT',{badarg,[{re,replace, - ["apa","p","X",[{return,banana}]]}, - {?MODULE, error_handling,1} | _]}} = + ["apa","p","X",[{return,banana}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch iolist_to_binary(re:replace("apa","p","X", [{return,banana}]))), ?line {'EXIT',{badarg,_}} = (catch re:replace("apa","(p","X",[])), % Badarg, not compile error. ?line {'EXIT',{badarg,[{re,replace, - ["apa","(p","X",[{return,banana}]]}, - {?MODULE, error_handling,1} | _]}} = + ["apa","(p","X",[{return,banana}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch iolist_to_binary(re:replace("apa","(p","X", [{return,banana}]))), % And the split errors: ?line [<<"a">>,<<"a">>] = (catch re:split("apa","p",[])), ?line [<<"a">>,<<"p">>,<<"a">>] = (catch re:split("apa",RE,[])), - ?line {'EXIT',{badarg,[{re,split,["apa","p",[global]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa","p",[global]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa","p",[global])), - ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all}]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa","p",[{capture,all}])), - ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all,binary}]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa","p",[{capture,all,binary}]],_}, + {?MODULE, error_handling,1,_} | _]}} = (catch re:split("apa","p",[{capture,all,binary}])), - ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",{1,2,3,4})), - ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]]}, - {?MODULE, error_handling,1} | _]}} = + ?line {'EXIT',{badarg,[{re,split,["apa",{1,2,3,4},[]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",{1,2,3,4},[])), ?line {'EXIT',{badarg,[{re,split, ["apa", RE, - [unicode]]}, - {?MODULE, error_handling,1} | _]}} = + [unicode]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",RE,[unicode])), ?line {'EXIT',{badarg,[{re,split, ["apa", RE, - [{return,banana}]]}, - {?MODULE, error_handling,1} | _]}} = + [{return,banana}]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",RE,[{return,banana}])), ?line {'EXIT',{badarg,[{re,split, ["apa", RE, - [banana]]}, - {?MODULE, error_handling,1} | _]}} = + [banana]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa",RE,[banana])), ?line {'EXIT',{badarg,_}} = (catch re:split("apa","(p")), %Exception on bad argument, not compilation error ?line {'EXIT',{badarg,[{re,split, ["apa", "(p", - [banana]]}, - {?MODULE, error_handling,1} | _]}} = + [banana]],_}, + {?MODULE,error_handling,1,_} | _]}} = (catch re:split("apa","(p",[banana])), ?t:timetrap_cancel(Dog), ok. diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 8273377ba1..b6019b86f0 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -2388,12 +2388,12 @@ otp_6554(Config) when is_list(Config) -> comm_err(<<"V = lists:seq(1, 20), case V of a -> ok end.">>), ?line "exception error: no function clause matching" = comm_err(<<"fun(P) when is_pid(P) -> true end(a).">>), - ?line "exception error: {function_clause,[{erl_eval,do_apply,[unproper|list]}"++_ = + ?line "exception error: {function_clause," = comm_err(<<"erlang:error(function_clause, [unproper | list]).">>), ?line "exception error: function_clause" = comm_err(<<"erlang:error(function_clause, 4).">>), %% Cheating: - ?line "exception error: no function clause matching erl_eval:do_apply(4)" = + ?line "exception error: no function clause matching erl_eval:do_apply(4)" ++ _ = comm_err(<<"erlang:error(function_clause, [4]).">>), ?line "exception error: no function clause matching" ++ _ = comm_err(<<"fun(a, b, c, d) -> foo end" @@ -2406,7 +2406,7 @@ otp_6554(Config) when is_list(Config) -> comm_err(<<"fun(P, q) when is_pid(P) -> true end(a, b).">>), ?line "exception error: no function clause matching lists:reverse(" ++ _ = comm_err(<<"F=fun() -> hello end, lists:reverse(F).">>), - ?line "exception error: no function clause matching lists:reverse(34)" = + ?line "exception error: no function clause matching lists:reverse(34) (lists.erl, line " ++ _ = comm_err(<<"lists:reverse(34).">>), ?line "exception error: no true branch found when evaluating an if expression" = comm_err(<<"if length([a,b]) > 17 -> a end.">>), diff --git a/lib/stdlib/test/sofs_SUITE.erl b/lib/stdlib/test/sofs_SUITE.erl index d6f88a655e..73b282149a 100644 --- a/lib/stdlib/test/sofs_SUITE.erl +++ b/lib/stdlib/test/sofs_SUITE.erl @@ -1879,11 +1879,11 @@ digraph(Conf) when is_list(Conf) -> ?line {'EXIT', {badarg, _}} = (catch family_to_digraph(set([a]))), - ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_]}|_]}} = + ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_],_}|_]}} = (catch family_to_digraph(set([a]), [foo])), - ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_]}|_]}} = + ?line {'EXIT', {badarg, [{sofs,family_to_digraph,[_,_],_}|_]}} = (catch family_to_digraph(F, [foo])), - ?line {'EXIT', {cyclic, [{sofs,family_to_digraph,[_,_]}|_]}} = + ?line {'EXIT', {cyclic, [{sofs,family_to_digraph,[_,_],_}|_]}} = (catch family_to_digraph(family([{a,[a]}]),[acyclic])), ?line G1 = family_to_digraph(E), diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index 1dcd4be21e..6969c095a0 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -273,9 +273,9 @@ words(Config) when is_list(Config) -> ?line 2 = string:words("2.35", $.), ?line 100 = string:words(string:copies(". ", 100)), %% invalid arg type - ?line {'EXIT',_} = (catch string:chars(hej)), + ?line {'EXIT',_} = (catch string:chars(hej, 1)), %% invalid arg type - ?line {'EXIT',_} = (catch string:chars("hej", " ")), + ?line {'EXIT',_} = (catch string:chars("hej", 1, " ")), ok. diff --git a/lib/stdlib/test/supervisor_2.erl b/lib/stdlib/test/supervisor_2.erl new file mode 100644 index 0000000000..67aacf5a9c --- /dev/null +++ b/lib/stdlib/test/supervisor_2.erl @@ -0,0 +1,42 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 1996-2010. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% Description: Simulates the behaviour that a child process may have. +%% Is used by the supervisor_SUITE test suite. +-module(supervisor_2). + +-export([start_child/1, init/1]). + +-export([handle_call/3, handle_info/2, terminate/2]). + +start_child(Time) when is_integer(Time), Time > 0 -> + gen_server:start_link(?MODULE, Time, []). + +init(Time) -> + process_flag(trap_exit, true), + {ok, Time}. + +handle_call(Req, _From, State) -> + {reply, Req, State}. + +handle_info(_, State) -> + {noreply, State}. + +terminate(_Reason, Time) -> + timer:sleep(Time), + ok. diff --git a/lib/stdlib/test/supervisor_SUITE.erl b/lib/stdlib/test/supervisor_SUITE.erl index 7a75114cb6..e709cf62ba 100644 --- a/lib/stdlib/test/supervisor_SUITE.erl +++ b/lib/stdlib/test/supervisor_SUITE.erl @@ -44,7 +44,7 @@ permanent_shutdown/1, transient_shutdown/1, temporary_shutdown/1, permanent_abnormal/1, transient_abnormal/1, - temporary_abnormal/1]). + temporary_abnormal/1, temporary_bystander/1]). %% Restart strategy tests -export([ one_for_one/1, @@ -52,7 +52,7 @@ 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]). + simple_one_for_one_extra/1, simple_one_for_one_shutdown/1]). %% Misc tests -export([child_unlink/1, tree/1, count_children_memory/1, @@ -77,7 +77,7 @@ all() -> {group, abnormal_termination}, child_unlink, tree, count_children_memory, do_not_save_start_parameters_for_temporary_children, do_not_save_child_specs_for_temporary_children, - simple_one_for_one_scale_many_temporary_children]. + simple_one_for_one_scale_many_temporary_children, temporary_bystander]. groups() -> [{sup_start, [], @@ -99,8 +99,8 @@ groups() -> {restart_one_for_all, [], [one_for_all, one_for_all_escalation]}, {restart_simple_one_for_one, [], - [simple_one_for_one, simple_one_for_one_extra, - simple_one_for_one_escalation]}, + [simple_one_for_one, simple_one_for_one_shutdown, + simple_one_for_one_extra, simple_one_for_one_escalation]}, {restart_rest_for_one, [], [rest_for_one, rest_for_one_escalation]}]. @@ -209,8 +209,8 @@ sup_start_fail(Config) when is_list(Config) -> %%------------------------------------------------------------------------- sup_stop_infinity(doc) -> - ["See sup_stop/1 when Shutdown = infinity, this walue is only allowed " - "for children of type supervisor"]; + ["See sup_stop/1 when Shutdown = infinity, this walue is allowed " + "for children of type supervisor _AND_ worker"]; sup_stop_infinity(suite) -> []; sup_stop_infinity(Config) when is_list(Config) -> @@ -221,12 +221,13 @@ sup_stop_infinity(Config) when is_list(Config) -> Child2 = {child2, {supervisor_1, start_child, []}, permanent, infinity, worker, []}, {ok, CPid1} = supervisor:start_child(sup_test, Child1), + {ok, CPid2} = supervisor:start_child(sup_test, Child2), link(CPid1), - {error, {invalid_shutdown,infinity}} = - supervisor:start_child(sup_test, Child2), + link(CPid2), terminate(Pid, shutdown), - check_exit_reason(CPid1, shutdown). + check_exit_reason(CPid1, shutdown), + check_exit_reason(CPid2, shutdown). %%------------------------------------------------------------------------- @@ -458,9 +459,8 @@ child_specs(Config) when is_list(Config) -> B2 = {child, {m,f,[a]}, prmanent, 1000, worker, []}, B3 = {child, {m,f,[a]}, permanent, -10, worker, []}, B4 = {child, {m,f,[a]}, permanent, 10, wrker, []}, - 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]}, + B5 = {child, {m,f,[a]}, permanent, 1000, worker, dy}, + B6 = {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 @@ -469,6 +469,7 @@ child_specs(Config) when is_list(Config) -> C2 = {child, {m,f,[a]}, permanent, 1000, supervisor, []}, C3 = {child, {m,f,[a]}, temporary, 1000, worker, dynamic}, C4 = {child, {m,f,[a]}, transient, 1000, worker, [m]}, + C5 = {child, {m,f,[a]}, permanent, infinity, worker, [m]}, {error, {invalid_mfa,mfa}} = supervisor:start_child(sup_test, B1), {error, {invalid_restart_type, prmanent}} = @@ -477,9 +478,8 @@ child_specs(Config) when is_list(Config) -> = supervisor:start_child(sup_test, B3), {error, {invalid_child_type,wrker}} = supervisor:start_child(sup_test, B4), - {error, _} = supervisor:start_child(sup_test, B5), {error, {invalid_modules,dy}} - = supervisor:start_child(sup_test, B6), + = supervisor:start_child(sup_test, B5), {error, {invalid_mfa,mfa}} = supervisor:check_childspecs([B1]), {error, {invalid_restart_type,prmanent}} = @@ -487,15 +487,15 @@ child_specs(Config) when is_list(Config) -> {error, {invalid_shutdown,-10}} = supervisor:check_childspecs([B3]), {error, {invalid_child_type,wrker}} = supervisor:check_childspecs([B4]), - {error, _} = supervisor:check_childspecs([B5]), - {error, {invalid_modules,dy}} = supervisor:check_childspecs([B6]), + {error, {invalid_modules,dy}} = supervisor:check_childspecs([B5]), {error, {invalid_module, 1}} = - supervisor:check_childspecs([B7]), + supervisor:check_childspecs([B6]), ok = supervisor:check_childspecs([C1]), ok = supervisor:check_childspecs([C2]), ok = supervisor:check_childspecs([C3]), ok = supervisor:check_childspecs([C4]), + ok = supervisor:check_childspecs([C5]), ok. %%------------------------------------------------------------------------- @@ -693,6 +693,37 @@ temporary_abnormal(Config) when is_list(Config) -> [0,0,0,0] = get_child_counts(sup_test). %%------------------------------------------------------------------------- +temporary_bystander(doc) -> + ["A temporary process killed as part of a rest_for_one or one_for_all " + "restart strategy should not be restarted given its args are not " + " saved. Otherwise the supervisor hits its limit and crashes."]; +temporary_bystander(suite) -> []; +temporary_bystander(_Config) -> + Child1 = {child1, {supervisor_1, start_child, []}, permanent, 100, + worker, []}, + Child2 = {child2, {supervisor_1, start_child, []}, temporary, 100, + worker, []}, + {ok, SupPid1} = supervisor:start_link(?MODULE, {ok, {{one_for_all, 2, 300}, []}}), + {ok, SupPid2} = supervisor:start_link(?MODULE, {ok, {{rest_for_one, 2, 300}, []}}), + unlink(SupPid1), % otherwise we crash with it + unlink(SupPid2), % otherwise we crash with it + {ok, CPid1} = supervisor:start_child(SupPid1, Child1), + {ok, _CPid2} = supervisor:start_child(SupPid1, Child2), + {ok, CPid3} = supervisor:start_child(SupPid2, Child1), + {ok, _CPid4} = supervisor:start_child(SupPid2, Child2), + terminate(SupPid1, CPid1, child1, normal), + terminate(SupPid2, CPid3, child1, normal), + timer:sleep(350), + catch link(SupPid1), + catch link(SupPid2), + %% The supervisor would die attempting to restart child2 + true = erlang:is_process_alive(SupPid1), + true = erlang:is_process_alive(SupPid2), + %% Child2 has not been restarted + [{child1, _, _, _}] = supervisor:which_children(SupPid1), + [{child1, _, _, _}] = supervisor:which_children(SupPid2). + +%%------------------------------------------------------------------------- one_for_one(doc) -> ["Test the one_for_one base case."]; one_for_one(suite) -> []; @@ -837,6 +868,38 @@ simple_one_for_one(Config) when is_list(Config) -> terminate(SupPid, Pid4, Id4, abnormal), check_exit([SupPid]). + +%%------------------------------------------------------------------------- +simple_one_for_one_shutdown(doc) -> + ["Test simple_one_for_one children shutdown accordingly to the " + "supervisor's shutdown strategy."]; +simple_one_for_one_shutdown(suite) -> []; +simple_one_for_one_shutdown(Config) when is_list(Config) -> + process_flag(trap_exit, true), + ShutdownTime = 1000, + Child = {child, {supervisor_2, start_child, []}, + permanent, 2*ShutdownTime, worker, []}, + {ok, SupPid} = start_link({ok, {{simple_one_for_one, 2, 3600}, [Child]}}), + + %% Will be gracefully shutdown + {ok, _CPid1} = supervisor:start_child(sup_test, [ShutdownTime]), + {ok, _CPid2} = supervisor:start_child(sup_test, [ShutdownTime]), + + %% Will be killed after 2*ShutdownTime milliseconds + {ok, _CPid3} = supervisor:start_child(sup_test, [5*ShutdownTime]), + + {T, ok} = timer:tc(fun terminate/2, [SupPid, shutdown]), + if T < 1000*ShutdownTime -> + %% Because supervisor's children wait before exiting, it can't + %% terminate quickly + test_server:fail({shutdown_too_short, T}); + T >= 1000*5*ShutdownTime -> + test_server:fail({shutdown_too_long, T}); + true -> + check_exit([SupPid]) + end. + + %%------------------------------------------------------------------------- simple_one_for_one_extra(doc) -> ["Tests automatic restart of children " diff --git a/lib/stdlib/test/supervisor_bridge_SUITE.erl b/lib/stdlib/test/supervisor_bridge_SUITE.erl index f2dbad0b3b..c4d696564d 100644 --- a/lib/stdlib/test/supervisor_bridge_SUITE.erl +++ b/lib/stdlib/test/supervisor_bridge_SUITE.erl @@ -158,7 +158,7 @@ internal_loop(State) -> terminate(Reason,{Parent,Worker}) -> %% This func knows about supervisor_bridge io:format("Terminating bridge...\n"), - exit(kill,Worker), + exit(Worker,kill), Parent ! {dying,Reason}, anything. diff --git a/lib/stdlib/test/sys_SUITE.erl b/lib/stdlib/test/sys_SUITE.erl index 72b089aa3f..fe039e8bcc 100644 --- a/lib/stdlib/test/sys_SUITE.erl +++ b/lib/stdlib/test/sys_SUITE.erl @@ -71,7 +71,7 @@ log_to_file(Config) when is_list(Config) -> ?line ok = sys:log_to_file(?server,TempName), ?line {ok,-44} = public_call(44), ?line ok = sys:log_to_file(?server,false), - ?line {ok,Fd} = file:open(TempName,read), + ?line {ok,Fd} = file:open(TempName,[read]), ?line Msg1 = io:get_line(Fd,''), ?line Msg2 = io:get_line(Fd,''), ?line file:close(Fd), diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl index e32704ca65..9ad3936928 100644 --- a/lib/stdlib/test/tar_SUITE.erl +++ b/lib/stdlib/test/tar_SUITE.erl @@ -65,7 +65,7 @@ borderline(Config) when is_list(Config) -> ?line {ok, Cwd} = file:get_cwd(), ?line RootDir = ?config(priv_dir, Config), - ?line TempDir = remove_prefix(Cwd++"/", filename:join(RootDir, borderline)), + ?line TempDir = remove_prefix(Cwd++"/", filename:join(RootDir, "borderline")), ?line ok = file:make_dir(TempDir), ?line Record = 512, @@ -283,17 +283,16 @@ long_names(doc) -> long_names(Config) when is_list(Config) -> ?line DataDir = ?config(data_dir, Config), ?line Long = filename:join(DataDir, "long_names.tar"), + run_in_short_tempdir(Config, + fun() -> do_long_names(Long) end). +do_long_names(Long) -> %% Try table/2 and extract/2. ?line case erl_tar:table(Long, [verbose]) of {ok,List} when is_list(List) -> ?line io:format("~p\n", [List]) end, - - %% To avoid getting too long paths for Windows to handle, extract into - %% the current directory (which is the test_server directory). Its path - %% is quite a bit shorter than the path to priv_dir. ?line {ok,Cwd} = file:get_cwd(), ?line ok = erl_tar:extract(Long), ?line Base = filename:join([Cwd, "original_software", "written_by", @@ -312,29 +311,28 @@ long_names(Config) when is_list(Config) -> ?line "Here"++_ = binary_to_list(First), ?line "And"++_ = binary_to_list(Second), - %% Clean up. - ?line delete_files([filename:join(Cwd, "original_software"),EmptyDir]), - ok. create_long_names(doc) -> ["Creates a tar file from a deep directory structure (filenames are ", "longer than 100 characters)."]; create_long_names(Config) when is_list(Config) -> - ?line PrivDir = ?config(priv_dir, Config), - ?line ok = file:set_cwd(PrivDir), - Dirs = [aslfjkshjkhliuf, - asdhjfehnbfsky, - sahajfskdfhsz, - asldfkdlfy4y8rchg, - f7nafhjgffagkhsfkhsjk, - dfjasldkfjsdkfjashbv], + run_in_short_tempdir(Config, fun create_long_names/0). + +create_long_names() -> + ?line {ok,Dir} = file:get_cwd(), + Dirs = ["aslfjkshjkhliuf", + "asdhjfehnbfsky", + "sahajfskdfhsz", + "asldfkdlfy4y8rchg", + "f7nafhjgffagkhsfkhsjk", + "dfjasldkfjsdkfjashbv"], ?line DeepDir = make_dirs(Dirs, []), ?line AFile = filename:join(DeepDir, "a_file"), ?line Hello = "hello, world\n", ?line ok = file:write_file(AFile, Hello), - ?line TarName = filename:join(PrivDir, "my_tar_with_long_names.tar"), + ?line TarName = filename:join(Dir, "my_tar_with_long_names.tar"), ?line ok = erl_tar:create(TarName, [AFile]), %% Print contents. @@ -347,9 +345,6 @@ create_long_names(Config) when is_list(Config) -> ?line {ok, Bin} = file:read_file(filename:join(ExtractDir, AFile)), ?line Hello = binary_to_list(Bin), - %% Clean up. - ?line delete_files([ExtractDir,TarName,hd(Dirs)]), - ok. make_dirs([Dir|Rest], []) -> @@ -487,7 +482,7 @@ extract_from_binary_compressed(Config) when is_list(Config) -> %% Trying extracting from a binary. ?line ok = erl_tar:extract({binary,Bin}, [compressed,{cwd,ExtractDir}]), - ?line {ok,List} = file:list_dir(filename:join(ExtractDir, ddll_SUITE_data)), + ?line {ok,List} = file:list_dir(filename:join(ExtractDir, "ddll_SUITE_data")), ?line io:format("~p\n", [List]), ?line 19 = length(List), @@ -676,7 +671,7 @@ cooked_compressed(Config) when is_list(Config) -> end, List), %% Clean up. - ?line delete_files([filename:join(PrivDir, ddll_SUITE_data)]), + ?line delete_files([filename:join(PrivDir, "ddll_SUITE_data")]), ok. memory(doc) -> @@ -734,3 +729,42 @@ delete_files([Item|Rest]) -> end, delete_files(Rest). +%% Move to a temporary directory with as short name as possible and +%% execute Fun. Remove the directory and any files in it afterwards. +%% This is necessary because pathnames on Windows may be limited to +%% 260 characters. +run_in_short_tempdir(Config, Fun) -> + {ok,Cwd} = file:get_cwd(), + PrivDir0 = ?config(priv_dir, Config), + + %% Normalize name to make sure that there is no slash at the end. + PrivDir = filename:absname(PrivDir0), + + %% We need a base directory with a much shorter pathname than + %% priv_dir. We KNOW that priv_dir is located four levels below + %% the directory that common_test puts the ct_run.* directories + %% in. That fact is not documented, but an usually reliable source + %% assured me that the directory structure is unlikely to change + %% in future versions of common_test because of backward + %% compatibility (tools developed by users of common_test depend + %% on the current directory layout). + Base = lists:foldl(fun(_, D) -> + filename:dirname(D) + end, PrivDir, [1,2,3,4]), + + Dir = make_temp_dir(Base, 0), + ok = file:set_cwd(Dir), + io:format("Running test in ~s\n", [Dir]), + try + Fun() + after + file:set_cwd(Cwd), + delete_files([Dir]) + end. + +make_temp_dir(Base, I) -> + Name = filename:join(Base, integer_to_list(I, 36)), + case file:make_dir(Name) of + ok -> Name; + {error,eexist} -> make_temp_dir(Base, I+1) + end. diff --git a/lib/stdlib/test/unicode_SUITE.erl b/lib/stdlib/test/unicode_SUITE.erl index 9aa800209d..4055af2741 100644 --- a/lib/stdlib/test/unicode_SUITE.erl +++ b/lib/stdlib/test/unicode_SUITE.erl @@ -322,7 +322,7 @@ roundtrips(Config) when is_list(Config) -> ex_roundtrips(Config) when is_list(Config) -> ?line L1 = ranges(0, 16#D800 - 1, erlang:system_info(context_reductions) * 11), - ?line L2 = ranges(16#DFFF + 1, 16#FFFE - 1, + ?line L2 = ranges(16#DFFF + 1, 16#10000 - 1, erlang:system_info(context_reductions) * 11), %?line L3 = ranges(16#FFFF + 1, 16#10FFFF, % erlang:system_info(context_reductions) * 11), @@ -569,7 +569,6 @@ utf16_illegal_sequences_bif(Config) when is_list(Config) -> ex_utf16_illegal_sequences_bif(Config) when is_list(Config) -> ?line utf16_fail_range_bif_simple(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line utf16_fail_range_bif(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line utf16_fail_range_bif(16#FFFE, 16#FFFF), %Non-characters. ?line lonely_hi_surrogate_bif(16#D800, 16#DBFF,incomplete), ?line lonely_hi_surrogate_bif(16#DC00, 16#DFFF,error), @@ -644,7 +643,6 @@ utf8_illegal_sequences_bif(Config) when is_list(Config) -> ex_utf8_illegal_sequences_bif(Config) when is_list(Config) -> ?line fail_range_bif(16#10FFFF+1, 16#10FFFF+512), %Too large. ?line fail_range_bif(16#D800, 16#DFFF), %Reserved for UTF-16. - ?line fail_range_bif(16#FFFE, 16#FFFF), %Reserved (BOM). %% Illegal first character. ?line [fail_bif(<<I,16#8F,16#8F,16#8F>>,unicode) || I <- lists:seq(16#80, 16#BF)], diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl index d5f2cd52d4..7233c061ef 100644 --- a/lib/stdlib/test/zip_SUITE.erl +++ b/lib/stdlib/test/zip_SUITE.erl @@ -375,7 +375,8 @@ zip_options(Config) when is_list(Config) -> ok = file:set_cwd(?config(data_dir, Config)), %% Create a zip archive - {ok, Zip} = zip:zip("filename_not_used.zip", Names, [memory, {cwd, PrivDir}]), + {ok, {_,Zip}} = + zip:zip("filename_not_used.zip", Names, [memory, {cwd, PrivDir}]), %% Open archive {ok, ZipSrv} = zip:zip_open(Zip, [memory]), |