aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib/test
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stdlib/test')
-rw-r--r--lib/stdlib/test/base64_SUITE.erl2
-rw-r--r--lib/stdlib/test/edlin_expand_SUITE.erl79
-rw-r--r--lib/stdlib/test/ets_SUITE.erl217
-rw-r--r--lib/stdlib/test/ets_tough_SUITE.erl58
-rw-r--r--lib/stdlib/test/filename_SUITE.erl69
-rw-r--r--lib/stdlib/test/gen_statem_SUITE.erl105
-rw-r--r--lib/stdlib/test/io_SUITE.erl262
-rw-r--r--lib/stdlib/test/lists_SUITE.erl2
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl18
-rw-r--r--lib/stdlib/test/random_iolist.erl38
-rw-r--r--lib/stdlib/test/random_unicode_list.erl38
-rw-r--r--lib/stdlib/test/re_testoutput1_replacement_test.erl2
-rw-r--r--lib/stdlib/test/re_testoutput1_split_test.erl2
-rw-r--r--lib/stdlib/test/run_pcre_tests.erl73
-rw-r--r--lib/stdlib/test/sofs_SUITE.erl9
-rw-r--r--lib/stdlib/test/tar_SUITE.erl178
-rw-r--r--lib/stdlib/test/tar_SUITE_data/bsd.tarbin0 -> 9216 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/gnu.tarbin0 -> 30720 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/pax_mtime.tarbin0 -> 10240 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/sparse00.tarbin0 -> 61440 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/sparse01.tarbin0 -> 61440 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/sparse01_empty.tarbin0 -> 10240 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/sparse10.tarbin0 -> 61440 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/sparse10_empty.tarbin0 -> 10240 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/star.tarbin0 -> 10240 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/v7.tarbin0 -> 10240 bytes
-rw-r--r--lib/stdlib/test/zip_SUITE.erl36
27 files changed, 822 insertions, 366 deletions
diff --git a/lib/stdlib/test/base64_SUITE.erl b/lib/stdlib/test/base64_SUITE.erl
index d0abe5c961..6ddc67464c 100644
--- a/lib/stdlib/test/base64_SUITE.erl
+++ b/lib/stdlib/test/base64_SUITE.erl
@@ -82,7 +82,7 @@ base64_decode(Config) when is_list(Config) ->
Alphabet = list_to_binary(lists:seq(0, 255)),
Alphabet = base64:decode(base64:encode(Alphabet)),
- %% Encoded base 64 strings may be devided by non base 64 chars.
+ %% Encoded base 64 strings may be divided by non base 64 chars.
%% In this cases whitespaces.
"0123456789!@#0^&*();:<>,. []{}" =
base64:decode_to_string(
diff --git a/lib/stdlib/test/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl
index 718d91c6a3..1f694ea549 100644
--- a/lib/stdlib/test/edlin_expand_SUITE.erl
+++ b/lib/stdlib/test/edlin_expand_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -21,7 +21,8 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_testcase/2, end_per_testcase/2,
init_per_group/2,end_per_group/2]).
--export([normal/1, quoted_fun/1, quoted_module/1, quoted_both/1, erl_1152/1]).
+-export([normal/1, quoted_fun/1, quoted_module/1, quoted_both/1, erl_1152/1,
+ erl_352/1]).
-include_lib("common_test/include/ct.hrl").
@@ -36,7 +37,7 @@ suite() ->
{timetrap,{minutes,1}}].
all() ->
- [normal, quoted_fun, quoted_module, quoted_both, erl_1152].
+ [normal, quoted_fun, quoted_module, quoted_both, erl_1152, erl_352].
groups() ->
[].
@@ -153,6 +154,78 @@ erl_1152(Config) when is_list(Config) ->
"\n"++"foo"++" "++[1089]++_ = do_format(["foo",[1089]]),
ok.
+erl_352(Config) when is_list(Config) ->
+ erl_352_test(3, 3),
+
+ erl_352_test(3, 75),
+ erl_352_test(3, 76, [trailing]),
+ erl_352_test(4, 74),
+ erl_352_test(4, 75, [leading]),
+ erl_352_test(4, 76, [leading, trailing]),
+
+ erl_352_test(75, 3),
+ erl_352_test(76, 3, [leading]),
+ erl_352_test(74, 4),
+ erl_352_test(75, 4, [leading]),
+ erl_352_test(76, 4, [leading]),
+
+ erl_352_test(74, 74, [leading]),
+ erl_352_test(74, 75, [leading]),
+ erl_352_test(74, 76, [leading, trailing]).
+
+erl_352_test(PrefixLen, SuffixLen) ->
+ erl_352_test(PrefixLen, SuffixLen, []).
+
+erl_352_test(PrefixLen, SuffixLen, Dots) ->
+ io:format("\nPrefixLen = ~w, SuffixLen = ~w\n", [PrefixLen, SuffixLen]),
+
+ PrefixM = lists:duplicate(PrefixLen, $p),
+ SuffixM = lists:duplicate(SuffixLen, $s),
+ LM = [PrefixM ++ S ++ SuffixM || S <- ["1", "2"]],
+ StrM = do_format(LM),
+ check_leading(StrM, "", PrefixM, SuffixM, Dots),
+
+ PrefixF = lists:duplicate(PrefixLen, $p),
+ SuffixF = lists:duplicate(SuffixLen-2, $s),
+ LF = [{PrefixF ++ S ++ SuffixF, 1} || S <- ["1", "2"]],
+ StrF = do_format(LF),
+ true = check_leading(StrF, "/1", PrefixF, SuffixF, Dots),
+
+ ok.
+
+check_leading(FormStr, ArityStr, Prefix, Suffix, Dots) ->
+ List = string:tokens(FormStr, "\n "),
+ io:format("~p\n", [List]),
+ true = lists:all(fun(L) -> length(L) < 80 end, List),
+ case lists:member(leading, Dots) of
+ true ->
+ true = lists:all(fun(L) ->
+ {"...", Rest} = lists:split(3, L),
+ check_trailing(Rest, ArityStr,
+ Suffix, Dots)
+ end, List);
+ false ->
+ true = lists:all(fun(L) ->
+ {Prefix, Rest} =
+ lists:split(length(Prefix), L),
+ check_trailing(Rest, ArityStr,
+ Suffix, Dots)
+ end, List)
+ end.
+
+check_trailing([I|Str], ArityStr, Suffix, Dots) ->
+ true = lists:member(I, [$1, $2]),
+ case lists:member(trailing, Dots) of
+ true ->
+ {Rest, "..." ++ ArityStr} =
+ lists:split(length(Str) - (3 + length(ArityStr)), Str),
+ true = lists:prefix(Rest, Suffix);
+ false ->
+ {Rest, ArityStr} =
+ lists:split(length(Str) - length(ArityStr), Str),
+ Rest =:= Suffix
+ end.
+
do_expand(String) ->
edlin_expand:expand(lists:reverse(String)).
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index f68d5eca3f..8581440d58 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_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]).
-export([default/1,setbag/1,badnew/1,verybadnew/1,named/1,keypos2/1,
- privacy/1,privacy_owner/2]).
+ privacy/1]).
-export([empty/1,badinsert/1]).
-export([time_lookup/1,badlookup/1,lookup_order/1]).
-export([delete_elem/1,delete_tab/1,delete_large_tab/1,
@@ -82,27 +82,6 @@
%% Convenience for manual testing
-export([random_test/0]).
-%% internal exports
--export([dont_make_worse_sub/0, make_better_sub1/0, make_better_sub2/0]).
--export([t_repair_continuation_do/1, t_bucket_disappears_do/1,
- select_fail_do/1, whitebox_1/1, whitebox_2/1, t_delete_all_objects_do/1,
- t_delete_object_do/1, t_init_table_do/1, t_insert_list_do/1,
- update_element_opts/1, update_element_opts/4, update_element/4, update_element_do/4,
- update_element_neg/1, update_element_neg_do/1, update_counter_do/1, update_counter_neg/1,
- evil_update_counter_do/1, fixtable_next_do/1, heir_do/1, give_away_do/1, setopts_do/1,
- rename_do/1, rename_unnamed_do/1, interface_equality_do/1, ordered_match_do/1,
- ordered_do/1, privacy_do/1, empty_do/1, badinsert_do/1, time_lookup_do/1,
- lookup_order_do/1, lookup_element_mult_do/1, delete_tab_do/1, delete_elem_do/1,
- match_delete_do/1, match_delete3_do/1, firstnext_do/1,
- slot_do/1, match1_do/1, match2_do/1, match_object_do/1, match_object2_do/1,
- misc1_do/1, safe_fixtable_do/1, info_do/1, dups_do/1, heavy_lookup_do/1,
- heavy_lookup_element_do/1, member_do/1, otp_5340_do/1, otp_7665_do/1, meta_wb_do/1,
- do_heavy_concurrent/1, tab2file2_do/2, exit_large_table_owner_do/2,
- types_do/1, sleeper/0, memory_do/1, update_counter_with_default_do/1,
- update_counter_table_growth_do/1,
- ms_tracee_dummy/1, ms_tracee_dummy/2, ms_tracee_dummy/3, ms_tracee_dummy/4
- ]).
-
-export([t_select_reverse/1]).
-include_lib("common_test/include/ct.hrl").
@@ -228,7 +207,7 @@ memory_check_summary(_Config) ->
%% Test that a disappearing bucket during select of a non-fixed table works.
t_bucket_disappears(Config) when is_list(Config) ->
- repeat_for_opts(t_bucket_disappears_do).
+ repeat_for_opts(fun t_bucket_disappears_do/1).
t_bucket_disappears_do(Opts) ->
EtsMem = etsmem(),
@@ -396,11 +375,16 @@ ms_tracer_collect(Tracee, Ref, Acc) ->
ms_tracee(Parent, CallArgList) ->
Parent ! {self(), ready},
receive start -> ok end,
- lists:foreach(fun(Args) ->
- erlang:apply(?MODULE, ms_tracee_dummy, tuple_to_list(Args))
- end, CallArgList).
-
-
+ F = fun({A1}) ->
+ ms_tracee_dummy(A1);
+ ({A1,A2}) ->
+ ms_tracee_dummy(A1, A2);
+ ({A1,A2,A3}) ->
+ ms_tracee_dummy(A1, A2, A3);
+ ({A1,A2,A3,A4}) ->
+ ms_tracee_dummy(A1, A2, A3, A4)
+ end,
+ lists:foreach(F, CallArgList).
ms_tracee_dummy(_) -> ok.
ms_tracee_dummy(_,_) -> ok.
@@ -418,7 +402,7 @@ assert_eq(A,B) ->
%% Test ets:repair_continuation/2.
t_repair_continuation(Config) when is_list(Config) ->
- repeat_for_opts(t_repair_continuation_do).
+ repeat_for_opts(fun t_repair_continuation_do/1).
t_repair_continuation_do(Opts) ->
@@ -564,7 +548,8 @@ default(Config) when is_list(Config) ->
%% Test that select fails even if nothing can match.
select_fail(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(select_fail_do, [all_types,write_concurrency]),
+ repeat_for_opts(fun select_fail_do/1,
+ [all_types,write_concurrency]),
verify_etsmem(EtsMem).
select_fail_do(Opts) ->
@@ -594,7 +579,7 @@ select_fail_do(Opts) ->
%% Whitebox test of ets:info(X, memory).
memory(Config) when is_list(Config) ->
ok = chk_normal_tab_struct_size(),
- repeat_for_opts(memory_do,[compressed]),
+ repeat_for_opts(fun memory_do/1, [compressed]),
catch erts_debug:set_internal_state(available_internal_state, false).
memory_do(Opts) ->
@@ -704,12 +689,12 @@ adjust_xmem([_T1,_T2,_T3,_T4], {A0,B0,C0,D0} = _Mem0, EstCnt) ->
%% Misc. whitebox tests
t_whitebox(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(whitebox_1),
- repeat_for_opts(whitebox_1),
- repeat_for_opts(whitebox_1),
- repeat_for_opts(whitebox_2),
- repeat_for_opts(whitebox_2),
- repeat_for_opts(whitebox_2),
+ repeat_for_opts(fun whitebox_1/1),
+ repeat_for_opts(fun whitebox_1/1),
+ repeat_for_opts(fun whitebox_1/1),
+ repeat_for_opts(fun whitebox_2/1),
+ repeat_for_opts(fun whitebox_2/1),
+ repeat_for_opts(fun whitebox_2/1),
verify_etsmem(EtsMem).
whitebox_1(Opts) ->
@@ -774,7 +759,7 @@ check_badarg({'EXIT', {badarg, [{M,F,A,_} | _]}}, M, F, Args) ->
%% Test ets:delete_all_objects/1.
t_delete_all_objects(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(t_delete_all_objects_do),
+ repeat_for_opts(fun t_delete_all_objects_do/1),
verify_etsmem(EtsMem).
get_kept_objects(T) ->
@@ -808,7 +793,7 @@ t_delete_all_objects_do(Opts) ->
%% Test ets:delete_object/2.
t_delete_object(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(t_delete_object_do),
+ repeat_for_opts(fun t_delete_object_do/1),
verify_etsmem(EtsMem).
t_delete_object_do(Opts) ->
@@ -881,7 +866,7 @@ make_init_fun(N) ->
%% Test ets:init_table/2.
t_init_table(Config) when is_list(Config)->
EtsMem = etsmem(),
- repeat_for_opts(t_init_table_do),
+ repeat_for_opts(fun t_init_table_do/1),
verify_etsmem(EtsMem).
t_init_table_do(Opts) ->
@@ -957,7 +942,7 @@ t_insert_new(Config) when is_list(Config) ->
%% Test ets:insert/2 with list of objects.
t_insert_list(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(t_insert_list_do),
+ repeat_for_opts(fun t_insert_list_do/1),
verify_etsmem(EtsMem).
t_insert_list_do(Opts) ->
@@ -1187,7 +1172,7 @@ partly_bound(Config) when is_list(Config) ->
end.
dont_make_worse() ->
- seventyfive_percent_success({?MODULE,dont_make_worse_sub,[]},0,0,10).
+ seventyfive_percent_success(fun dont_make_worse_sub/0, 0, 0, 10).
dont_make_worse_sub() ->
T = build_table([a,b],[a,b],15000),
@@ -1199,8 +1184,9 @@ dont_make_worse_sub() ->
ok.
make_better() ->
- fifty_percent_success({?MODULE,make_better_sub2,[]},0,0,10),
- fifty_percent_success({?MODULE,make_better_sub1,[]},0,0,10).
+ fifty_percent_success(fun make_better_sub2/0, 0, 0, 10),
+ fifty_percent_success(fun make_better_sub1/0, 0, 0, 10).
+
make_better_sub1() ->
T = build_table2([a,b],[a,b],15000),
T1 = time_match_object(T,{'_',1500,a,a}, [{{1500,a,a},1500,a,a}]),
@@ -1485,7 +1471,7 @@ do_random_test() ->
%% Ttest various variants of update_element.
update_element(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(update_element_opts),
+ repeat_for_opts(fun update_element_opts/1),
verify_etsmem(EtsMem).
update_element_opts(Opts) ->
@@ -1647,7 +1633,7 @@ update_element_neg_do(T) ->
%% test various variants of update_counter.
update_counter(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(update_counter_do),
+ repeat_for_opts(fun update_counter_do/1),
verify_etsmem(EtsMem).
update_counter_do(Opts) ->
@@ -1868,7 +1854,7 @@ evil_update_counter(Config) when is_list(Config) ->
ordsets:module_info(),
rand:module_info(),
- repeat_for_opts(evil_update_counter_do).
+ repeat_for_opts(fun evil_update_counter_do/1).
evil_update_counter_do(Opts) ->
EtsMem = etsmem(),
@@ -1915,7 +1901,7 @@ evil_counter_1(Iter, T) ->
evil_counter_1(Iter-1, T).
update_counter_with_default(Config) when is_list(Config) ->
- repeat_for_opts(update_counter_with_default_do).
+ repeat_for_opts(fun update_counter_with_default_do/1).
update_counter_with_default_do(Opts) ->
T1 = ets_new(a, [set | Opts]),
@@ -1953,7 +1939,7 @@ update_counter_with_default_do(Opts) ->
ok.
update_counter_table_growth(_Config) ->
- repeat_for_opts(update_counter_table_growth_do).
+ repeat_for_opts(fun update_counter_table_growth_do/1).
update_counter_table_growth_do(Opts) ->
Set = ets_new(b, [set | Opts]),
@@ -1964,7 +1950,8 @@ update_counter_table_growth_do(Opts) ->
%% Check that a first-next sequence always works on a fixed table.
fixtable_next(Config) when is_list(Config) ->
- repeat_for_opts(fixtable_next_do, [write_concurrency,all_types]).
+ repeat_for_opts(fun fixtable_next_do/1,
+ [write_concurrency,all_types]).
fixtable_next_do(Opts) ->
EtsMem = etsmem(),
@@ -2104,7 +2091,7 @@ write_concurrency(Config) when is_list(Config) ->
%% The 'heir' option.
heir(Config) when is_list(Config) ->
- repeat_for_opts(heir_do).
+ repeat_for_opts(fun heir_do/1).
heir_do(Opts) ->
EtsMem = etsmem(),
@@ -2244,7 +2231,7 @@ heir_1(HeirData,Mode,Opts) ->
%% Test ets:give_way/3.
give_away(Config) when is_list(Config) ->
- repeat_for_opts(give_away_do).
+ repeat_for_opts(fun give_away_do/1).
give_away_do(Opts) ->
T = ets_new(foo,[named_table, private | Opts]),
@@ -2325,7 +2312,7 @@ give_away_receiver(T, Giver) ->
%% Test ets:setopts/2.
setopts(Config) when is_list(Config) ->
- repeat_for_opts(setopts_do,[write_concurrency,all_types]).
+ repeat_for_opts(fun setopts_do/1, [write_concurrency,all_types]).
setopts_do(Opts) ->
Self = self(),
@@ -2475,7 +2462,7 @@ bad_table_call(T,{F,Args,_,{return,Return}}) ->
%% Check rename of ets tables.
rename(Config) when is_list(Config) ->
- repeat_for_opts(rename_do, [write_concurrency, all_types]).
+ repeat_for_opts(fun rename_do/1, [write_concurrency, all_types]).
rename_do(Opts) ->
EtsMem = etsmem(),
@@ -2490,7 +2477,8 @@ rename_do(Opts) ->
%% Check rename of unnamed ets table.
rename_unnamed(Config) when is_list(Config) ->
- repeat_for_opts(rename_unnamed_do,[write_concurrency,all_types]).
+ repeat_for_opts(fun rename_unnamed_do/1,
+ [write_concurrency,all_types]).
rename_unnamed_do(Opts) ->
EtsMem = etsmem(),
@@ -2565,7 +2553,7 @@ evil_create_fixed_tab() ->
%% Tests that the return values and errors are equal for set's and
%% ordered_set's where applicable.
interface_equality(Config) when is_list(Config) ->
- repeat_for_opts(interface_equality_do).
+ repeat_for_opts(fun interface_equality_do/1).
interface_equality_do(Opts) ->
EtsMem = etsmem(),
@@ -2629,7 +2617,7 @@ maybe_sort(Any) ->
%% Test match, match_object and match_delete in ordered set's.
ordered_match(Config) when is_list(Config)->
- repeat_for_opts(ordered_match_do).
+ repeat_for_opts(fun ordered_match_do/1).
ordered_match_do(Opts) ->
EtsMem = etsmem(),
@@ -2675,7 +2663,7 @@ ordered_match_do(Opts) ->
%% Test basic functionality in ordered_set's.
ordered(Config) when is_list(Config) ->
- repeat_for_opts(ordered_do).
+ repeat_for_opts(fun ordered_do/1).
ordered_do(Opts) ->
EtsMem = etsmem(),
@@ -2801,12 +2789,13 @@ keypos2(Config) when is_list(Config) ->
%% Privacy check. Check that a named(public/private/protected) table
%% cannot be read by the wrong process(es).
privacy(Config) when is_list(Config) ->
- repeat_for_opts(privacy_do).
+ repeat_for_opts(fun privacy_do/1).
privacy_do(Opts) ->
EtsMem = etsmem(),
process_flag(trap_exit,true),
- Owner = my_spawn_link(?MODULE,privacy_owner,[self(),Opts]),
+ Parent = self(),
+ Owner = my_spawn_link(fun() -> privacy_owner(Parent, Opts) end),
receive
{'EXIT',Owner,Reason} ->
exit({privacy_test,Reason});
@@ -2886,7 +2875,7 @@ rotate_tuple(Tuple, N) ->
%% Check lookup in an empty table and lookup of a non-existing key.
empty(Config) when is_list(Config) ->
- repeat_for_opts(empty_do).
+ repeat_for_opts(fun empty_do/1).
empty_do(Opts) ->
EtsMem = etsmem(),
@@ -2899,7 +2888,7 @@ empty_do(Opts) ->
%% Check proper return values for illegal insert operations.
badinsert(Config) when is_list(Config) ->
- repeat_for_opts(badinsert_do).
+ repeat_for_opts(fun badinsert_do/1).
badinsert_do(Opts) ->
EtsMem = etsmem(),
@@ -2923,7 +2912,7 @@ badinsert_do(Opts) ->
time_lookup(Config) when is_list(Config) ->
%% just for timing, really
EtsMem = etsmem(),
- Values = repeat_for_opts(time_lookup_do),
+ Values = repeat_for_opts(fun time_lookup_do/1),
verify_etsmem(EtsMem),
{comment,lists:flatten(io_lib:format(
"~p ets lookups/s",[Values]))}.
@@ -2957,7 +2946,8 @@ badlookup(Config) when is_list(Config) ->
%% Test that lookup returns objects in order of insertion for bag and dbag.
lookup_order(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(lookup_order_do, [write_concurrency,[bag,duplicate_bag]]),
+ repeat_for_opts(fun lookup_order_do/1,
+ [write_concurrency,[bag,duplicate_bag]]),
verify_etsmem(EtsMem),
ok.
@@ -3048,7 +3038,7 @@ fill_tab(Tab,Val) ->
%% OTP-2386. Multiple return elements.
lookup_element_mult(Config) when is_list(Config) ->
- repeat_for_opts(lookup_element_mult_do).
+ repeat_for_opts(fun lookup_element_mult_do/1).
lookup_element_mult_do(Opts) ->
EtsMem = etsmem(),
@@ -3086,7 +3076,8 @@ lem_crash_3(T) ->
%% Check delete of an element inserted in a `filled' table.
delete_elem(Config) when is_list(Config) ->
- repeat_for_opts(delete_elem_do, [write_concurrency, all_types]).
+ repeat_for_opts(fun delete_elem_do/1,
+ [write_concurrency, all_types]).
delete_elem_do(Opts) ->
EtsMem = etsmem(),
@@ -3103,7 +3094,8 @@ delete_elem_do(Opts) ->
%% Check that ets:delete() works and releases the name of the
%% deleted table.
delete_tab(Config) when is_list(Config) ->
- repeat_for_opts(delete_tab_do,[write_concurrency,all_types]).
+ repeat_for_opts(fun delete_tab_do/1,
+ [write_concurrency,all_types]).
delete_tab_do(Opts) ->
Name = foo,
@@ -3301,10 +3293,14 @@ exit_large_table_owner(Config) when is_list(Config) ->
end, 1)
end,
EtsMem = etsmem(),
- repeat_for_opts({exit_large_table_owner_do,{FEData,Config}}),
+ repeat_for_opts(fun(Opts) ->
+ exit_large_table_owner_do(Opts,
+ FEData,
+ Config)
+ end),
verify_etsmem(EtsMem).
-exit_large_table_owner_do(Opts,{FEData,Config}) ->
+exit_large_table_owner_do(Opts, FEData, Config) ->
verify_rescheduling_exit(Config, FEData, [named_table | Opts], true, 1, 1),
verify_rescheduling_exit(Config, FEData, Opts, false, 1, 1).
@@ -3472,7 +3468,8 @@ baddelete(Config) when is_list(Config) ->
%% Check that match_delete works. Also tests tab2list function.
match_delete(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(match_delete_do,[write_concurrency,all_types]),
+ repeat_for_opts(fun match_delete_do/1,
+ [write_concurrency,all_types]),
verify_etsmem(EtsMem).
match_delete_do(Opts) ->
@@ -3489,7 +3486,7 @@ match_delete_do(Opts) ->
%% OTP-3005: check match_delete with constant argument.
match_delete3(Config) when is_list(Config) ->
- repeat_for_opts(match_delete3_do).
+ repeat_for_opts(fun match_delete3_do/1).
match_delete3_do(Opts) ->
EtsMem = etsmem(),
@@ -3514,7 +3511,7 @@ match_delete3_do(Opts) ->
%% Test ets:first/1 & ets:next/2.
firstnext(Config) when is_list(Config) ->
- repeat_for_opts(firstnext_do).
+ repeat_for_opts(fun firstnext_do/1).
firstnext_do(Opts) ->
EtsMem = etsmem(),
@@ -3572,7 +3569,7 @@ dyn_lookup(T, K) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
slot(Config) when is_list(Config) ->
- repeat_for_opts(slot_do).
+ repeat_for_opts(fun slot_do/1).
slot_do(Opts) ->
EtsMem = etsmem(),
@@ -3597,7 +3594,7 @@ slot_loop(Tab,SlotNo,EltsSoFar) ->
match1(Config) when is_list(Config) ->
- repeat_for_opts(match1_do).
+ repeat_for_opts(fun match1_do/1).
match1_do(Opts) ->
EtsMem = etsmem(),
@@ -3633,7 +3630,7 @@ match1_do(Opts) ->
%% Test match with specified keypos bag table.
match2(Config) when is_list(Config) ->
- repeat_for_opts(match2_do).
+ repeat_for_opts(fun match2_do/1).
match2_do(Opts) ->
EtsMem = etsmem(),
@@ -3660,7 +3657,7 @@ match2_do(Opts) ->
%% Some ets:match_object tests.
match_object(Config) when is_list(Config) ->
- repeat_for_opts(match_object_do).
+ repeat_for_opts(fun match_object_do/1).
match_object_do(Opts) ->
EtsMem = etsmem(),
@@ -3760,7 +3757,7 @@ match_object_do(Opts) ->
%% Tests that db_match_object does not generate a `badarg' when
%% resuming a search with no previous matches.
match_object2(Config) when is_list(Config) ->
- repeat_for_opts(match_object2_do).
+ repeat_for_opts(fun match_object2_do/1).
match_object2_do(Opts) ->
EtsMem = etsmem(),
@@ -3796,7 +3793,7 @@ tab2list(Config) when is_list(Config) ->
%% Simple general small test. If this fails, ets is in really bad
%% shape.
misc1(Config) when is_list(Config) ->
- repeat_for_opts(misc1_do).
+ repeat_for_opts(fun misc1_do/1).
misc1_do(Opts) ->
EtsMem = etsmem(),
@@ -3814,7 +3811,7 @@ misc1_do(Opts) ->
%% Check the safe_fixtable function.
safe_fixtable(Config) when is_list(Config) ->
- repeat_for_opts(safe_fixtable_do).
+ repeat_for_opts(fun safe_fixtable_do/1).
safe_fixtable_do(Opts) ->
EtsMem = etsmem(),
@@ -3872,7 +3869,7 @@ safe_fixtable_do(Opts) ->
%% Tests ets:info result for required tuples.
info(Config) when is_list(Config) ->
- repeat_for_opts(info_do).
+ repeat_for_opts(fun info_do/1).
info_do(Opts) ->
EtsMem = etsmem(),
@@ -3904,7 +3901,7 @@ info_do(Opts) ->
%% Test various duplicate_bags stuff.
dups(Config) when is_list(Config) ->
- repeat_for_opts(dups_do).
+ repeat_for_opts(fun dups_do/1).
dups_do(Opts) ->
EtsMem = etsmem(),
@@ -3970,7 +3967,9 @@ tab2file_do(FName, Opts) ->
%% Check the ets:tab2file function on a filled set/bag type ets table.
tab2file2(Config) when is_list(Config) ->
- repeat_for_opts({tab2file2_do,Config}, [[set,bag],compressed]).
+ repeat_for_opts(fun(Opts) ->
+ tab2file2_do(Opts, Config)
+ end, [[set,bag],compressed]).
tab2file2_do(Opts, Config) ->
EtsMem = etsmem(),
@@ -4234,7 +4233,7 @@ make_sub_binary(List, Num) when is_list(List) ->
%% Perform multiple lookups for every key in a large table.
heavy_lookup(Config) when is_list(Config) ->
- repeat_for_opts(heavy_lookup_do).
+ repeat_for_opts(fun heavy_lookup_do/1).
heavy_lookup_do(Opts) ->
EtsMem = etsmem(),
@@ -4257,7 +4256,7 @@ do_lookup(Tab, N) ->
%% Perform multiple lookups for every element in a large table.
heavy_lookup_element(Config) when is_list(Config) ->
- repeat_for_opts(heavy_lookup_element_do).
+ repeat_for_opts(fun heavy_lookup_element_do/1).
heavy_lookup_element_do(Opts) ->
EtsMem = etsmem(),
@@ -4285,7 +4284,7 @@ do_lookup_element(Tab, N, M) ->
heavy_concurrent(Config) when is_list(Config) ->
ct:timetrap({minutes,30}), %% valgrind needs a lot of time
- repeat_for_opts(do_heavy_concurrent).
+ repeat_for_opts(fun do_heavy_concurrent/1).
do_heavy_concurrent(Opts) ->
Size = 10000,
@@ -4370,7 +4369,7 @@ foldr_ordered(Config) when is_list(Config) ->
%% Test ets:member BIF.
member(Config) when is_list(Config) ->
- repeat_for_opts(member_do, [write_concurrency, all_types]).
+ repeat_for_opts(fun member_do/1, [write_concurrency, all_types]).
member_do(Opts) ->
EtsMem = etsmem(),
@@ -4453,26 +4452,26 @@ time_match(Tab,Match) ->
seventyfive_percent_success(_,S,Fa,0) ->
true = (S > ((S + Fa) * 0.75));
-seventyfive_percent_success({M,F,A},S,Fa,N) ->
- case (catch apply(M,F,A)) of
- {'EXIT', _} ->
- seventyfive_percent_success({M,F,A},S,Fa+1,N-1);
- _ ->
- seventyfive_percent_success({M,F,A},S+1,Fa,N-1)
+seventyfive_percent_success(F, S, Fa, N) when is_function(F, 0) ->
+ try F() of
+ _ ->
+ seventyfive_percent_success(F, S+1, Fa, N-1)
+ catch error:_ ->
+ seventyfive_percent_success(F, S, Fa+1, N-1)
end.
fifty_percent_success(_,S,Fa,0) ->
true = (S > ((S + Fa) * 0.5));
-fifty_percent_success({M,F,A},S,Fa,N) ->
- case (catch apply(M,F,A)) of
- {'EXIT', _} ->
- fifty_percent_success({M,F,A},S,Fa+1,N-1);
- _ ->
- fifty_percent_success({M,F,A},S+1,Fa,N-1)
+fifty_percent_success(F, S, Fa, N) when is_function(F, 0) ->
+ try F() of
+ _ ->
+ fifty_percent_success(F, S+1, Fa, N-1)
+ catch
+ error:_ ->
+ fifty_percent_success(F, S, Fa+1, N-1)
end.
-
create_random_string(0) ->
[];
@@ -4811,7 +4810,7 @@ otp_6338(Config) when is_list(Config) ->
%% Elements could come in the wrong order in a bag if a rehash occurred.
otp_5340(Config) when is_list(Config) ->
- repeat_for_opts(otp_5340_do).
+ repeat_for_opts(fun otp_5340_do/1).
otp_5340_do(Opts) ->
N = 3000,
@@ -4847,7 +4846,7 @@ verify2(_Err, _) ->
%% delete_object followed by delete on fixed bag failed to delete objects.
otp_7665(Config) when is_list(Config) ->
- repeat_for_opts(otp_7665_do).
+ repeat_for_opts(fun otp_7665_do/1).
otp_7665_do(Opts) ->
Tab = ets_new(otp_7665,[bag | Opts]),
@@ -4877,7 +4876,7 @@ otp_7665_act(Tab,Min,Max,DelNr) ->
%% Whitebox testing of meta name table hashing.
meta_wb(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(meta_wb_do),
+ repeat_for_opts(fun meta_wb_do/1),
verify_etsmem(EtsMem).
@@ -5446,7 +5445,7 @@ smp_select_delete(Config) when is_list(Config) ->
%% Test different types.
types(Config) when is_list(Config) ->
init_externals(),
- repeat_for_opts(types_do,[[set,ordered_set],compressed]).
+ repeat_for_opts(fun types_do/1, [[set,ordered_set],compressed]).
types_do(Opts) ->
EtsMem = etsmem(),
@@ -5848,12 +5847,8 @@ log_test_proc(Proc) when is_pid(Proc) ->
Proc.
my_spawn(Fun) -> log_test_proc(spawn(Fun)).
-%%my_spawn(M,F,A) -> log_test_proc(spawn(M,F,A)).
-%%my_spawn(N,M,F,A) -> log_test_proc(spawn(N,M,F,A)).
my_spawn_link(Fun) -> log_test_proc(spawn_link(Fun)).
-my_spawn_link(M,F,A) -> log_test_proc(spawn_link(M,F,A)).
-%%my_spawn_link(N,M,F,A) -> log_test_proc(spawn_link(N,M,F,A)).
my_spawn_opt(Fun,Opts) ->
case spawn_opt(Fun,Opts) of
@@ -6096,7 +6091,7 @@ make_port() ->
open_port({spawn, "efile"}, [eof]).
make_pid() ->
- spawn_link(?MODULE, sleeper, []).
+ spawn_link(fun sleeper/0).
sleeper() ->
receive after infinity -> ok end.
@@ -6232,11 +6227,7 @@ make_unaligned_sub_binary(List) ->
repeat_for_opts(F) ->
repeat_for_opts(F, [write_concurrency, read_concurrency, compressed]).
-repeat_for_opts(F, OptGenList) when is_atom(F) ->
- repeat_for_opts(fun(Opts) -> ?MODULE:F(Opts) end, OptGenList);
-repeat_for_opts({F,Args}, OptGenList) when is_atom(F) ->
- repeat_for_opts(fun(Opts) -> ?MODULE:F(Opts,Args) end, OptGenList);
-repeat_for_opts(F, OptGenList) ->
+repeat_for_opts(F, OptGenList) when is_function(F, 1) ->
repeat_for_opts(F, OptGenList, []).
repeat_for_opts(F, [], Acc) ->
diff --git a/lib/stdlib/test/ets_tough_SUITE.erl b/lib/stdlib/test/ets_tough_SUITE.erl
index 49aba7a529..0abce3200f 100644
--- a/lib/stdlib/test/ets_tough_SUITE.erl
+++ b/lib/stdlib/test/ets_tough_SUITE.erl
@@ -19,10 +19,15 @@
%%
-module(ets_tough_SUITE).
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,ex1/1]).
--export([init/1,terminate/2,handle_call/3,handle_info/2]).
+ init_per_group/2,end_per_group/2,
+ ex1/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
--compile([export_all]).
+
+%% gen_server behavior.
+-behavior(gen_server).
+-export([init/1,terminate/2,handle_call/3,handle_cast/2,
+ handle_info/2,code_change/3]).
+
-include_lib("common_test/include/ct.hrl").
suite() ->
@@ -235,33 +240,6 @@ random_element(T) ->
I = rand:uniform(tuple_size(T)),
element(I,T).
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-show_table(N) ->
- FileName = ["etsdump.",integer_to_list(N)],
- case file:open(FileName,read) of
- {ok,Fd} ->
- show_entries(Fd);
- _ ->
- error
- end.
-
-show_entries(Fd) ->
- case phys_read_len(Fd) of
- {ok,Len} ->
- case phys_read_entry(Fd,Len) of
- {ok,ok} ->
- ok;
- {ok,{Key,Val}} ->
- io:format("~w\n",[{Key,Val}]),
- show_entries(Fd);
- _ ->
- error
- end;
- _ ->
- error
- end.
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -378,20 +356,6 @@ dget_class(ServerPid,Class,Condition) ->
derase_class(ServerPid,Class) ->
gen_server:call(ServerPid,{handle_delete_class,Class}, infinity).
-%%% dmodify(ServerPid,Application) -> ok
-%%%
-%%% Applies a function on every instance in the database.
-%%% The user provided function must always return one of the
-%%% terms {ok,NewItem}, true, or false.
-%%% Aug 96, this is only used to reset all timestamp values
-%%% in the database.
-%%% The function is supplied as Application = {Mod, Fun, ExtraArgs},
-%%% where the instance will be prepended to ExtraArgs before each
-%%% call is made.
-
-dmodify(ServerPid,Application) ->
- gen_server:call(ServerPid,{handle_dmodify,Application}, infinity).
-
%%% ddump_first(ServerPid,DumpDir) -> {dump_more,Ticket} | already_dumping
%%%
%%% Starts dumping the database. This call redirects all database updates
@@ -643,9 +607,15 @@ handle_call(stop,_From,Admin) ->
?ets_delete(Admin), % Make sure table is gone before reply is sent.
{stop, normal, ok, []}.
+handle_cast(_Req, Admin) ->
+ {noreply, Admin}.
+
handle_info({'EXIT',_Pid,_Reason},Admin) ->
{stop,normal,Admin}.
+code_change(_OldVsn, StateData, _Extra) ->
+ {ok, StateData}.
+
handle_delete(Class, Key, Admin) ->
handle_call({handle_delete,Class,Key},from,Admin).
diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl
index 54066021fb..dc3daa56c1 100644
--- a/lib/stdlib/test/filename_SUITE.erl
+++ b/lib/stdlib/test/filename_SUITE.erl
@@ -29,6 +29,7 @@
dirname_bin/1, extension_bin/1, join_bin/1, t_nativename_bin/1]).
-export([pathtype_bin/1,rootname_bin/1,split_bin/1]).
-export([t_basedir_api/1, t_basedir_xdg/1, t_basedir_windows/1]).
+-export([safe_relative_path/1]).
-include_lib("common_test/include/ct.hrl").
@@ -41,7 +42,8 @@ all() ->
find_src,
absname_bin, absname_bin_2,
{group,p},
- t_basedir_xdg, t_basedir_windows].
+ t_basedir_xdg, t_basedir_windows,
+ safe_relative_path].
groups() ->
[{p, [parallel],
@@ -770,6 +772,71 @@ t_nativename_bin(Config) when is_list(Config) ->
filename:nativename(<<"/usr/tmp//arne/">>)
end.
+safe_relative_path(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Root = filename:join(PrivDir, ?FUNCTION_NAME),
+ ok = file:make_dir(Root),
+ ok = file:set_cwd(Root),
+
+ ok = file:make_dir("a"),
+ ok = file:set_cwd("a"),
+ ok = file:make_dir("b"),
+ ok = file:set_cwd("b"),
+ ok = file:make_dir("c"),
+
+ ok = file:set_cwd(Root),
+
+ "a" = test_srp("a"),
+ "a/b" = test_srp("a/b"),
+ "a/b" = test_srp("a/./b"),
+ "a/b" = test_srp("a/./b/."),
+
+ "" = test_srp("a/.."),
+ "" = test_srp("a/./.."),
+ "" = test_srp("a/../."),
+ "a" = test_srp("a/b/.."),
+ "a" = test_srp("a/../a"),
+ "a" = test_srp("a/../a/../a"),
+ "a/b/c" = test_srp("a/../a/b/c"),
+
+ unsafe = test_srp("a/../.."),
+ unsafe = test_srp("a/../../.."),
+ unsafe = test_srp("a/./../.."),
+ unsafe = test_srp("a/././../../.."),
+ unsafe = test_srp("a/b/././../../.."),
+
+ unsafe = test_srp(PrivDir), %Absolute path.
+
+ ok.
+
+test_srp(RelPath) ->
+ Res = do_test_srp(RelPath),
+ Res = case do_test_srp(list_to_binary(RelPath)) of
+ Bin when is_binary(Bin) ->
+ binary_to_list(Bin);
+ Other ->
+ Other
+ end.
+
+do_test_srp(RelPath) ->
+ {ok,Root} = file:get_cwd(),
+ ok = file:set_cwd(RelPath),
+ {ok,Cwd} = file:get_cwd(),
+ ok = file:set_cwd(Root),
+ case filename:safe_relative_path(RelPath) of
+ unsafe ->
+ true = length(Cwd) < length(Root),
+ unsafe;
+ "" ->
+ "";
+ SafeRelPath ->
+ ok = file:set_cwd(SafeRelPath),
+ {ok,Cwd} = file:get_cwd(),
+ true = length(Cwd) >= length(Root),
+ ok = file:set_cwd(Root),
+ SafeRelPath
+ end.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% basedirs
t_basedir_api(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl
index 8f2ba0cab2..ac27c9fc79 100644
--- a/lib/stdlib/test/gen_statem_SUITE.erl
+++ b/lib/stdlib/test/gen_statem_SUITE.erl
@@ -38,7 +38,7 @@ all() ->
{group, abnormal},
{group, abnormal_handle_event},
shutdown, stop_and_reply, state_enter, event_order,
- state_timeout, code_change,
+ state_timeout, event_types, code_change,
{group, sys},
hibernate, enter_loop].
@@ -600,15 +600,26 @@ state_enter(_Config) ->
(internal, Prev, N) ->
Self ! {internal,start,Prev,N},
{keep_state,N + 1};
+ ({call,From}, repeat, N) ->
+ {repeat_state,N + 1,
+ [{reply,From,{repeat,start,N}}]};
({call,From}, echo, N) ->
- {next_state,wait,N + 1,{reply,From,{echo,start,N}}};
+ {next_state,wait,N + 1,
+ {reply,From,{echo,start,N}}};
({call,From}, {stop,Reason}, N) ->
- {stop_and_reply,Reason,[{reply,From,{stop,N}}],N + 1}
+ {stop_and_reply,Reason,
+ [{reply,From,{stop,N}}],N + 1}
end,
wait =>
- fun (enter, Prev, N) ->
+ fun (enter, Prev, N) when N < 5 ->
+ {repeat_state,N + 1,
+ {reply,{Self,N},{enter,Prev}}};
+ (enter, Prev, N) ->
Self ! {enter,wait,Prev,N},
{keep_state,N + 1};
+ ({call,From}, repeat, N) ->
+ {repeat_state_and_data,
+ [{reply,From,{repeat,wait,N}}]};
({call,From}, echo, N) ->
{next_state,start,N + 1,
[{next_event,internal,wait},
@@ -620,11 +631,15 @@ state_enter(_Config) ->
[{enter,start,start,1}] = flush(),
{echo,start,2} = gen_statem:call(STM, echo),
- [{enter,wait,start,3}] = flush(),
- {wait,[4|_]} = sys:get_state(STM),
- {echo,wait,4} = gen_statem:call(STM, echo),
- [{enter,start,wait,5},{internal,start,wait,6}] = flush(),
- {stop,7} = gen_statem:call(STM, {stop,bye}),
+ [{3,{enter,start}},{4,{enter,start}},{enter,wait,start,5}] = flush(),
+ {wait,[6|_]} = sys:get_state(STM),
+ {repeat,wait,6} = gen_statem:call(STM, repeat),
+ [{enter,wait,wait,6}] = flush(),
+ {echo,wait,7} = gen_statem:call(STM, echo),
+ [{enter,start,wait,8},{internal,start,wait,9}] = flush(),
+ {repeat,start,10} = gen_statem:call(STM, repeat),
+ [{enter,start,start,11}] = flush(),
+ {stop,12} = gen_statem:call(STM, {stop,bye}),
[{'EXIT',STM,bye}] = flush(),
{noproc,_} =
@@ -801,6 +816,74 @@ state_timeout(_Config) ->
+%% Test that all event types can be sent with {next_event,EventType,_}
+event_types(_Config) ->
+ process_flag(trap_exit, true),
+
+ Machine =
+ %% Abusing the internal format of From...
+ #{init =>
+ fun () ->
+ {ok, start, undefined}
+ end,
+ start =>
+ fun ({call,_} = Call, Req, undefined) ->
+ {next_state, state1, undefined,
+ [{next_event,internal,1},
+ {next_event,state_timeout,2},
+ {next_event,timeout,3},
+ {next_event,info,4},
+ {next_event,cast,5},
+ {next_event,Call,Req}]}
+ end,
+ state1 =>
+ fun (internal, 1, undefined) ->
+ {next_state, state2, undefined}
+ end,
+ state2 =>
+ fun (state_timeout, 2, undefined) ->
+ {next_state, state3, undefined}
+ end,
+ state3 =>
+ fun (timeout, 3, undefined) ->
+ {next_state, state4, undefined}
+ end,
+ state4 =>
+ fun (info, 4, undefined) ->
+ {next_state, state5, undefined}
+ end,
+ state5 =>
+ fun (cast, 5, undefined) ->
+ {next_state, state6, undefined}
+ end,
+ state6 =>
+ fun ({call,From}, stop, undefined) ->
+ {stop_and_reply, shutdown,
+ [{reply,From,stopped}]}
+ end},
+ {ok,STM} =
+ gen_statem:start_link(
+ ?MODULE, {map_statem,Machine,[]}, [{debug,[trace]}]),
+
+ stopped = gen_statem:call(STM, stop),
+ receive
+ {'EXIT',STM,shutdown} ->
+ ok
+ after 500 ->
+ ct:fail(did_not_stop)
+ end,
+
+ {noproc,_} =
+ ?EXPECT_FAILURE(gen_statem:call(STM, hej), Reason),
+ case flush() of
+ [] ->
+ ok;
+ Other2 ->
+ ct:fail({unexpected,Other2})
+ end.
+
+
+
sys1(Config) ->
{ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []),
{status, Pid, {module,gen_statem}, _} = sys:get_status(Pid),
@@ -1722,6 +1805,10 @@ handle_event(
{keep_state,[NewData|Machine]};
{keep_state,NewData,Ops} ->
{keep_state,[NewData|Machine],Ops};
+ {repeat_state,NewData} ->
+ {repeat_state,[NewData|Machine]};
+ {repeat_state,NewData,Ops} ->
+ {repeat_state,[NewData|Machine],Ops};
Other ->
Other
end;
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index 7d48cbc97c..d546e8fad2 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -30,7 +30,7 @@
io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1,
otp_10836/1, io_lib_width_too_small/1,
io_with_huge_message_queue/1, format_string/1,
- maps/1, coverage/1]).
+ maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1]).
-export([pretty/2]).
@@ -61,7 +61,7 @@ all() ->
printable_range, bad_printable_range,
io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836,
io_lib_width_too_small, io_with_huge_message_queue,
- format_string, maps, coverage].
+ format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175].
%% Error cases for output.
error_1(Config) when is_list(Config) ->
@@ -415,13 +415,13 @@ otp_6354(Config) when is_list(Config) ->
bt(<<"#rrrrr{\n"
" f1 = 1,\n"
" f2 = #rrrrr{f1 = a,f2 = b,f3 = c},\n"
- " f3 = \n"
+ " f3 =\n"
" #rrrrr{\n"
" f1 = h,f2 = i,\n"
- " f3 = \n"
+ " f3 =\n"
" #rrrrr{\n"
" f1 = aa,\n"
- " f2 = \n"
+ " f2 =\n"
" #rrrrr{\n"
" f1 = #rrrrr{f1 = a,f2 = b,f3 = c},\n"
" f2 = 2,f3 = 3},\n"
@@ -431,17 +431,17 @@ otp_6354(Config) when is_list(Config) ->
2,3},bb}}},
-1)),
bt(<<"#d{aaaaaaaaaaaaaaaaaaaa = 1,\n"
- " bbbbbbbbbbbbbbbbbbbb = \n"
+ " bbbbbbbbbbbbbbbbbbbb =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = a,bbbbbbbbbbbbbbbbbbbb = b,\n"
" cccccccccccccccccccc = c,dddddddddddddddddddd = d,\n"
" eeeeeeeeeeeeeeeeeeee = e},\n"
" cccccccccccccccccccc = 3,\n"
- " dddddddddddddddddddd = \n"
+ " dddddddddddddddddddd =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = h,bbbbbbbbbbbbbbbbbbbb = i,\n"
- " cccccccccccccccccccc = \n"
+ " cccccccccccccccccccc =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = aa,"
"bbbbbbbbbbbbbbbbbbbb = bb,\n"
- " cccccccccccccccccccc = \n"
+ " cccccccccccccccccccc =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = 1,"
"bbbbbbbbbbbbbbbbbbbb = 2,\n"
" cccccccccccccccccccc = 3,"
@@ -534,21 +534,21 @@ otp_6354(Config) when is_list(Config) ->
p({A,{A,{A,{A,{A,{A,{A,
{g,{h,{i,{j,{k,{l,{m,{n,{o,{a}}}}}}}}}}}}}}}}}, 100)),
bt(<<"#c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
" f1 = #c{f1 = #c{f1 = #c{f1 = a,"
"f2 = b},f2 = b},f2 = b},\n"
@@ -564,13 +564,13 @@ otp_6354(Config) when is_list(Config) ->
p({c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b},
b},b},b},b},b},b}, -1)),
bt(<<"#rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" {rrrrr,{rrrrr,a,#rrrrr{f1 = {rrrrr,1,2},f2 = a,"
"f3 = b}},b},\n"
" f2 = {rrrrr,c,d},\n"
@@ -2106,3 +2106,221 @@ coverage(_Config) ->
io:format("~s\n", [S2]),
ok.
+
+%% Test UTF-8 atoms.
+otp_14178_unicode_atoms(_Config) ->
+ "atom" = fmt("~ts", ['atom']),
+ "кирилли́ческий атом" = fmt("~ts", ['кирилли́ческий атом']),
+ [16#10FFFF] = fmt("~ts", ['\x{10FFFF}']),
+
+ %% ~s must not accept code points greater than 255.
+ bad_io_lib_format("~s", ['\x{100}']),
+ bad_io_lib_format("~s", ['кирилли́ческий атом']),
+
+ ok.
+
+bad_io_lib_format(F, S) ->
+ try io_lib:format(F, S) of
+ _ ->
+ ct:fail({should_fail,F,S})
+ catch
+ error:badarg ->
+ ok
+ end.
+
+otp_14175(_Config) ->
+ "..." = p(#{}, 0),
+ "#{}" = p(#{}, 1),
+ "#{...}" = p(#{a => 1}, 1),
+ "#{#{} => a}" = p(#{#{} => a}, 2),
+ "#{a => 1,...}" = p(#{a => 1, b => 2}, 2),
+ "#{a => 1,b => 2}" = p(#{a => 1, b => 2}, -1),
+
+ M = #{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,
+ kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,
+ keeeeeeeeeeeeeeeeeee => v5},
+ "#{...}" = p(M, 1),
+ mt("#{kaaaaaaaaaaaaaaaaaaaa => v1,...}", p(M, 2)),
+ mt("#{kaaaaaaaaaaaaaaaaaaaa => 1,kbbbbbbbbbbbbbbbbbbbb => 2,...}",
+ p(M, 3)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,...}", p(M, 4)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,...}",
+ p(M, 5)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,\n"
+ " keeeeeeeeeeeeeeeeeee => v5}", p(M, 6)),
+
+ weak("#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2,\n"
+ " cccccccccccccccccccc => {3},\n"
+ " dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}",
+ p(#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2,
+ cccccccccccccccccccc => {3},
+ dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}, -1)),
+
+ M2 = #{dddddddddddddddddddd => {1}, {aaaaaaaaaaaaaaaaaaaa} => 2,
+ {bbbbbbbbbbbbbbbbbbbb} => 3,{cccccccccccccccccccc} => 4,
+ {eeeeeeeeeeeeeeeeeeee} => 5},
+ "#{...}" = p(M2, 1),
+ weak("#{dddddddddddddddddddd => {...},...}", p(M2, 2)),
+ weak("#{dddddddddddddddddddd => {1},{...} => 2,...}", p(M2, 3)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {...} => 3,...}", p(M2, 4)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {...} => 4,...}", p(M2, 5)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {cccccccccccccccccccc} => 4,\n"
+ " {...} => 5}", p(M2, 6)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {cccccccccccccccccccc} => 4,\n"
+ " {eeeeeeeeeeeeeeeeeeee} => 5}", p(M2, 7)),
+
+ M3 = #{kaaaaaaaaaaaaaaaaaaa => vuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu,
+ kbbbbbbbbbbbbbbbbbbb => vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,
+ kccccccccccccccccccc => vxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx,
+ kddddddddddddddddddd => vyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy,
+ keeeeeeeeeeeeeeeeeee => vzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz},
+
+ mt("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu,\n"
+ " bbbbbbbbbbbbbbbbbbbb =>\n"
+ " vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,\n"
+ " cccccccccccccccccccc =>\n"
+ " xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx,\n"
+ " dddddddddddddddddddd =>\n"
+ " yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy,\n"
+ " eeeeeeeeeeeeeeeeeeee =>\n"
+ " zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz}", p(M3, -1)),
+
+ R4 = {c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b},
+ b},b},b},b},b},b},
+ M4 = #{aaaaaaaaaaaaaaaaaaaa => R4,
+ bbbbbbbbbbbbbbbbbbbb => R4,
+ cccccccccccccccccccc => R4,
+ dddddddddddddddddddd => R4,
+ eeeeeeeeeeeeeeeeeeee => R4},
+
+ weak("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " #c{f1 = #c{f1 = #c{...},f2 = b},f2 = b},\n"
+ " bbbbbbbbbbbbbbbbbbbb => #c{f1 = #c{f1 = {...},...},f2 = b},\n"
+ " cccccccccccccccccccc => #c{f1 = #c{...},f2 = b},\n"
+ " dddddddddddddddddddd => #c{f1 = {...},...},\n"
+ " eeeeeeeeeeeeeeeeeeee => #c{...}}", p(M4, 7)),
+
+ M5 = #{aaaaaaaaaaaaaaaaaaaa => R4},
+ mt("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 = #c{f1 = #c{f1 = #c{f1 = a,f2 = b},f2 = b},"
+ "f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b}}", p(M5, -1)),
+ ok.
+
+%% Just check number of newlines and dots ('...').
+-define(WEAK, true).
+
+-ifdef(WEAK).
+
+weak(S, R) ->
+ (nl(S) =:= nl(R) andalso
+ dots(S) =:= dots(S)).
+
+nl(S) ->
+ [C || C <- S, C =:= $\n].
+
+dots(S) ->
+ [C || C <- S, C =:= $\.].
+
+-else. % WEAK
+
+weak(S, R) ->
+ mt(S, R).
+
+-endif. % WEAK
+
+%% If EXACT is defined: mt() matches strings exactly.
+%%
+%% if EXACT is not defined: do not match the strings exactly, but
+%% compare them assuming that all map keys and all map values are
+%% equal (by assuming all map keys and all map values have the same
+%% length and begin with $k and $v respectively).
+
+%-define(EXACT, true).
+
+-ifdef(EXACT).
+
+mt(S, R) ->
+ S =:= R.
+
+-else. % EXACT
+
+mt(S, R) ->
+ anon(S) =:= anon(R).
+
+anon(S) ->
+ {ok, Ts0, _} = erl_scan:string(S, 1, [text]),
+ Ts = anon1(Ts0),
+ text(Ts).
+
+anon1([]) -> [];
+anon1([{atom,Anno,Atom}=T|Ts]) ->
+ case erl_anno:text(Anno) of
+ "k" ++ _ ->
+ NewAnno = erl_anno:set_text("key", Anno),
+ [{atom,NewAnno,Atom}|anon1(Ts)];
+ "v" ++ _ ->
+ NewAnno = erl_anno:set_text("val", Anno),
+ [{atom,NewAnno,Atom}|anon1(Ts)];
+ _ ->
+ [T|anon1(Ts)]
+ end;
+anon1([T|Ts]) ->
+ [T|anon1(Ts)].
+
+text(Ts) ->
+ lists:append(text1(Ts)).
+
+text1([]) -> [];
+text1([T|Ts]) ->
+ Anno = element(2, T),
+ [erl_anno:text(Anno) | text1(Ts)].
+
+-endif. % EXACT
diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl
index 531e97e8d6..5f2d8f0f4e 100644
--- a/lib/stdlib/test/lists_SUITE.erl
+++ b/lib/stdlib/test/lists_SUITE.erl
@@ -121,7 +121,7 @@ groups() ->
{zip, [parallel], [zip_unzip, zip_unzip3, zipwith, zipwith3]},
{misc, [parallel], [reverse, member, dropwhile, takewhile,
filter_partition, suffix, subtract, join,
- hof]}
+ hof, droplast]}
].
init_per_suite(Config) ->
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index c08e138ad3..2b5d52287e 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -886,11 +886,12 @@ eval_unique(Config) when is_list(Config) ->
[a] = qlc:e(Q2, {unique_all, true})
">>,
- <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1]],unique)],
+ <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1,#{a => 1}]],
+ unique)],
unique),
{call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} =
qlc:info(Q, [{format,abstract_code},unique_all]),
- [1,2] = qlc:e(Q)">>,
+ [1,2,#{a := 1}] = qlc:e(Q)">>,
<<"Q = qlc:q([X || X <- [1,2,1]]),
{call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} =
@@ -2637,7 +2638,16 @@ info(Config) when is_list(Config) ->
{cons, _, _, _}]},
{nil,_}}]}]} = i(QH, {format, abstract_code}),
[{5},{6}] = qlc:e(QH),
- [{4},{5},{6}] = qlc:e(F(3))">>
+ [{4},{5},{6}] = qlc:e(F(3))">>,
+
+ <<"Fun = fun ?MODULE:i/2,
+ L = [{#{k => #{v => Fun}}, Fun}],
+ H = qlc:q([Q || Q <- L, Q =:= {#{k => #{v => Fun}}, Fun}]),
+ L = qlc:e(H),
+ {call,_,_,[{lc,_,{var,_,'Q'},
+ [{generate,_,_,_},
+ {op,_,_,_,_}]}]} =
+ qlc:info(H, [{format,abstract_code}])">>
],
run(Config, Ts),
diff --git a/lib/stdlib/test/random_iolist.erl b/lib/stdlib/test/random_iolist.erl
index 555f063e0a..b62cf5b82b 100644
--- a/lib/stdlib/test/random_iolist.erl
+++ b/lib/stdlib/test/random_iolist.erl
@@ -24,17 +24,13 @@
-module(random_iolist).
--export([run/3, run2/3, standard_seed/0, compare/3, compare2/3,
+-export([run/3, standard_seed/0, compare/3,
random_iolist/1]).
run(Iter,Fun1,Fun2) ->
standard_seed(),
compare(Iter,Fun1,Fun2).
-run2(Iter,Fun1,Fun2) ->
- standard_seed(),
- compare2(Iter,Fun1,Fun2).
-
random_byte() ->
rand:uniform(256) - 1.
@@ -150,16 +146,6 @@ do_comp(List,F1,F2) ->
_ ->
true
end.
-
-do_comp(List,List2,F1,F2) ->
- X = F1(List,List2),
- Y = F2(List,List2),
- case X =:= Y of
- false ->
- exit({not_matching,List,List2,X,Y});
- _ ->
- true
- end.
compare(0,Fun1,Fun2) ->
do_comp(<<>>,Fun1,Fun2),
@@ -172,25 +158,3 @@ compare(N,Fun1,Fun2) ->
L = random_iolist(N),
do_comp(L,Fun1,Fun2),
compare(N-1,Fun1,Fun2).
-
-compare2(0,Fun1,Fun2) ->
- L = random_iolist(100),
- do_comp(<<>>,L,Fun1,Fun2),
- do_comp(L,<<>>,Fun1,Fun2),
- do_comp(<<>>,<<>>,Fun1,Fun2),
- do_comp([],L,Fun1,Fun2),
- do_comp(L,[],Fun1,Fun2),
- do_comp([],[],Fun1,Fun2),
- do_comp([[]|<<>>],L,Fun1,Fun2),
- do_comp(L,[[]|<<>>],Fun1,Fun2),
- do_comp([[]|<<>>],[[]|<<>>],Fun1,Fun2),
- do_comp([<<>>,[]|<<>>],L,Fun1,Fun2),
- do_comp(L,[<<>>,[]|<<>>],Fun1,Fun2),
- do_comp([<<>>,[]|<<>>],[<<>>,[]|<<>>],Fun1,Fun2),
- true;
-
-compare2(N,Fun1,Fun2) ->
- L = random_iolist(N),
- L2 = random_iolist(N),
- do_comp(L,L2,Fun1,Fun2),
- compare2(N-1,Fun1,Fun2).
diff --git a/lib/stdlib/test/random_unicode_list.erl b/lib/stdlib/test/random_unicode_list.erl
index 8db2fa8b56..2eeb28113d 100644
--- a/lib/stdlib/test/random_unicode_list.erl
+++ b/lib/stdlib/test/random_unicode_list.erl
@@ -24,7 +24,7 @@
-module(random_unicode_list).
--export([run/3, run/4, run2/3, standard_seed/0, compare/4, compare2/3,
+-export([run/3, run/4, standard_seed/0, compare/4,
random_unicode_list/2]).
run(I,F1,F2) ->
@@ -33,10 +33,6 @@ run(Iter,Fun1,Fun2,Enc) ->
standard_seed(),
compare(Iter,Fun1,Fun2,Enc).
-run2(Iter,Fun1,Fun2) ->
- standard_seed(),
- compare2(Iter,Fun1,Fun2).
-
int_to_utf8(I) when I =< 16#7F ->
<<I>>;
int_to_utf8(I) when I =< 16#7FF ->
@@ -225,16 +221,6 @@ do_comp(List,F1,F2) ->
_ ->
true
end.
-
-do_comp(List,List2,F1,F2) ->
- X = F1(List,List2),
- Y = F2(List,List2),
- case X =:= Y of
- false ->
- exit({not_matching,List,List2,X,Y});
- _ ->
- true
- end.
compare(0,Fun1,Fun2,_Enc) ->
do_comp(<<>>,Fun1,Fun2),
@@ -247,25 +233,3 @@ compare(N,Fun1,Fun2,Enc) ->
L = random_unicode_list(N,Enc),
do_comp(L,Fun1,Fun2),
compare(N-1,Fun1,Fun2,Enc).
-
-compare2(0,Fun1,Fun2) ->
- L = random_unicode_list(100,utf8),
- do_comp(<<>>,L,Fun1,Fun2),
- do_comp(L,<<>>,Fun1,Fun2),
- do_comp(<<>>,<<>>,Fun1,Fun2),
- do_comp([],L,Fun1,Fun2),
- do_comp(L,[],Fun1,Fun2),
- do_comp([],[],Fun1,Fun2),
- do_comp([[]|<<>>],L,Fun1,Fun2),
- do_comp(L,[[]|<<>>],Fun1,Fun2),
- do_comp([[]|<<>>],[[]|<<>>],Fun1,Fun2),
- do_comp([<<>>,[]|<<>>],L,Fun1,Fun2),
- do_comp(L,[<<>>,[]|<<>>],Fun1,Fun2),
- do_comp([<<>>,[]|<<>>],[<<>>,[]|<<>>],Fun1,Fun2),
- true;
-
-compare2(N,Fun1,Fun2) ->
- L = random_unicode_list(N,utf8),
- L2 = random_unicode_list(N,utf8),
- do_comp(L,L2,Fun1,Fun2),
- compare2(N-1,Fun1,Fun2).
diff --git a/lib/stdlib/test/re_testoutput1_replacement_test.erl b/lib/stdlib/test/re_testoutput1_replacement_test.erl
index a40800d760..563e0001e4 100644
--- a/lib/stdlib/test/re_testoutput1_replacement_test.erl
+++ b/lib/stdlib/test/re_testoutput1_replacement_test.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(re_testoutput1_replacement_test).
--compile(export_all).
+-export([run/0]).
-compile(no_native).
%% This file is generated by running run_pcre_tests:gen_repl_test("re_SUITE_data/testoutput1")
run() ->
diff --git a/lib/stdlib/test/re_testoutput1_split_test.erl b/lib/stdlib/test/re_testoutput1_split_test.erl
index 02987971fa..b39cb53a55 100644
--- a/lib/stdlib/test/re_testoutput1_split_test.erl
+++ b/lib/stdlib/test/re_testoutput1_split_test.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(re_testoutput1_split_test).
--compile(export_all).
+-export([run/0]).
-compile(no_native).
%% This file is generated by running run_pcre_tests:gen_split_test("re_SUITE_data/testoutput1")
join([]) -> [];
diff --git a/lib/stdlib/test/run_pcre_tests.erl b/lib/stdlib/test/run_pcre_tests.erl
index ae56db59d6..b62674d6e0 100644
--- a/lib/stdlib/test/run_pcre_tests.erl
+++ b/lib/stdlib/test/run_pcre_tests.erl
@@ -18,8 +18,7 @@
%% %CopyrightEnd%
%%
-module(run_pcre_tests).
-
--compile(export_all).
+-export([test/1,gen_split_test/1,gen_repl_test/1]).
test(RootDir) ->
put(verbose,false),
@@ -119,49 +118,6 @@ test([{RE0,Line,Options0,Tests}|T],PreCompile,XMode,REAsList) ->
end
end.
-loopexec(_,_,X,Y,_,_) when X > Y ->
- {match,[]};
-loopexec(P,Chal,X,Y,Unicode,Xopt) ->
- case re:run(Chal,P,[{offset,X}]++Xopt) of
- nomatch ->
- {match,[]};
- {match,[{A,B}|More]} ->
- {match,Rest} =
- case B>0 of
- true ->
- loopexec(P,Chal,A+B,Y,Unicode,Xopt);
- false ->
- {match,M} = case re:run(Chal,P,[{offset,X},notempty,anchored]++Xopt) of
- nomatch ->
- {match,[]};
- {match,Other} ->
- {match,fixup(Chal,Other,0)}
- end,
- NewA = forward(Chal,A,1,Unicode),
- {match,MM} = loopexec(P,Chal,NewA,Y,Unicode,Xopt),
- {match,M ++ MM}
- end,
- {match,fixup(Chal,[{A,B}|More],0)++Rest}
- end.
-
-forward(_Chal,A,0,_) ->
- A;
-forward(_Chal,A,N,false) ->
- A+N;
-forward(Chal,A,N,true) ->
- <<_:A/binary,Tl/binary>> = Chal,
- Forw = case Tl of
- <<1:1,1:1,0:1,_:5,_/binary>> ->
- 2;
- <<1:1,1:1,1:1,0:1,_:4,_/binary>> ->
- 3;
- <<1:1,1:1,1:1,1:1,0:1,_:3,_/binary>> ->
- 4;
- _ ->
- 1
- end,
- forward(Chal,A+Forw,N-1,true).
-
contains_eightbit(<<>>) ->
false;
contains_eightbit(<<X:8,_/binary>>) when X >= 128 ->
@@ -201,23 +157,6 @@ clean_duplicates([X|T],L) ->
end.
-global_fixup(_,nomatch) ->
- nomatch;
-global_fixup(P,{match,M}) ->
- {match,lists:flatten(global_fixup2(P,M))}.
-
-global_fixup2(_,[]) ->
- [];
-global_fixup2(P,[H|T]) ->
- [gfixup_one(P,0,H)|global_fixup2(P,T)].
-
-gfixup_one(_,_,[]) ->
- [];
-gfixup_one(P,I,[{Start,Len}|T]) ->
- <<_:Start/binary,R:Len/binary,_/binary>> = P,
- [{I,R}|gfixup_one(P,I+1,T)].
-
-
press([]) ->
[];
press([H|T]) ->
@@ -981,7 +920,7 @@ gen_split_test(OneFile) ->
ErlFileName = ErlModule++".erl",
{ok,F}= file:open(ErlFileName,[write]),
io:format(F,"-module(~s).~n",[ErlModule]),
- io:format(F,"-compile(export_all).~n",[]),
+ io:format(F,"-export([run/0]).~n",[]),
io:format(F,"-compile(no_native).~n",[]),
io:format(F,"%% This file is generated by running ~w:gen_split_test(~p)~n",
[?MODULE,OneFile]),
@@ -1024,7 +963,7 @@ dumponesplit(F,{RE,Line,O,TS}) ->
"$x =~~ s/\\\\/\\\\\\\\/g; $x =~~ s/\\\"/\\\\\"/g; "
"print \" <<\\\"$x\\\">> = "
"iolist_to_binary(join(re:split(\\\"~s\\\","
- "\\\"~s\\\",~p))), \\n\";'~n",
+ "\\\"~s\\\",~p))),\\n\";'~n",
[zsafe(safe(RE)),
SSS,
ysafe(safe(Str)),
@@ -1035,7 +974,7 @@ dumponesplit(F,{RE,Line,O,TS}) ->
"$x =~~ s/\\\\/\\\\\\\\/g; $x =~~ s/\\\"/\\\\\"/g; "
"print \" <<\\\"$x\\\">> = "
"iolist_to_binary(join(re:split(\\\"~s\\\","
- "\\\"~s\\\",~p))), \\n\";'~n",
+ "\\\"~s\\\",~p))),\\n\";'~n",
[zsafe(safe(RE)),
SSS,
ysafe(safe(Str)),
@@ -1046,7 +985,7 @@ dumponesplit(F,{RE,Line,O,TS}) ->
"$x =~~ s/\\\\/\\\\\\\\/g; $x =~~ s/\\\"/\\\\\"/g; "
"print \" <<\\\"$x\\\">> = "
"iolist_to_binary(join(re:split(\\\"~s\\\","
- "\\\"~s\\\",~p))), \\n\";'~n",
+ "\\\"~s\\\",~p))),\\n\";'~n",
[zsafe(safe(RE)),
SSS,
ysafe(safe(Str)),
@@ -1071,7 +1010,7 @@ gen_repl_test(OneFile) ->
ErlFileName = ErlModule++".erl",
{ok,F}= file:open(ErlFileName,[write]),
io:format(F,"-module(~s).~n",[ErlModule]),
- io:format(F,"-compile(export_all).~n",[]),
+ io:format(F,"-export([run/0]).~n",[]),
io:format(F,"-compile(no_native).~n",[]),
io:format(F,"%% This file is generated by running ~w:gen_repl_test(~p)~n",
[?MODULE,OneFile]),
diff --git a/lib/stdlib/test/sofs_SUITE.erl b/lib/stdlib/test/sofs_SUITE.erl
index 13c12ad2f2..f67bf16f0f 100644
--- a/lib/stdlib/test/sofs_SUITE.erl
+++ b/lib/stdlib/test/sofs_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1837,11 +1837,8 @@ digraph(Conf) when is_list(Conf) ->
ok.
digraph_fail(ExitReason, Fail) ->
- {'EXIT', {ExitReason, [{sofs,family_to_digraph,A,_}|_]}} = Fail,
- case {test_server:is_native(sofs),A} of
- {false,[_,_]} -> ok;
- {true,2} -> ok
- end.
+ {'EXIT', {ExitReason, [{sofs,family_to_digraph,2,_}|_]}} = Fail,
+ ok.
constant_function(Conf) when is_list(Conf) ->
E = empty_set(),
diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl
index 6f3979bb77..d6b6d3f80c 100644
--- a/lib/stdlib/test/tar_SUITE.erl
+++ b/lib/stdlib/test/tar_SUITE.erl
@@ -22,9 +22,10 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2, borderline/1, atomic/1, long_names/1,
create_long_names/1, bad_tar/1, errors/1, extract_from_binary/1,
- extract_from_binary_compressed/1,
+ extract_from_binary_compressed/1, extract_filtered/1,
extract_from_open_file/1, symlinks/1, open_add_close/1, cooked_compressed/1,
- memory/1,unicode/1]).
+ memory/1,unicode/1,read_other_implementations/1,
+ sparse/1, init/1]).
-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
@@ -35,7 +36,10 @@ all() ->
[borderline, atomic, long_names, create_long_names,
bad_tar, errors, extract_from_binary,
extract_from_binary_compressed, extract_from_open_file,
- symlinks, open_add_close, cooked_compressed, memory, unicode].
+ extract_filtered,
+ symlinks, open_add_close, cooked_compressed, memory, unicode,
+ read_other_implementations,
+ sparse,init].
groups() ->
[].
@@ -84,17 +88,30 @@ borderline(Config) when is_list(Config) ->
ok.
borderline_test(Size, TempDir) ->
- Archive = filename:join(TempDir, "ar_"++integer_to_list(Size)++".tar"),
- Name = filename:join(TempDir, "file_"++integer_to_list(Size)),
io:format("Testing size ~p", [Size]),
+ borderline_test(Size, TempDir, true),
+ borderline_test(Size, TempDir, false),
+ ok.
+
+borderline_test(Size, TempDir, IsUstar) ->
+ Prefix = case IsUstar of
+ true ->
+ "file_";
+ false ->
+ lists:duplicate(100, $f) ++ "ile_"
+ end,
+ SizeList = integer_to_list(Size),
+ Archive = filename:join(TempDir, "ar_"++ SizeList ++".tar"),
+ Name = filename:join(TempDir, Prefix++SizeList),
%% Create a file and archive it.
X0 = erlang:monotonic_time(),
- file:write_file(Name, random_byte_list(X0, Size)),
+ ok = file:write_file(Name, random_byte_list(X0, Size)),
ok = erl_tar:create(Archive, [Name]),
ok = file:delete(Name),
%% Verify listing and extracting.
+ IsUstar = is_ustar(Archive),
{ok, [Name]} = erl_tar:table(Archive),
ok = erl_tar:extract(Archive, [verbose]),
@@ -103,7 +120,12 @@ borderline_test(Size, TempDir) ->
true = match_byte_list(X0, binary_to_list(Bin)),
%% Verify that Unix tar can read it.
- tar_tf(Archive, Name),
+ case IsUstar of
+ true ->
+ tar_tf(Archive, Name);
+ false ->
+ ok
+ end,
ok.
@@ -336,6 +358,7 @@ create_long_names() ->
ok = erl_tar:tt(TarName),
%% Extract and verify.
+ true = is_ustar(TarName),
ExtractDir = "extract_dir",
ok = file:make_dir(ExtractDir),
ok = erl_tar:extract(TarName, [{cwd,ExtractDir}]),
@@ -357,7 +380,7 @@ make_dirs([], Dir) ->
%% Try erl_tar:table/2 and erl_tar:extract/2 on some corrupted tar files.
bad_tar(Config) when is_list(Config) ->
try_bad("bad_checksum", bad_header, Config),
- try_bad("bad_octal", bad_header, Config),
+ try_bad("bad_octal", invalid_tar_checksum, Config),
try_bad("bad_too_short", eof, Config),
try_bad("bad_even_shorter", eof, Config),
ok.
@@ -370,8 +393,10 @@ try_bad(Name0, Reason, Config) ->
Name = Name0 ++ ".tar",
io:format("~nTrying ~s", [Name]),
Full = filename:join(DataDir, Name),
- Opts = [verbose, {cwd, PrivDir}],
+ Dest = filename:join(PrivDir, Name0),
+ Opts = [verbose, {cwd, Dest}],
Expected = {error, Reason},
+ io:fwrite("Expected: ~p\n", [Expected]),
case {erl_tar:table(Full, Opts), erl_tar:extract(Full, Opts)} of
{Expected, Expected} ->
io:format("Result: ~p", [Expected]),
@@ -493,6 +518,27 @@ extract_from_binary_compressed(Config) when is_list(Config) ->
ok.
+%% Test extracting a tar archive from a binary.
+extract_filtered(Config) when is_list(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Long = filename:join(DataDir, "no_fancy_stuff.tar"),
+ ExtractDir = filename:join(PrivDir, "extract_from_binary"),
+ ok = file:make_dir(ExtractDir),
+
+ ok = erl_tar:extract(Long, [{cwd,ExtractDir},{files,["no_fancy_stuff/EPLICENCE"]}]),
+
+ %% Verify.
+ Dir = filename:join(ExtractDir, "no_fancy_stuff"),
+ true = filelib:is_dir(Dir),
+ false = filelib:is_file(filename:join(Dir, "a_dir_list")),
+ true = filelib:is_file(filename:join(Dir, "EPLICENCE")),
+
+ %% Clean up.
+ delete_files([ExtractDir]),
+
+ ok.
+
%% Test extracting a tar archive from an open file.
extract_from_open_file(Config) when is_list(Config) ->
DataDir = proplists:get_value(data_dir, Config),
@@ -573,6 +619,7 @@ symlinks(Dir, BadSymlink, PointsTo) ->
ok = file:write_file(AFile, ALine),
ok = file:make_symlink(AFile, GoodSymlink),
ok = erl_tar:create(Tar, [BadSymlink, GoodSymlink, AFile], [verbose]),
+ true = is_ustar(Tar),
%% List contents of tar file.
@@ -581,6 +628,7 @@ symlinks(Dir, BadSymlink, PointsTo) ->
%% Also create another archive with the dereference flag.
ok = erl_tar:create(DerefTar, [AFile, GoodSymlink], [dereference, verbose]),
+ true = is_ustar(DerefTar),
%% Extract files to a new directory.
@@ -619,13 +667,50 @@ long_symlink(Dir) ->
ok = file:set_cwd(Dir),
AFile = "long_symlink",
- FarTooLong = "/tmp/aarrghh/this/path/is/far/longer/than/one/hundred/characters/which/is/the/maximum/number/of/characters/allowed",
- ok = file:make_symlink(FarTooLong, AFile),
- {error,Error} = erl_tar:create(Tar, [AFile], [verbose]),
- io:format("Error: ~s\n", [erl_tar:format_error(Error)]),
- {FarTooLong,symbolic_link_too_long} = Error,
+ RequiresPAX = "/tmp/aarrghh/this/path/is/far/longer/than/one/hundred/characters/which/is/the/maximum/number/of/characters/allowed",
+ ok = file:make_symlink(RequiresPAX, AFile),
+ ok = erl_tar:create(Tar, [AFile], [verbose]),
+ false = is_ustar(Tar),
+ NewDir = filename:join(Dir, "extracted"),
+ _ = file:make_dir(NewDir),
+ ok = erl_tar:extract(Tar, [{cwd, NewDir}, verbose]),
+ ok = file:set_cwd(NewDir),
+ {ok, #file_info{type=symlink}} = file:read_link_info(AFile),
+ {ok, RequiresPAX} = file:read_link(AFile),
+ ok.
+
+init(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ ok = file:set_cwd(PrivDir),
+ Dir = filename:join(PrivDir, "init"),
+ ok = file:make_dir(Dir),
+
+ [{FileOne,_,_}|_] = oac_files(),
+ TarOne = filename:join(Dir, "archive1.tar"),
+ {ok,Fd} = file:open(TarOne, [write]),
+
+ %% If the arity of the fun is wrong, badarg should be returned
+ {error, badarg} = erl_tar:init(Fd, write, fun file_op_bad/1),
+
+ %% Otherwise we should be good to go
+ {ok, Tar} = erl_tar:init(Fd, write, fun file_op/2),
+ ok = erl_tar:add(Tar, FileOne, []),
+ ok = erl_tar:close(Tar),
+ {ok, [FileOne]} = erl_tar:table(TarOne),
ok.
+file_op_bad(_) ->
+ throw({error, should_never_be_called}).
+
+file_op(write, {Fd, Data}) ->
+ file:write(Fd, Data);
+file_op(position, {Fd, Pos}) ->
+ file:position(Fd, Pos);
+file_op(read2, {Fd, Size}) ->
+ file:read(Fd, Size);
+file_op(close, Fd) ->
+ file:close(Fd).
+
open_add_close(Config) when is_list(Config) ->
PrivDir = proplists:get_value(priv_dir, Config),
ok = file:set_cwd(PrivDir),
@@ -643,17 +728,26 @@ open_add_close(Config) when is_list(Config) ->
TarOne = filename:join(Dir, "archive1.tar"),
{ok,AD} = erl_tar:open(TarOne, [write]),
ok = erl_tar:add(AD, FileOne, []),
- ok = erl_tar:add(AD, FileTwo, "second file", []),
- ok = erl_tar:add(AD, FileThree, [verbose]),
+
+ %% Add with {NameInArchive,Name}
+ ok = erl_tar:add(AD, {"second file", FileTwo}, []),
+
+ %% Add with {binary, Bin}
+ {ok,FileThreeBin} = file:read_file(FileThree),
+ ok = erl_tar:add(AD, {FileThree, FileThreeBin}, [verbose]),
+
+ %% Add with Name
ok = erl_tar:add(AD, FileThree, "chunked", [{chunks,11411},verbose]),
ok = erl_tar:add(AD, ADir, [verbose]),
ok = erl_tar:add(AD, AnotherDir, [verbose]),
ok = erl_tar:close(AD),
+ true = is_ustar(TarOne),
ok = erl_tar:t(TarOne),
ok = erl_tar:tt(TarOne),
- {ok,[FileOne,"second file",FileThree,"chunked",ADir,SomeContent]} = erl_tar:table(TarOne),
+ Expected = {ok,[FileOne,"second file",FileThree,"chunked",ADir,SomeContent]},
+ Expected = erl_tar:table(TarOne),
delete_files(["oac_file","oac_small","oac_big",Dir,AnotherDir,ADir]),
@@ -718,6 +812,41 @@ memory(Config) when is_list(Config) ->
ok = delete_files([Name1,Name2]),
ok.
+read_other_implementations(Config) when is_list(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ Files = ["v7.tar", "gnu.tar", "bsd.tar",
+ "star.tar", "pax_mtime.tar"],
+ do_read_other_implementations(Files, DataDir).
+
+do_read_other_implementations([], _DataDir) ->
+ ok;
+do_read_other_implementations([File|Rest], DataDir) ->
+ io:format("~nTrying ~s", [File]),
+ Full = filename:join(DataDir, File),
+ {ok, _} = erl_tar:table(Full),
+ {ok, _} = erl_tar:extract(Full, [memory]),
+ do_read_other_implementations(Rest, DataDir).
+
+
+%% Test handling of sparse files
+sparse(Config) when is_list(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Sparse01Empty = "sparse01_empty.tar",
+ Sparse01 = "sparse01.tar",
+ Sparse10Empty = "sparse10_empty.tar",
+ Sparse10 = "sparse10.tar",
+ do_sparse([Sparse01Empty, Sparse01, Sparse10Empty, Sparse10], DataDir, PrivDir).
+
+do_sparse([], _DataDir, _PrivDir) ->
+ ok;
+do_sparse([Name|Rest], DataDir, PrivDir) ->
+ io:format("~nTrying sparse file ~s", [Name]),
+ Full = filename:join(DataDir, Name),
+ {ok, [_]} = erl_tar:table(Full),
+ {ok, _} = erl_tar:extract(Full, [memory]),
+ do_sparse(Rest, DataDir, PrivDir).
+
%% Test filenames with characters outside the US ASCII range.
unicode(Config) when is_list(Config) ->
run_unicode_node(Config, "+fnu"),
@@ -753,6 +882,9 @@ do_unicode(PrivDir) ->
Names = lists:sort(unicode_create_files()),
Tar = "unicöde.tar",
ok = erl_tar:create(Tar, ["unicöde"], []),
+
+ %% Unicode filenames require PAX format.
+ false = is_ustar(Tar),
{ok,Names0} = erl_tar:table(Tar, []),
Names = lists:sort(Names0),
_ = [ok = file:delete(Name) || Name <- Names],
@@ -850,3 +982,15 @@ start_node(Name, Args) ->
ct:log("Node ~p started~n", [Node]),
Node
end.
+
+%% Test that the given tar file is a plain USTAR archive,
+%% without any PAX extensions.
+is_ustar(File) ->
+ {ok,Bin} = file:read_file(File),
+ <<_:257/binary,"ustar",0,_/binary>> = Bin,
+ <<_:156/binary,Type:8,_/binary>> = Bin,
+ case Type of
+ $x -> false;
+ $g -> false;
+ _ -> true
+ end.
diff --git a/lib/stdlib/test/tar_SUITE_data/bsd.tar b/lib/stdlib/test/tar_SUITE_data/bsd.tar
new file mode 100644
index 0000000000..8c31864be0
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/bsd.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/gnu.tar b/lib/stdlib/test/tar_SUITE_data/gnu.tar
new file mode 100644
index 0000000000..60268065c1
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/gnu.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/pax_mtime.tar b/lib/stdlib/test/tar_SUITE_data/pax_mtime.tar
new file mode 100644
index 0000000000..1b6e80ffac
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/pax_mtime.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/sparse00.tar b/lib/stdlib/test/tar_SUITE_data/sparse00.tar
new file mode 100644
index 0000000000..61a04de90b
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/sparse00.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/sparse01.tar b/lib/stdlib/test/tar_SUITE_data/sparse01.tar
new file mode 100644
index 0000000000..61a04de90b
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/sparse01.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/sparse01_empty.tar b/lib/stdlib/test/tar_SUITE_data/sparse01_empty.tar
new file mode 100644
index 0000000000..efa6d060f4
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/sparse01_empty.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/sparse10.tar b/lib/stdlib/test/tar_SUITE_data/sparse10.tar
new file mode 100644
index 0000000000..61a04de90b
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/sparse10.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/sparse10_empty.tar b/lib/stdlib/test/tar_SUITE_data/sparse10_empty.tar
new file mode 100644
index 0000000000..efa6d060f4
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/sparse10_empty.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/star.tar b/lib/stdlib/test/tar_SUITE_data/star.tar
new file mode 100644
index 0000000000..b0631e3b13
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/star.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/v7.tar b/lib/stdlib/test/tar_SUITE_data/v7.tar
new file mode 100644
index 0000000000..9918e006bb
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/v7.tar
Binary files differ
diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl
index 7d90795c9e..f0feda217a 100644
--- a/lib/stdlib/test/zip_SUITE.erl
+++ b/lib/stdlib/test/zip_SUITE.erl
@@ -27,7 +27,7 @@
openzip_api/1, zip_api/1, open_leak/1, unzip_jar/1,
unzip_traversal_exploit/1,
compress_control/1,
- foldl/1]).
+ foldl/1,fd_leak/1]).
-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
@@ -40,7 +40,7 @@ all() ->
unzip_to_binary, zip_to_binary, unzip_options,
zip_options, list_dir_options, aliases, openzip_api,
zip_api, open_leak, unzip_jar, compress_control, foldl,
- unzip_traversal_exploit].
+ unzip_traversal_exploit,fd_leak].
groups() ->
[].
@@ -882,3 +882,35 @@ foldl(Config) ->
{error, enoent} = zip:foldl(ZipFun, [], File),
ok.
+
+fd_leak(Config) ->
+ ok = file:set_cwd(proplists:get_value(priv_dir, Config)),
+ DataDir = proplists:get_value(data_dir, Config),
+ Name = filename:join(DataDir, "bad_file_header.zip"),
+ BadExtract = fun() ->
+ {error,bad_file_header} = zip:extract(Name),
+ ok
+ end,
+ do_fd_leak(BadExtract, 1),
+
+ BadCreate = fun() ->
+ {error,enoent} = zip:zip("failed.zip",
+ ["none"]),
+ ok
+ end,
+ do_fd_leak(BadCreate, 1),
+
+ ok.
+
+do_fd_leak(_Bad, 10000) ->
+ ok;
+do_fd_leak(Bad, N) ->
+ try Bad() of
+ ok ->
+ do_fd_leak(Bad, N + 1)
+ catch
+ C:R ->
+ Stk = erlang:get_stacktrace(),
+ io:format("Bad error after ~p attempts\n", [N]),
+ erlang:raise(C, R, Stk)
+ end.