From 1ecdeb93de260fcd31a9e7032e404b92d206e50f Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Mon, 2 Oct 2017 17:09:50 +0200 Subject: stdlib: Minor unicode_util opts Exit early for Latin-1 --- lib/stdlib/test/string_SUITE.erl | 16 ++++++++-------- lib/stdlib/test/unicode_util_SUITE.erl | 2 +- 2 files changed, 9 insertions(+), 9 deletions(-) (limited to 'lib/stdlib/test') diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index 90f980c0e5..3e50a0e3c1 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -92,7 +92,7 @@ end_per_testcase(_Case, _Config) -> ok. debug() -> - Config = [{data_dir, ?MODULE_STRING++"_data"}], + Config = [{data_dir, "./" ++ ?MODULE_STRING++"_data"}], [io:format("~p:~p~n",[Test,?MODULE:Test(Config)]) || {_,Tests} <- groups(), Test <- Tests]. @@ -717,19 +717,19 @@ meas(Config) -> {_,{_,Scale}} when Scale > 1 -> {skip,{will_not_run_in_debug,Scale}}; _ -> % No scaling - DataDir = proplists:get_value(data_dir, Config), - TestDir = filename:dirname(string:trim(DataDir, trailing, "/")), - do_measure(TestDir) + DataDir0 = proplists:get_value(data_dir, Config), + DataDir = filename:join(lists:droplast(filename:split(DataDir0))), + do_measure(DataDir) end. -do_measure(TestDir) -> - File = filename:join(TestDir, ?MODULE_STRING ++ ".erl"), +do_measure(DataDir) -> + File = filename:join([DataDir,"unicode_util_SUITE_data","NormalizationTest.txt"]), io:format("File ~s ",[File]), {ok, Bin} = file:read_file(File), io:format("~p~n",[byte_size(Bin)]), Do = fun(Name, Func, Mode) -> {N, Mean, Stddev, _} = time_func(Func, Mode, Bin), - io:format("~10w ~6w ~6.2fms ±~4.2fms #~.2w gc included~n", + io:format("~10w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n", [Name, Mode, Mean/1000, Stddev/1000, N]) end, io:format("----------------------~n"), @@ -947,7 +947,7 @@ time_func(Fun, Mode, Bin) -> end), receive {Pid,Msg} -> Msg end. -time_func(N,Sum,SumSq, Fun, Str, _) when N < 50 -> +time_func(N,Sum,SumSq, Fun, Str, _) when N < 20 -> {Time, Res} = timer:tc(fun() -> Fun(Str) end), time_func(N+1,Sum+Time,SumSq+Time*Time, Fun, Str, Res); time_func(N,Sum,SumSq, _, _, Res) -> diff --git a/lib/stdlib/test/unicode_util_SUITE.erl b/lib/stdlib/test/unicode_util_SUITE.erl index 03c24c7027..f23e6b8b9a 100644 --- a/lib/stdlib/test/unicode_util_SUITE.erl +++ b/lib/stdlib/test/unicode_util_SUITE.erl @@ -312,7 +312,7 @@ get(_) -> count(Config) -> ct:timetrap({minutes,5}), case ct:get_timetrap_info() of - {_,{_,Scale}} -> + {_,{_,Scale}} when Scale > 1 -> {skip,{measurments_skipped_debug,Scale}}; _ -> % No scaling do_measure(Config) -- cgit v1.2.3 From 8350886687735b3552f41780563eedac7e6650e7 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Wed, 4 Oct 2017 16:20:25 +0200 Subject: stdlib: string optimize special case for ASCII Avoid unicode_util module call for ASCII strings --- lib/stdlib/test/string_SUITE.erl | 94 ++++++++++++++++++++++++++++++++++++---- 1 file changed, 86 insertions(+), 8 deletions(-) (limited to 'lib/stdlib/test') diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index 3e50a0e3c1..7a39439764 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -97,9 +97,6 @@ debug() -> {_,Tests} <- groups(), Test <- Tests]. -define(TEST(B,C,D), test(?LINE,?FUNCTION_NAME,B,C,D, true)). --define(TEST_EQ(B,C,D), - test(?LINE,?FUNCTION_NAME,B,C,D, true), - test(?LINE,?FUNCTION_NAME,hd(C),[B|tl(C),D, true)). -define(TEST_NN(B,C,D), test(?LINE,?FUNCTION_NAME,B,C,D, false), @@ -294,6 +291,7 @@ trim(_) -> ?TEST(["..h", ".e", <<"j..">>], [both, ". "], "h.ej"), ?TEST(["..h", <<".ejsa"/utf8>>, "n.."], [both, ". "], "h.ejsan"), %% Test that it behaves with graphemes (i.e. nfd tests are the hard part) + ?TEST([1013,101,778,101,101], [trailing, [101]], [1013,101,778]), ?TEST("aaåaa", [both, "a"], "å"), ?TEST(["aaa",778,"äöoo"], [both, "ao"], "åäö"), ?TEST([<<"aaa">>,778,"äöoo"], [both, "ao"], "åäö"), @@ -353,6 +351,7 @@ take(_) -> ?TEST([<<>>,<<"..">>, " h.ej", <<" ..">>], [Chars, true, leading], {".. ", "h.ej .."}), ?TEST(["..h", <<".ejsa"/utf8>>, "n.."], [Chars, true, leading], {"..", "h.ejsan.."}), %% Test that it behaves with graphemes (i.e. nfd tests are the hard part) + ?TEST([101,778], [[[101, 779]], true], {[101,778], []}), ?TEST(["aaee",778,"äöoo"], [[[$e,778]], true, leading], {"aae", [$e,778|"äöoo"]}), ?TEST([<<"aae">>,778,"äöoo"], [[[$e,778]],true,leading], {"aa", [$e,778|"äöoo"]}), ?TEST([<<"e">>,778,"åäöe", <<778/utf8>>], [[[$e,778]], true, leading], {[], [$e,778]++"åäöe"++[778]}), @@ -719,7 +718,15 @@ meas(Config) -> _ -> % No scaling DataDir0 = proplists:get_value(data_dir, Config), DataDir = filename:join(lists:droplast(filename:split(DataDir0))), - do_measure(DataDir) + case proplists:get_value(profile, Config, false) of + false -> + do_measure(DataDir); + eprof -> + eprof:profile(fun() -> do_measure(DataDir) end, [set_on_spawn]), + eprof:stop_profiling(), + eprof:analyze(), + eprof:stop() + end end. do_measure(DataDir) -> @@ -729,13 +736,86 @@ do_measure(DataDir) -> io:format("~p~n",[byte_size(Bin)]), Do = fun(Name, Func, Mode) -> {N, Mean, Stddev, _} = time_func(Func, Mode, Bin), - io:format("~10w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n", + io:format("~15w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n", [Name, Mode, Mean/1000, Stddev/1000, N]) end, + Do2 = fun(Name, Func, Mode) -> + {N, Mean, Stddev, _} = time_func(Func, binary, <<>>), + io:format("~15w ~6w ~6.2fms ±~5.2fms #~.2w gc included~n", + [Name, Mode, Mean/1000, Stddev/1000, N]) + end, io:format("----------------------~n"), - Do(tokens, fun(Str) -> string:tokens(Str, [$\n,$\r]) end, list), + + Do(old_tokens, fun(Str) -> string:tokens(Str, [$\n,$\r]) end, list), Tokens = {lexemes, fun(Str) -> string:lexemes(Str, [$\n,$\r]) end}, [Do(Name,Fun,Mode) || {Name,Fun} <- [Tokens], Mode <- [list, binary]], + + S0 = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy.....", + S0B = <<"xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy.....">>, + Do2(old_strip_l, repeat(fun() -> string:strip(S0, left, $x) end), list), + Do2(trim_l, repeat(fun() -> string:trim(S0, leading, [$x]) end), list), + Do2(trim_l, repeat(fun() -> string:trim(S0B, leading, [$x]) end), binary), + Do2(old_strip_r, repeat(fun() -> string:strip(S0, right, $.) end), list), + Do2(trim_t, repeat(fun() -> string:trim(S0, trailing, [$.]) end), list), + Do2(trim_t, repeat(fun() -> string:trim(S0B, trailing, [$.]) end), binary), + + Do2(old_chr_sub, repeat(fun() -> string:sub_string(S0, string:chr(S0, $.)) end), list), + Do2(old_str_sub, repeat(fun() -> string:sub_string(S0, string:str(S0, [$.])) end), list), + Do2(find, repeat(fun() -> string:find(S0, [$.]) end), list), + Do2(find, repeat(fun() -> string:find(S0B, [$.]) end), binary), + Do2(old_str_sub2, repeat(fun() -> N = string:str(S0, "xy.."), + {string:sub_string(S0,1,N), string:sub_string(S0,N+4)} end), list), + Do2(split, repeat(fun() -> string:split(S0, "xy..") end), list), + Do2(split, repeat(fun() -> string:split(S0B, "xy..") end), binary), + + Do2(old_rstr_sub, repeat(fun() -> string:sub_string(S0, string:rstr(S0, [$y])) end), list), + Do2(find_t, repeat(fun() -> string:find(S0, [$y], trailing) end), list), + Do2(find_t, repeat(fun() -> string:find(S0B, [$y], trailing) end), binary), + Do2(old_rstr_sub2, repeat(fun() -> N = string:rstr(S0, "y.."), + {string:sub_string(S0,1,N), string:sub_string(S0,N+3)} end), list), + Do2(split_t, repeat(fun() -> string:split(S0, "y..", trailing) end), list), + Do2(split_t, repeat(fun() -> string:split(S0B, "y..", trailing) end), binary), + + Do2(old_span, repeat(fun() -> N=string:span(S0, [$x, $y]), + {string:sub_string(S0,1,N),string:sub_string(S0,N+1)} + end), list), + Do2(take, repeat(fun() -> string:take(S0, [$x, $y]) end), list), + Do2(take, repeat(fun() -> string:take(S0B, [$x, $y]) end), binary), + + Do2(old_cspan, repeat(fun() -> N=string:cspan(S0, [$.,$y]), + {string:sub_string(S0,1,N),string:sub_string(S0,N+1)} + end), list), + Do2(take_c, repeat(fun() -> string:take(S0, [$.,$y], true) end), list), + Do2(take_c, repeat(fun() -> string:take(S0B, [$.,$y], true) end), binary), + + Do2(old_substr, repeat(fun() -> string:substr(S0, 21, 15) end), list), + Do2(slice, repeat(fun() -> string:slice(S0, 20, 15) end), list), + Do2(slice, repeat(fun() -> string:slice(S0B, 20, 15) end), binary), + + io:format("--~n",[]), + NthTokens = {nth_lexemes, fun(Str) -> string:nth_lexeme(Str, 18000, [$\n,$\r]) end}, + [Do(Name,Fun,Mode) || {Name,Fun} <- [NthTokens], Mode <- [list, binary]], + Do2(take_t, repeat(fun() -> string:take(S0, [$.,$y], false, trailing) end), list), + Do2(take_t, repeat(fun() -> string:take(S0B, [$.,$y], false, trailing) end), binary), + Do2(take_tc, repeat(fun() -> string:take(S0, [$x], true, trailing) end), list), + Do2(take_tc, repeat(fun() -> string:take(S0B, [$x], true, trailing) end), binary), + + Length = {length, fun(Str) -> string:length(Str) end}, + [Do(Name,Fun,Mode) || {Name,Fun} <- [Length], Mode <- [list, binary]], + + Reverse = {reverse, fun(Str) -> string:reverse(Str) end}, + [Do(Name,Fun,Mode) || {Name,Fun} <- [Reverse], Mode <- [list, binary]], + + ok. + +repeat(F) -> + fun(_) -> repeat_1(F,20000) end. + +repeat_1(F, N) when N > 0 -> + F(), + repeat_1(F, N-1); +repeat_1(_, _) -> + erlang:garbage_collect(), ok. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -865,8 +945,6 @@ check_types_1({list, _},{list, undefined}) -> ok; check_types_1({list, _},{list, codepoints}) -> ok; -check_types_1({list, _},{list, {list, codepoints}}) -> - ok; check_types_1({list, {list, _}},{list, {list, codepoints}}) -> ok; check_types_1(mixed,_) -> -- cgit v1.2.3 From 34df9b51b0237172c41e81fd5ae5597cba534473 Mon Sep 17 00:00:00 2001 From: Dan Gudmundsson Date: Fri, 13 Oct 2017 14:35:07 +0200 Subject: Avoid falling measurements testcases on slow machines --- lib/stdlib/test/string_SUITE.erl | 37 +++++++++++++++++++++++----------- lib/stdlib/test/unicode_util_SUITE.erl | 15 ++++++++++++-- 2 files changed, 38 insertions(+), 14 deletions(-) (limited to 'lib/stdlib/test') diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index 7a39439764..f43bfb4482 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -712,21 +712,34 @@ nth_lexeme(_) -> meas(Config) -> + Parent = self(), + Exec = fun() -> + DataDir0 = proplists:get_value(data_dir, Config), + DataDir = filename:join(lists:droplast(filename:split(DataDir0))), + case proplists:get_value(profile, Config, false) of + false -> + do_measure(DataDir); + eprof -> + eprof:profile(fun() -> do_measure(DataDir) end, [set_on_spawn]), + eprof:stop_profiling(), + eprof:analyze(), + eprof:stop() + end, + Parent ! {test_done, self()}, + normal + end, + ct:timetrap({minutes,2}), case ct:get_timetrap_info() of {_,{_,Scale}} when Scale > 1 -> {skip,{will_not_run_in_debug,Scale}}; - _ -> % No scaling - DataDir0 = proplists:get_value(data_dir, Config), - DataDir = filename:join(lists:droplast(filename:split(DataDir0))), - case proplists:get_value(profile, Config, false) of - false -> - do_measure(DataDir); - eprof -> - eprof:profile(fun() -> do_measure(DataDir) end, [set_on_spawn]), - eprof:stop_profiling(), - eprof:analyze(), - eprof:stop() - end + _ -> % No scaling, run at most 1.5 min + Tester = spawn(Exec), + receive {test_done, Tester} -> ok + after 90000 -> + io:format("Timelimit reached stopping~n",[]), + exit(Tester, die) + end, + ok end. do_measure(DataDir) -> diff --git a/lib/stdlib/test/unicode_util_SUITE.erl b/lib/stdlib/test/unicode_util_SUITE.erl index f23e6b8b9a..a89627eba5 100644 --- a/lib/stdlib/test/unicode_util_SUITE.erl +++ b/lib/stdlib/test/unicode_util_SUITE.erl @@ -310,12 +310,23 @@ get(_) -> add_get_tests. count(Config) -> + Parent = self(), + Exec = fun() -> + do_measure(Config), + Parent ! {test_done, self()} + end, ct:timetrap({minutes,5}), case ct:get_timetrap_info() of {_,{_,Scale}} when Scale > 1 -> {skip,{measurments_skipped_debug,Scale}}; - _ -> % No scaling - do_measure(Config) + _ -> % No scaling, run at most 2 min + Tester = spawn(Exec), + receive {test_done, Tester} -> ok + after 120000 -> + io:format("Timelimit reached stopping~n",[]), + exit(Tester, die) + end, + ok end. do_measure(Config) -> -- cgit v1.2.3