diff options
Diffstat (limited to 'erts/emulator/test/float_SUITE.erl')
| -rw-r--r-- | erts/emulator/test/float_SUITE.erl | 398 |
1 files changed, 247 insertions, 151 deletions
diff --git a/erts/emulator/test/float_SUITE.erl b/erts/emulator/test/float_SUITE.erl index c1a76b8af4..4098aa9c6a 100644 --- a/erts/emulator/test/float_SUITE.erl +++ b/erts/emulator/test/float_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2012. All Rights Reserved. +%% Copyright Ericsson AB 1997-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. @@ -20,63 +20,40 @@ -module(float_SUITE). --include_lib("test_server/include/test_server.hrl"). +-include_lib("common_test/include/ct.hrl"). --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, - init_per_testcase/2,end_per_testcase/2, - fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1, - bad_float_unpack/1, write/1, cmp_zero/1, cmp_integer/1, cmp_bignum/1]). +-export([all/0, suite/0, groups/0, + fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1, + t_mul_add_ops/1, + bad_float_unpack/1, write/1, cmp_zero/1, cmp_integer/1, cmp_bignum/1]). -export([otp_7178/1]). -export([hidden_inf/1]). +-export([arith/1]). - -init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) -> - Dog = ?t:timetrap(?t:minutes(3)), - [{watchdog, Dog},{testcase,Func}|Config]. - -end_per_testcase(_Func, Config) -> - Dog = ?config(watchdog, Config), - ?t:timetrap_cancel(Dog). - -suite() -> [{ct_hooks,[ts_install_cth]}]. +suite() -> + [{ct_hooks,[ts_install_cth]}, + {timetrap, {minutes, 3}}]. all() -> [fpe, fp_drv, fp_drv_thread, otp_7178, denormalized, match, bad_float_unpack, write, {group, comparison} ,hidden_inf - ]. + ,arith, t_mul_add_ops]. groups() -> [{comparison, [parallel], [cmp_zero, cmp_integer, cmp_bignum]}]. -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - %% %% OTP-7178, list_to_float on very small numbers should give 0.0 %% instead of exception, i.e. ignore underflow. %% -otp_7178(suite) -> - []; -otp_7178(doc) -> - ["test that list_to_float on very small numbers give 0.0"]; +%% test that list_to_float on very small numbers give 0.0 otp_7178(Config) when is_list(Config) -> - ?line X = list_to_float("1.0e-325"), - ?line true = (X < 0.00000001) and (X > -0.00000001), - ?line Y = list_to_float("1.0e-325325325"), - ?line true = (Y < 0.00000001) and (Y > -0.00000001), - ?line {'EXIT', {badarg,_}} = (catch list_to_float("1.0e83291083210")), + X = list_to_float("1.0e-325"), + true = (X < 0.00000001) and (X > -0.00000001), + Y = list_to_float("1.0e-325325325"), + true = (Y < 0.00000001) and (Y > -0.00000001), + {'EXIT', {badarg,_}} = (catch list_to_float("1.0e83291083210")), ok. %% Forces floating point exceptions and tests that subsequent, legal, @@ -84,15 +61,15 @@ otp_7178(Config) when is_list(Config) -> %% Strollo. fpe(Config) when is_list(Config) -> - ?line 0.0 = math:log(1.0), - ?line {'EXIT', {badarith, _}} = (catch math:log(-1.0)), - ?line 0.0 = math:log(1.0), - ?line {'EXIT', {badarith, _}} = (catch math:log(0.0)), - ?line 0.0 = math:log(1.0), - ?line {'EXIT',{badarith,_}} = (catch 3.23e133 * id(3.57e257)), - ?line 0.0 = math:log(1.0), - ?line {'EXIT',{badarith,_}} = (catch 5.0/id(0.0)), - ?line 0.0 = math:log(1.0), + 0.0 = math:log(1.0), + {'EXIT', {badarith, _}} = (catch math:log(-1.0)), + 0.0 = math:log(1.0), + {'EXIT', {badarith, _}} = (catch math:log(0.0)), + 0.0 = math:log(1.0), + {'EXIT',{badarith,_}} = (catch 3.23e133 * id(3.57e257)), + 0.0 = math:log(1.0), + {'EXIT',{badarith,_}} = (catch 5.0/id(0.0)), + 0.0 = math:log(1.0), ok. @@ -100,70 +77,70 @@ fpe(Config) when is_list(Config) -> -define(ERTS_FP_THREAD_TEST, 1). fp_drv(Config) when is_list(Config) -> - fp_drv_test(?ERTS_FP_CONTROL_TEST, ?config(data_dir, Config)). + fp_drv_test(?ERTS_FP_CONTROL_TEST, proplists:get_value(data_dir, Config)). fp_drv_thread(Config) when is_list(Config) -> %% Run in a separate node since it used to crash the emulator... - ?line Parent = self(), - ?line DrvDir = ?config(data_dir, Config), - ?line {ok,Node} = start_node(Config), - ?line Tester = spawn_link(Node, - fun () -> - Parent ! - {self(), - fp_drv_test(?ERTS_FP_THREAD_TEST, - DrvDir)} - end), - ?line Result = receive {Tester, Res} -> Res end, - ?line stop_node(Node), - ?line Result. + Parent = self(), + DrvDir = proplists:get_value(data_dir, Config), + {ok,Node} = start_node(Config), + Tester = spawn_link(Node, + fun () -> + Parent ! + {self(), + fp_drv_test(?ERTS_FP_THREAD_TEST, + DrvDir)} + end), + Result = receive {Tester, Res} -> Res end, + stop_node(Node), + Result. fp_drv_test(Test, DrvDir) -> - ?line Drv = fp_drv, - ?line try - begin - ?line case erl_ddll:load_driver(DrvDir, Drv) of - ok -> - ok; - {error, permanent} -> - ok; - {error, LoadError} -> - exit({load_error, - erl_ddll:format_error(LoadError)}); - LoadError -> - exit({load_error, LoadError}) - end, - case open_port({spawn, Drv}, []) of - Port when is_port(Port) -> - try port_control(Port, Test, "") of - "ok" -> - 0.0 = math:log(1.0), - ok; - [$s,$k,$i,$p,$:,$ | Reason] -> - {skipped, Reason}; - Error -> - exit(Error) - after - Port ! {self(), close}, - receive {Port, closed} -> ok end, - false = lists:member(Port, erlang:ports()), - ok - end; - Error -> - exit({open_port_failed, Error}) - end - end - catch - throw:Term -> ?line Term - after - erl_ddll:unload_driver(Drv) - end. + Drv = fp_drv, + try + begin + case erl_ddll:load_driver(DrvDir, Drv) of + ok -> + ok; + {error, permanent} -> + ok; + {error, LoadError} -> + exit({load_error, + erl_ddll:format_error(LoadError)}); + LoadError -> + exit({load_error, LoadError}) + end, + case open_port({spawn, Drv}, []) of + Port when is_port(Port) -> + try port_control(Port, Test, "") of + "ok" -> + 0.0 = math:log(1.0), + ok; + [$s,$k,$i,$p,$:,$ | Reason] -> + {skipped, Reason}; + Error -> + exit(Error) + after + Port ! {self(), close}, + receive {Port, closed} -> ok end, + false = lists:member(Port, erlang:ports()), + ok + end; + Error -> + exit({open_port_failed, Error}) + end + end + catch + throw:Term -> Term + after + erl_ddll:unload_driver(Drv) + end. denormalized(Config) when is_list(Config) -> - ?line Denormalized = 1.0e-307 / 1000, - ?line roundtrip(Denormalized), - ?line NegDenormalized = -1.0e-307 / 1000, - ?line roundtrip(NegDenormalized), + Denormalized = 1.0e-307 / 1000, + roundtrip(Denormalized), + NegDenormalized = -1.0e-307 / 1000, + roundtrip(NegDenormalized), ok. roundtrip(N) -> @@ -171,12 +148,12 @@ roundtrip(N) -> N = binary_to_term(term_to_binary(N, [{minor_version,1}])). match(Config) when is_list(Config) -> - ?line one = match_1(1.0), - ?line two = match_1(2.0), - ?line a_lot = match_1(1000.0), - ?line {'EXIT',_} = (catch match_1(0.5)), + one = match_1(1.0), + two = match_1(2.0), + a_lot = match_1(1000.0), + {'EXIT',_} = (catch match_1(0.5)), ok. - + match_1(1.0) -> one; match_1(2.0) -> two; match_1(1000.0) -> a_lot. @@ -184,8 +161,8 @@ match_1(1000.0) -> a_lot. %% Thanks to Per Gustafsson. bad_float_unpack(Config) when is_list(Config) -> - ?line Bin = <<-1:64>>, - ?line -1 = bad_float_unpack_match(Bin), + Bin = <<-1:64>>, + -1 = bad_float_unpack_match(Bin), ok. bad_float_unpack_match(<<F:64/float>>) -> F; @@ -231,81 +208,81 @@ span_cmp(Axis, Incr, Length) -> %% for both negative and positive numbers. %% %% Axis: The number around which to do the tests eg. (1 bsl 58) - 1.0 -%% Incr: How much to increment the test numbers inbetween each test. +%% Incr: How much to increment the test numbers in-between each test. %% Length: Length/2 is the number of Incr away from Axis to test on the %% negative and positive plane. %% Diff: How much the float and int should differ when comparing span_cmp(Axis, Incr, Length, Diff) -> [begin - cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr), - cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr) + cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr), + cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr) end || I <- lists:seq((Length div 2)*-1,(Length div 2))], [begin - cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr), - cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr) + cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr), + cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr) end || I <- lists:seq((Length div 2)*-1,(Length div 2))]. cmp(Big,Small) when is_float(Big) -> BigGtSmall = lists:flatten( - io_lib:format("~f > ~p",[Big,Small])), + io_lib:format("~f > ~p",[Big,Small])), BigLtSmall = lists:flatten( - io_lib:format("~f < ~p",[Big,Small])), + io_lib:format("~f < ~p",[Big,Small])), BigEqSmall = lists:flatten( - io_lib:format("~f == ~p",[Big,Small])), + io_lib:format("~f == ~p",[Big,Small])), SmallGtBig = lists:flatten( - io_lib:format("~p > ~f",[Small,Big])), + io_lib:format("~p > ~f",[Small,Big])), SmallLtBig = lists:flatten( - io_lib:format("~p < ~f",[Small,Big])), + io_lib:format("~p < ~f",[Small,Big])), SmallEqBig = lists:flatten( - io_lib:format("~p == ~f",[Small,Big])), + io_lib:format("~p == ~f",[Small,Big])), cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, - SmallEqBig,BigEqSmall); + SmallEqBig,BigEqSmall); cmp(Big,Small) when is_float(Small) -> BigGtSmall = lists:flatten( - io_lib:format("~p > ~f",[Big,Small])), + io_lib:format("~p > ~f",[Big,Small])), BigLtSmall = lists:flatten( - io_lib:format("~p < ~f",[Big,Small])), + io_lib:format("~p < ~f",[Big,Small])), BigEqSmall = lists:flatten( - io_lib:format("~p == ~f",[Big,Small])), + io_lib:format("~p == ~f",[Big,Small])), SmallGtBig = lists:flatten( - io_lib:format("~f > ~p",[Small,Big])), + io_lib:format("~f > ~p",[Small,Big])), SmallLtBig = lists:flatten( - io_lib:format("~f < ~p",[Small,Big])), + io_lib:format("~f < ~p",[Small,Big])), SmallEqBig = lists:flatten( - io_lib:format("~f == ~p",[Small,Big])), + io_lib:format("~f == ~p",[Small,Big])), cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, - SmallEqBig,BigEqSmall). + SmallEqBig,BigEqSmall). cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig, SmallEqBig,BigEqSmall) -> {_,_,_,true} = {Big,Small,BigGtSmall, - Big > Small}, + Big > Small}, {_,_,_,false} = {Big,Small,BigLtSmall, - Big < Small}, + Big < Small}, {_,_,_,false} = {Big,Small,SmallGtBig, - Small > Big}, + Small > Big}, {_,_,_,true} = {Big,Small,SmallLtBig, - Small < Big}, + Small < Big}, {_,_,_,false} = {Big,Small,SmallEqBig, - Small == Big}, + Small == Big}, {_,_,_,false} = {Big,Small,BigEqSmall, - Big == Small}. + Big == Small}. id(I) -> I. - + start_node(Config) when is_list(Config) -> - ?line Pa = filename:dirname(code:which(?MODULE)), - ?line Name = list_to_atom(atom_to_list(?MODULE) - ++ "-" - ++ atom_to_list(?config(testcase, Config)) - ++ "-" - ++ integer_to_list(erlang:system_time(seconds)) - ++ "-" - ++ integer_to_list(erlang:unique_integer([positive]))), - ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]). + Pa = filename:dirname(code:which(?MODULE)), + Name = list_to_atom(atom_to_list(?MODULE) + ++ "-" + ++ atom_to_list(proplists:get_value(testcase, Config)) + ++ "-" + ++ integer_to_list(erlang:system_time(second)) + ++ "-" + ++ integer_to_list(erlang:unique_integer([positive]))), + test_server:start_node(Name, slave, [{args, "-pa "++Pa}]). stop_node(Node) -> - ?t:stop_node(Node). + test_server:stop_node(Node). %% Test that operations that might hide infinite intermediate results @@ -315,8 +292,8 @@ hidden_inf(Config) when is_list(Config) -> ZeroN = id(ZeroP) * (-1), [hidden_inf_1(A, B, Z, 9.23e307) || A <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN], - B <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN], - Z <- [ZeroP, ZeroN]], + B <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN], + Z <- [ZeroP, ZeroN]], ok. hidden_inf_1(A, B, Zero, Huge) -> @@ -328,3 +305,122 @@ hidden_inf_1(A, B, Zero, Huge) -> {'EXIT',{badarith,_}} = (catch (B * (Huge + Huge))), {'EXIT',{badarith,_}} = (catch (B / (-Huge - Huge))), {'EXIT',{badarith,_}} = (catch (B * (-Huge - Huge))). + +%% Improve code coverage in our different arithmetic functions +%% and make sure they yield consistent results. +arith(_Config) -> + _TAG_IMMED1_SIZE = 4, + + <<FLOAT_MAX/float>> = <<0:1, 16#7fe:11, -1:52>>, + <<FLOAT_MIN/float>> = <<0:1, 0:11, 1:52>>, + <<FloatNegZero/float>> = <<1:1, 0:11, 0:52>>, + + WORD_BITS = erlang:system_info(wordsize) * 8, + SMALL_BITS = (WORD_BITS - _TAG_IMMED1_SIZE), + SMALL_MAX = (1 bsl (SMALL_BITS-1)) - 1, + SMALL_MIN = -(1 bsl (SMALL_BITS-1)), + BIG1_MAX = (1 bsl WORD_BITS) - 1, + BIG2_MAX = (1 bsl (WORD_BITS*2)) - 1, + + fixnum = erts_internal:term_type(SMALL_MAX), + fixnum = erts_internal:term_type(SMALL_MIN), + bignum = erts_internal:term_type(SMALL_MAX + 1), + bignum = erts_internal:term_type(SMALL_MIN - 1), + + L = [0, 0.0, FloatNegZero, 1, 1.0, 17, 17.0, 0.17, + FLOAT_MIN, FLOAT_MAX, + SMALL_MAX, SMALL_MAX+1, + SMALL_MIN, SMALL_MIN-1, + BIG1_MAX, BIG1_MAX+1, + BIG2_MAX, BIG2_MAX+1, + trunc(FLOAT_MAX), trunc(FLOAT_MAX)+1, trunc(FLOAT_MAX)*2, + immed_badarg, + "list badarg", + {"boxed badarg"}], + + foreach_pair(fun(A,B) -> do_bin_ops(A,B) end, L). + +foreach_pair(F, L) -> + lists:foreach( + fun(A) -> lists:foreach(fun(B) -> F(A,B) end, L) end, + L). + +do_bin_ops(A, B) -> + Fun = fun(Op) -> + Op(A,B), + is_number(A) andalso Op(-A,B), + is_number(B) andalso Op(A,-B), + is_number(A) andalso is_number(B) andalso Op(-A,-B) + end, + lists:foreach(Fun, + [fun op_add/2, fun op_sub/2, fun op_mul/2, fun op_div/2]). + +op_add(A, B) -> + Info = [A,B], + R = unify(catch A + B, Info), + R = unify(my_apply(erlang,'+',[A,B]), Info), + case R of + _ when A + B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +op_sub(A, B) -> + Info = [A,B], + R = unify(catch A - B, Info), + R = unify(my_apply(erlang,'-',[A,B]), Info), + case R of + _ when A - B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +op_mul(A, B) -> + Info = [A,B], + R = unify(catch A * B, Info), + R = unify(my_apply(erlang,'*',[A,B]), Info), + case R of + _ when A * B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +op_div(A, B) -> + Info = [A,B], + R = unify(catch A / B, Info), + R = unify(my_apply(erlang,'/',[A,B]), Info), + case R of + _ when A / B =:= element(1,R) -> ok; + {{'EXIT',badarith}, Info} -> ok + end. + +my_apply(M, F, A) -> + catch apply(id(M), id(F), A). + +% Unify exceptions be removing stack traces. +% and add argument info to make it easer to debug failed matches. +unify({'EXIT',{Reason,_Stack}}, Info) -> + {{'EXIT', Reason}, Info}; +unify(Other, Info) -> + {Other, Info}. + + +-define(epsilon, 1.0e-20). +check_epsilon(R,Val) -> + if erlang:abs(R-Val) < ?epsilon -> ok; + true -> ct:fail({R,Val}) + end. + +t_mul_add_ops(Config) when is_list(Config) -> + check_epsilon(op_mul_add(1, 2.0, 1.0, 0.0), 1.0), + check_epsilon(op_mul_add(2, 2.0, 1.0, 0.0), 3.0), + check_epsilon(op_mul_add(3, 2.0, 1.0, 0.0), 7.0), + check_epsilon(op_mul_add(4, 2.0, 1.0, 0.0), 15.0), + check_epsilon(op_mul_add(5, 2.0, 1.0, 0.0), 31.0), + check_epsilon(op_mul_add(6, 2.0, 1.0, 0.0), 63.0), + check_epsilon(op_mul_add(6, 2.0, 1.3, 0.0), 81.9), + check_epsilon(op_mul_add(6, 2.03, 1.3, 0.0), 87.06260151458997), + ok. + + +op_mul_add(0, _, _, R) -> R; +op_mul_add(N, A, B, R) when is_float(A), is_float(B), is_float(R) -> + op_mul_add(N - 1, A, B, R * A + B). + |