From 52097fab56edbbd8c6f8a57ec3b3f33aa60c5bb9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= Date: Mon, 1 Aug 2016 14:49:47 +0200 Subject: Update test cases for erlang:hash/2 removal --- lib/stdlib/test/erl_lint_SUITE.erl | 51 +++++++++++++++++++------------------- 1 file changed, 26 insertions(+), 25 deletions(-) (limited to 'lib/stdlib/test') diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index c90f855b3b..c7dcd9ae16 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -2002,22 +2002,22 @@ otp_5362(Config) when is_list(Config) -> <<"-compile(nowarn_deprecated_function). -compile(nowarn_bif_clash). spawn(A) -> - erlang:hash(A, 3000), + erlang:now(), spawn(A). ">>, - {[nowarn_unused_function, + {[nowarn_unused_function, warn_deprecated_function, warn_bif_clash]}, {error, [{5,erl_lint,{call_to_redefined_old_bif,{spawn,1}}}], - [{4,erl_lint,{deprecated,{erlang,hash,2},{erlang,phash2,2}, - "a future release"}}]}}, - + [{4,erl_lint,{deprecated,{erlang,now,0}, + "Deprecated BIF. See the \"Time and Time Correction in Erlang\" " + "chapter of the ERTS User's Guide for more information."}}]}}, {otp_5362_5, <<"-compile(nowarn_deprecated_function). -compile(nowarn_bif_clash). spawn(A) -> - erlang:hash(A, 3000), + erlang:now(), spawn(A). ">>, {[nowarn_unused_function]}, @@ -2026,37 +2026,37 @@ otp_5362(Config) when is_list(Config) -> %% The special nowarn_X are not affected by general warn_X. {otp_5362_6, - <<"-compile({nowarn_deprecated_function,{erlang,hash,2}}). + <<"-compile({nowarn_deprecated_function,{erlang,now,0}}). -compile({nowarn_bif_clash,{spawn,1}}). spawn(A) -> - erlang:hash(A, 3000), + erlang:now(), spawn(A). ">>, - {[nowarn_unused_function, - warn_deprecated_function, + {[nowarn_unused_function, + warn_deprecated_function, warn_bif_clash]}, {errors, [{2,erl_lint,disallowed_nowarn_bif_clash}],[]}}, {otp_5362_7, <<"-export([spawn/1]). - -compile({nowarn_deprecated_function,{erlang,hash,2}}). + -compile({nowarn_deprecated_function,{erlang,now,0}}). -compile({nowarn_bif_clash,{spawn,1}}). -compile({nowarn_bif_clash,{spawn,2}}). % bad -compile([{nowarn_deprecated_function, - [{erlang,hash,-1},{3,hash,-1}]}, % 2 bad - {nowarn_deprecated_function, {{a,b,c},hash,-1}}]). % bad + [{erlang,now,-1},{3,now,-1}]}, % 2 bad + {nowarn_deprecated_function, {{a,b,c},now,-1}}]). % bad spawn(A) -> - erlang:hash(A, 3000), + erlang:now(), spawn(A). ">>, {[nowarn_unused_function]}, {error,[{3,erl_lint,disallowed_nowarn_bif_clash}, {4,erl_lint,disallowed_nowarn_bif_clash}, {4,erl_lint,{bad_nowarn_bif_clash,{spawn,2}}}], - [{5,erl_lint,{bad_nowarn_deprecated_function,{3,hash,-1}}}, - {5,erl_lint,{bad_nowarn_deprecated_function,{erlang,hash,-1}}}, - {5,erl_lint,{bad_nowarn_deprecated_function,{{a,b,c},hash,-1}}}]} + [{5,erl_lint,{bad_nowarn_deprecated_function,{3,now,-1}}}, + {5,erl_lint,{bad_nowarn_deprecated_function,{erlang,now,-1}}}, + {5,erl_lint,{bad_nowarn_deprecated_function,{{a,b,c},now,-1}}}]} }, {otp_5362_8, @@ -2064,14 +2064,15 @@ otp_5362(Config) when is_list(Config) -> -compile(warn_deprecated_function). -compile(warn_bif_clash). spawn(A) -> - erlang:hash(A, 3000), + erlang:now(), spawn(A). ">>, {[nowarn_unused_function, {nowarn_bif_clash,{spawn,1}}]}, % has no effect {warnings, - [{5,erl_lint,{deprecated,{erlang,hash,2},{erlang,phash2,2}, - "a future release"}}]}}, + [{5,erl_lint,{deprecated,{erlang,now,0}, + "Deprecated BIF. See the \"Time and Time Correction in Erlang\" " + "chapter of the ERTS User's Guide for more information."}}]}}, {otp_5362_9, <<"-include_lib(\"stdlib/include/qlc.hrl\"). @@ -2083,11 +2084,11 @@ otp_5362(Config) when is_list(Config) -> []}, {otp_5362_10, - <<"-compile({nowarn_deprecated_function,{erlang,hash,2}}). + <<"-compile({nowarn_deprecated_function,{erlang,now,0}}). -compile({nowarn_bif_clash,{spawn,1}}). -import(x,[spawn/1]). spin(A) -> - erlang:hash(A, 3000), + erlang:now(), spawn(A). ">>, {[nowarn_unused_function, @@ -2097,11 +2098,11 @@ otp_5362(Config) when is_list(Config) -> [{2,erl_lint,disallowed_nowarn_bif_clash}],[]}}, {call_deprecated_function, - <<"t(X) -> erlang:hash(X, 2000).">>, + <<"t(X) -> crypto:md5(X).">>, [], {warnings, - [{1,erl_lint,{deprecated,{erlang,hash,2}, - {erlang,phash2,2},"a future release"}}]}}, + [{1,erl_lint,{deprecated,{crypto,md5,1}, + {crypto,hash,2}, "a future release"}}]}}, {call_removed_function, <<"t(X) -> regexp:match(X).">>, -- cgit v1.2.3 From 26b59dfe67ef551cd94765557cdd8c79794bcc38 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Valim?= Date: Tue, 31 May 2016 14:28:54 +0200 Subject: Add new AtU8 beam chunk MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The new chunk stores atoms encoded in UTF-8. beam_lib has also been modified to handle the new 'utf8_atoms' attribute while the 'atoms' attribute may be a missing chunk from now on. The binary_to_atom/2 BIF can now encode any utf8 binary with up to 255 characters. The list_to_atom/1 BIF can now accept codepoints higher than 255 with up to 255 characters (thanks to Björn Gustavsson). --- lib/stdlib/test/beam_lib_SUITE.erl | 45 +++++++++++++++++++++++++------------- lib/stdlib/test/erl_scan_SUITE.erl | 15 ++++++------- 2 files changed, 37 insertions(+), 23 deletions(-) (limited to 'lib/stdlib/test') diff --git a/lib/stdlib/test/beam_lib_SUITE.erl b/lib/stdlib/test/beam_lib_SUITE.erl index 4521ecc0ef..279e15f703 100644 --- a/lib/stdlib/test/beam_lib_SUITE.erl +++ b/lib/stdlib/test/beam_lib_SUITE.erl @@ -81,12 +81,8 @@ normal(Conf) when is_list(Conf) -> NoOfTables = length(ets:all()), P0 = pps(), - CompileFlags = [{outdir,PrivDir}, debug_info], - {ok,_} = compile:file(Source, CompileFlags), - {ok, Binary} = file:read_file(BeamFile), - - do_normal(BeamFile), - do_normal(Binary), + do_normal(Source, PrivDir, BeamFile, []), + do_normal(Source, PrivDir, BeamFile, [no_utf8_atoms]), {ok,_} = compile:file(Source, [{outdir,PrivDir}, no_debug_info]), {ok, {simple, [{abstract_code, no_abstract_code}]}} = @@ -101,7 +97,15 @@ normal(Conf) when is_list(Conf) -> true = (P0 == pps()), ok. -do_normal(BeamFile) -> +do_normal(Source, PrivDir, BeamFile, Opts) -> + CompileFlags = [{outdir,PrivDir}, debug_info | Opts], + {ok,_} = compile:file(Source, CompileFlags), + {ok, Binary} = file:read_file(BeamFile), + + do_normal(BeamFile, Opts), + do_normal(Binary, Opts). + +do_normal(BeamFile, Opts) -> Imports = {imports, [{erlang, get_module_info, 1}, {erlang, get_module_info, 2}, {lists, member, 2}]}, @@ -130,20 +134,31 @@ do_normal(BeamFile) -> beam_lib:chunks(BeamFile, [abstract_code]), %% Test reading optional chunks. - All = ["Atom", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT"], + All = ["Atom", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT", "AtU8"], {ok,{simple,Chunks}} = beam_lib:chunks(BeamFile, All, [allow_missing_chunks]), - verify_simple(Chunks). + case {verify_simple(Chunks),Opts} of + {{missing_chunk, AtomBin}, []} when is_binary(AtomBin) -> ok; + {{AtomBin, missing_chunk}, [no_utf8_atoms]} when is_binary(AtomBin) -> ok + end, -verify_simple([{"Atom", AtomBin}, + %% Make sure that reading the atom chunk works when the 'allow_missing_chunks' + %% option is used. + Some = ["Code",atoms,"ExpT","LitT"], + {ok,{simple,SomeChunks}} = beam_lib:chunks(BeamFile, Some, [allow_missing_chunks]), + [{"Code",<<_/binary>>},{atoms,[_|_]},{"ExpT",<<_/binary>>},{"LitT",missing_chunk}] = + SomeChunks. + +verify_simple([{"Atom", PlainAtomChunk}, {"Code", CodeBin}, {"StrT", StrBin}, {"ImpT", ImpBin}, {"ExpT", ExpBin}, {"FunT", missing_chunk}, - {"LitT", missing_chunk}]) - when is_binary(AtomBin), is_binary(CodeBin), is_binary(StrBin), + {"LitT", missing_chunk}, + {"AtU8", AtU8Chunk}]) + when is_binary(CodeBin), is_binary(StrBin), is_binary(ImpBin), is_binary(ExpBin) -> - ok. + {PlainAtomChunk, AtU8Chunk}. %% Read invalid beam files. error(Conf) when is_list(Conf) -> @@ -211,7 +226,7 @@ last_chunk(Bin) -> do_error(BeamFile, ACopy) -> %% evil tests Chunks = chunk_info(BeamFile), - {value, {_, AtomStart, _}} = lists:keysearch("Atom", 1, Chunks), + {value, {_, AtomStart, _}} = lists:keysearch("AtU8", 1, Chunks), {value, {_, ImportStart, _}} = lists:keysearch("ImpT", 1, Chunks), {value, {_, AbstractStart, _}} = lists:keysearch("Abst", 1, Chunks), {value, {_, AttributesStart, _}} = @@ -234,7 +249,7 @@ do_error(BeamFile, ACopy) -> verify(not_a_beam_file, beam_lib:info(BF7)), BF8 = set_byte(ACopy, BeamFile, 13, 17), - verify(missing_chunk, beam_lib:chunks(BF8, ["Atom"])), + verify(missing_chunk, beam_lib:chunks(BF8, ["AtU8"])), BF9 = set_byte(ACopy, BeamFile, CompileInfoStart+10, 17), verify(invalid_chunk, beam_lib:chunks(BF9, [compile_info])). diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl index 4ae734eb65..7d0ba967f9 100644 --- a/lib/stdlib/test/erl_scan_SUITE.erl +++ b/lib/stdlib/test/erl_scan_SUITE.erl @@ -772,10 +772,9 @@ unicode() -> erl_scan:string([1089]), {error,{{1,1},erl_scan,{illegal,character}},{1,2}} = erl_scan:string([1089], {1,1}), - {error,{1,erl_scan,{illegal,atom}},1} = - erl_scan:string("'a"++[1089]++"b'", 1), - {error,{{1,1},erl_scan,{illegal,atom}},{1,6}} = - erl_scan:string("'a"++[1089]++"b'", {1,1}), + {error,{{1,3},erl_scan,{illegal,character}},{1,4}} = + erl_scan:string("'a" ++ [999999999] ++ "c'", {1,1}), + test("\"a"++[1089]++"b\""), {ok,[{char,1,1}],1} = erl_scan_string([$$,$\\,$^,1089], 1), @@ -786,8 +785,8 @@ unicode() -> erl_scan:format_error(Error), {error,{{1,1},erl_scan,_},{1,11}} = erl_scan:string("\"qa\\x{aaa}",{1,1}), - {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = - erl_scan:string("'qa\\x{aaa}'",{1,1}), + {error,{{1,1},erl_scan,_},{1,11}} = + erl_scan:string("'qa\\x{aaa}",{1,1}), {ok,[{char,1,1089}],1} = erl_scan_string([$$,1089], 1), @@ -904,9 +903,9 @@ more_chars() -> %% OTP-10302. Unicode characters scanner/parser. otp_10302(Config) when is_list(Config) -> %% From unicode(): - {error,{1,erl_scan,{illegal,atom}},1} = + {ok,[{atom,1,'aсb'}],1} = erl_scan:string("'a"++[1089]++"b'", 1), - {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} = + {ok,[{atom,{1,1},'qaપ'}],{1,12}} = erl_scan:string("'qa\\x{aaa}'",{1,1}), {ok,[{char,1,1089}],1} = erl_scan_string([$$,1089], 1), -- cgit v1.2.3 From db442323e9e86528edeb7226d55404e290b088b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 1 Feb 2017 16:25:47 +0100 Subject: Make "~s" fail for Unicode atoms MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 26b59dfe67e introduced support for arbitrary Unicode characters in atoms. After that commit, it is possible to print any atom with a "~s" format string: 1> io:format("~s\n", ['спутник']). спутник Note that the same text as a string will fail: 2> io:format("~s\n", ["спутник"]). ** exception error: bad argument in function io:format/3 called as io:format(<0.53.0>,"~s\n", [[1089,1087,1091,1090,1085,1080,1082]]) Being more permissive for atoms is probably beneficial for io:format/2. However, for io_lib:format/2, the new behavior breaks this guarantee in the documentation for io_lib:format/2: If and only if the Unicode translation modifier is used in the format string (that is, ~ts or ~tc), the resulting list can contain characters beyond the ISO Latin-1 character range (that is, numbers > 255). The problem is that you can no longer be sure whether io_lib:format/2 will return an iolist that can be successfully passed to a port or iolist_to_binary/1. We see three solutions: 1. Keep the new behavior. That means that you can get non-iolist data when you use ~s for printing an atom, but a 'badarg' when printing Unicode strings. That is inconsistent, and it delays error detection if the result is passed to a port or iolist_to_binary/1. 2. Always allow Unicode characters for ~s. That would be incompatible, because ~s says that any binary is encoded in latin1, while ~ts says that any binary is encoded in UTF-8. To implement this solution, we could no longer support latin1 binaries; all binaries would have to be encoded in UTF-8. 3. Only allow ~s for atoms where all characters are less than 256. Require ~ts to print atoms such as 'спутник'. We reject solution 1 because it is slightly incompatible and is inconsistent. We reject solution 2 because it too incompatible. Therefore, this commit implements solution 3. --- lib/stdlib/test/io_SUITE.erl | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) (limited to 'lib/stdlib/test') diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl index 7d48cbc97c..b0a1e461e3 100644 --- a/lib/stdlib/test/io_SUITE.erl +++ b/lib/stdlib/test/io_SUITE.erl @@ -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]). -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]. %% Error cases for output. error_1(Config) when is_list(Config) -> @@ -2106,3 +2106,24 @@ 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. -- cgit v1.2.3 From 714ef59e3c3f6d765cbb60974c42ad111abf33e7 Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Fri, 3 Feb 2017 15:39:59 +0100 Subject: Fix broken test for filename:find_src/2 --- lib/stdlib/test/filename_SUITE.erl | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lib/stdlib/test') diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl index b7c4d3a6e5..54066021fb 100644 --- a/lib/stdlib/test/filename_SUITE.erl +++ b/lib/stdlib/test/filename_SUITE.erl @@ -421,8 +421,10 @@ t_nativename(Config) when is_list(Config) -> find_src(Config) when is_list(Config) -> {Source,_} = filename:find_src(file), ["file"|_] = lists:reverse(filename:split(Source)), - {_,_} = filename:find_src(init, [{".","."}, {"ebin","src"}]), - + {Source,_} = filename:find_src(file, [{"",""}, {"ebin","src"}]), + {Source,_} = filename:find_src(Source), + {Source,_} = filename:find_src(Source ++ ".erl"), + %% Try to find the source for a preloaded module. {error,{preloaded,init}} = filename:find_src(init), -- cgit v1.2.3 From 57aaf7d0c7c75cfd8c6b55c21d977b695f460022 Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Wed, 18 Jan 2017 18:28:47 +0100 Subject: Add filelib:find_file/2/3 and filelib:find_source/1/2/3 This moves, extends and exports functionality that previously existed only internally in filename:find_src/1/2, adding the ability to automatically substitute file suffixes and use different rules for different suffixes. --- lib/stdlib/test/filelib_SUITE.erl | 55 +++++++++++++++++++++++++++++++++++++-- 1 file changed, 53 insertions(+), 2 deletions(-) (limited to 'lib/stdlib/test') diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl index 4f8936edbf..87fba815d2 100644 --- a/lib/stdlib/test/filelib_SUITE.erl +++ b/lib/stdlib/test/filelib_SUITE.erl @@ -25,7 +25,8 @@ init_per_testcase/2,end_per_testcase/2, wildcard_one/1,wildcard_two/1,wildcard_errors/1, fold_files/1,otp_5960/1,ensure_dir_eexist/1,ensure_dir_symlink/1, - wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1]). + wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1, + find_source/1]). -import(lists, [foreach/2]). @@ -45,7 +46,8 @@ suite() -> all() -> [wildcard_one, wildcard_two, wildcard_errors, fold_files, otp_5960, ensure_dir_eexist, ensure_dir_symlink, - wildcard_symlink, is_file_symlink, file_props_symlink]. + wildcard_symlink, is_file_symlink, file_props_symlink, + find_source]. groups() -> []. @@ -503,3 +505,52 @@ file_props_symlink(Config) -> FileSize = filelib:file_size(Alias, erl_prim_loader), FileSize = filelib:file_size(Alias, prim_file) end. + +find_source(Config) when is_list(Config) -> + BeamFile = code:which(lists), + BeamName = filename:basename(BeamFile), + BeamDir = filename:dirname(BeamFile), + SrcName = filename:basename(BeamFile, ".beam") ++ ".erl", + + {ok, BeamFile} = filelib:find_file(BeamName, BeamDir), + {ok, BeamFile} = filelib:find_file(BeamName, BeamDir, []), + {ok, BeamFile} = filelib:find_file(BeamName, BeamDir, [{"",""},{"ebin","src"}]), + {error, not_found} = filelib:find_file(BeamName, BeamDir, [{"ebin","src"}]), + + {ok, SrcFile} = filelib:find_file(SrcName, BeamDir), + {ok, SrcFile} = filelib:find_file(SrcName, BeamDir, []), + {ok, SrcFile} = filelib:find_file(SrcName, BeamDir, [{"foo","bar"},{"ebin","src"}]), + {error, not_found} = filelib:find_file(SrcName, BeamDir, [{"",""}]), + + {ok, SrcFile} = filelib:find_source(BeamFile), + {ok, SrcFile} = filelib:find_source(BeamName, BeamDir), + {ok, SrcFile} = filelib:find_source(BeamName, BeamDir, + [{".erl",".yrl",[{"",""}]}, + {".beam",".erl",[{"ebin","src"}]}]), + {error, not_found} = filelib:find_source(BeamName, BeamDir, + [{".erl",".yrl",[{"",""}]}]), + + {ok, ParserErl} = filelib:find_source(code:which(erl_parse)), + {ok, ParserYrl} = filelib:find_source(ParserErl), + "lry." ++ _ = lists:reverse(ParserYrl), + {ok, ParserYrl} = filelib:find_source(ParserErl, + [{".beam",".erl",[{"ebin","src"}]}, + {".erl",".yrl",[{"",""}]}]), + + %% find_source automatically checks the local directory regardless of rules + {ok, ParserYrl} = filelib:find_source(ParserErl), + {ok, ParserYrl} = filelib:find_source(ParserErl, + [{".beam",".erl",[{"ebin","src"}]}]), + + %% find_file does not check the local directory unless in the rules + ParserYrlName = filename:basename(ParserYrl), + ParserYrlDir = filename:dirname(ParserYrl), + {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir, + [{"",""}]), + {error, not_found} = filelib:find_file(ParserYrlName, ParserYrlDir, + [{"ebin","src"}]), + + %% local directory is in the default list for find_file + {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir), + {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir, []), + ok. -- cgit v1.2.3 From 0eb45e21d406539caaad98bfc1740f9a11e32565 Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Tue, 6 Dec 2016 12:14:18 +0100 Subject: Add shell shortcut for recompiling existing modules This extends the shell function c/1 and c/2 so that if the argument is a module name instead of a file name, it automatically locates the .beam file and the corresponding source file, and then recompiles the module using the same compiler options (plus any options passed to c/2). If compilation fails, the old beam file is preserved. Also adds c(Mod, Opts, Filter), where the Filter argument allows you to remove old compiler options before the new options are added. --- lib/stdlib/test/shell_SUITE.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/stdlib/test') diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl index 15ccdea284..4864bc3d72 100644 --- a/lib/stdlib/test/shell_SUITE.erl +++ b/lib/stdlib/test/shell_SUITE.erl @@ -282,7 +282,7 @@ restricted_local(Config) when is_list(Config) -> comm_err(<<"begin F=fun() -> hello end, foo(F) end.">>), "exception error: undefined shell command banan/1" = comm_err(<<"begin F=fun() -> hello end, banan(F) end.">>), - "{error,"++_ = t(<<"begin F=fun() -> hello end, c(F) end.">>), + "Recompiling "++_ = t(<<"c(shell_SUITE).">>), "exception exit: restricted shell does not allow l(" ++ _ = comm_err(<<"begin F=fun() -> hello end, l(F) end.">>), "exception error: variable 'F' is unbound" = -- cgit v1.2.3 From 2a78349342b9f72651c016b650321bb317098a3c Mon Sep 17 00:00:00 2001 From: Rickard Green Date: Mon, 23 Jan 2017 21:26:22 +0100 Subject: Use magic refs for compiled match specs --- lib/stdlib/test/dets_SUITE.erl | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'lib/stdlib/test') diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl index aa31fdde5a..95c9b47465 100644 --- a/lib/stdlib/test/dets_SUITE.erl +++ b/lib/stdlib/test/dets_SUITE.erl @@ -3012,8 +3012,13 @@ repair_continuation(Config) -> MS = [{'_',[],[true]}], - {[true], C1} = dets:select(Tab, MS, 1), - C2 = binary_to_term(term_to_binary(C1)), + SRes = term_to_binary(dets:select(Tab, MS, 1)), + %% Get rid of compiled match spec + lists:foreach(fun (P) -> + garbage_collect(P) + end, processes()), + {[true], C2} = binary_to_term(SRes), + {'EXIT', {badarg, _}} = (catch dets:select(C2)), C3 = dets:repair_continuation(C2, MS), {[true], C4} = dets:select(C3), -- cgit v1.2.3 From 6f5c79240554dbb5caaafcb9124e8917e62c980d Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Mon, 6 Feb 2017 15:45:45 +0100 Subject: stdlib: Improve Erlang shell's tab-completion of long names --- lib/stdlib/test/edlin_expand_SUITE.erl | 79 ++++++++++++++++++++++++++++++++-- 1 file changed, 76 insertions(+), 3 deletions(-) (limited to 'lib/stdlib/test') 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)). -- cgit v1.2.3 From 16683b57438bcd50174a30308f48761966589aaa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 7 Feb 2017 12:56:13 +0100 Subject: stdlib test: Eliminate export_all from re_SUITE and friends There is no actual need to use export_all, since very few functions are actually called from the outside. While we are it, remove the unused functions in run_pcre_tests.erl. --- .../test/re_testoutput1_replacement_test.erl | 2 +- lib/stdlib/test/re_testoutput1_split_test.erl | 2 +- lib/stdlib/test/run_pcre_tests.erl | 73 ++-------------------- 3 files changed, 8 insertions(+), 69 deletions(-) (limited to 'lib/stdlib/test') 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(<>) 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]), -- cgit v1.2.3 From 4641b415766e4a7c4f1968a74378760192fd915a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 9 Feb 2017 13:00:28 +0100 Subject: random_{iolist,unicode_list}: Remove unused functions --- lib/stdlib/test/random_iolist.erl | 38 +-------------------------------- lib/stdlib/test/random_unicode_list.erl | 38 +-------------------------------- 2 files changed, 2 insertions(+), 74 deletions(-) (limited to 'lib/stdlib/test') 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 -> <>; 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). -- cgit v1.2.3 From 65f847788fd505dc5ceccd4f39978f31e36e385d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 10 Feb 2017 12:10:26 +0100 Subject: lists_SUITE: Run the droplast/1 test case The testcase was never actually run. --- lib/stdlib/test/lists_SUITE.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/stdlib/test') 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) -> -- cgit v1.2.3 From 72d95ebc0277081f9cc7dd484e3e56f67b25486e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 10 Feb 2017 12:38:53 +0100 Subject: ets_SUITE: Eliminate internal exports used for spawn/apply In the future we will run xref to make sure that all functions that are exported are also used. Having internal exports only used for spawning or applying will mess with that. --- lib/stdlib/test/ets_SUITE.erl | 217 ++++++++++++++++++++---------------------- 1 file changed, 104 insertions(+), 113 deletions(-) (limited to 'lib/stdlib/test') 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) -> -- cgit v1.2.3 From c09cbf5baf27391252e109c102e11fb3dbb1db2f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 10 Feb 2017 12:14:19 +0100 Subject: ets_tough_SUITE: Remove functions that are never called --- lib/stdlib/test/ets_tough_SUITE.erl | 41 ------------------------------------- 1 file changed, 41 deletions(-) (limited to 'lib/stdlib/test') diff --git a/lib/stdlib/test/ets_tough_SUITE.erl b/lib/stdlib/test/ets_tough_SUITE.erl index 49aba7a529..ec5aae27ae 100644 --- a/lib/stdlib/test/ets_tough_SUITE.erl +++ b/lib/stdlib/test/ets_tough_SUITE.erl @@ -235,33 +235,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 +351,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 -- cgit v1.2.3 From 8175aef42b87fd5c7f43bdad7890642f05906c83 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 10 Feb 2017 13:25:35 +0100 Subject: ets_tough_SUITE: Add the gen_server behavior Add a declaration to make it clear for tools that this module uses the gen_server behavior. While at it, also remove the totally unnecessary 'export_all' option. --- lib/stdlib/test/ets_tough_SUITE.erl | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) (limited to 'lib/stdlib/test') diff --git a/lib/stdlib/test/ets_tough_SUITE.erl b/lib/stdlib/test/ets_tough_SUITE.erl index ec5aae27ae..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() -> @@ -602,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). -- cgit v1.2.3 From a3291799c29e82bb2725a589ef0f804dfbd9eac7 Mon Sep 17 00:00:00 2001 From: Andrew Dryga Date: Sun, 12 Feb 2017 19:54:46 +0200 Subject: Fixed typos in lib/stdlib --- lib/stdlib/test/base64_SUITE.erl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lib/stdlib/test') 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( -- cgit v1.2.3 From aa0c4b0df7cdc750450906aff4e8c81627d80605 Mon Sep 17 00:00:00 2001 From: Paul Schoenfelder Date: Tue, 31 Jan 2017 17:40:34 -0600 Subject: Update erl_tar to support PAX format, etc. This commit introduces the following key changes: - Support for reading tar archives in formats currently in common use, such as v7, STAR, USTAR, PAX, and GNU tar's extensions to the STAR/USTAR format. - Support for writing PAX archives, only when necessary, using USTAR when possible for greater portability. These changes result in lifting of some prior restrictions: - Support for reading archives produced by modern tar implementations when other restrictions described below are present. - Support for filenames which exceed 100 bytes in length, or paths which exceed 255 bytes (see USTAR format specification for more details on this restriction). - Support for filenames of arbitrary length - Support for unicode metadata (the previous behaviour of erl_tar was actually violating the spec, by writing unicode-encoded data to fields which are defined to be 7-bit ASCII, even though this technically worked when using erl_tar at source and destination, it may not have worked with other tar utilities, and this implementation now conforms to the spec). - Support for uid/gid values which cannot be converted to octal integers. --- lib/stdlib/test/tar_SUITE.erl | 178 +++++++++++++++++++--- lib/stdlib/test/tar_SUITE_data/bsd.tar | Bin 0 -> 9216 bytes lib/stdlib/test/tar_SUITE_data/gnu.tar | Bin 0 -> 30720 bytes lib/stdlib/test/tar_SUITE_data/pax_mtime.tar | Bin 0 -> 10240 bytes lib/stdlib/test/tar_SUITE_data/sparse00.tar | Bin 0 -> 61440 bytes lib/stdlib/test/tar_SUITE_data/sparse01.tar | Bin 0 -> 61440 bytes lib/stdlib/test/tar_SUITE_data/sparse01_empty.tar | Bin 0 -> 10240 bytes lib/stdlib/test/tar_SUITE_data/sparse10.tar | Bin 0 -> 61440 bytes lib/stdlib/test/tar_SUITE_data/sparse10_empty.tar | Bin 0 -> 10240 bytes lib/stdlib/test/tar_SUITE_data/star.tar | Bin 0 -> 10240 bytes lib/stdlib/test/tar_SUITE_data/v7.tar | Bin 0 -> 10240 bytes 11 files changed, 161 insertions(+), 17 deletions(-) create mode 100644 lib/stdlib/test/tar_SUITE_data/bsd.tar create mode 100644 lib/stdlib/test/tar_SUITE_data/gnu.tar create mode 100644 lib/stdlib/test/tar_SUITE_data/pax_mtime.tar create mode 100644 lib/stdlib/test/tar_SUITE_data/sparse00.tar create mode 100644 lib/stdlib/test/tar_SUITE_data/sparse01.tar create mode 100644 lib/stdlib/test/tar_SUITE_data/sparse01_empty.tar create mode 100644 lib/stdlib/test/tar_SUITE_data/sparse10.tar create mode 100644 lib/stdlib/test/tar_SUITE_data/sparse10_empty.tar create mode 100644 lib/stdlib/test/tar_SUITE_data/star.tar create mode 100644 lib/stdlib/test/tar_SUITE_data/v7.tar (limited to 'lib/stdlib/test') 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 Binary files /dev/null and b/lib/stdlib/test/tar_SUITE_data/bsd.tar 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 Binary files /dev/null and b/lib/stdlib/test/tar_SUITE_data/gnu.tar 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 Binary files /dev/null and b/lib/stdlib/test/tar_SUITE_data/pax_mtime.tar 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 Binary files /dev/null and b/lib/stdlib/test/tar_SUITE_data/sparse00.tar 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 Binary files /dev/null and b/lib/stdlib/test/tar_SUITE_data/sparse01.tar 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 Binary files /dev/null and b/lib/stdlib/test/tar_SUITE_data/sparse01_empty.tar 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 Binary files /dev/null and b/lib/stdlib/test/tar_SUITE_data/sparse10.tar 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 Binary files /dev/null and b/lib/stdlib/test/tar_SUITE_data/sparse10_empty.tar 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 Binary files /dev/null and b/lib/stdlib/test/tar_SUITE_data/star.tar 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 Binary files /dev/null and b/lib/stdlib/test/tar_SUITE_data/v7.tar differ -- cgit v1.2.3