%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 1997-2011. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
%%
%% %CopyrightEnd%
%%
-module(float_SUITE).
-include_lib("test_server/include/test_server.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,cmp_zero/1, cmp_integer/1, cmp_bignum/1]).
-export([otp_7178/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]}].
all() ->
[fpe, fp_drv, fp_drv_thread, otp_7178, denormalized,
match, bad_float_unpack, {group, comparison}].
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"];
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")),
ok.
%% Forces floating point exceptions and tests that subsequent, legal,
%% operations are calculated correctly. Original version by Sebastian
%% 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),
ok.
-define(ERTS_FP_CONTROL_TEST, 0).
-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_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.
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.
denormalized(Config) when is_list(Config) ->
?line Denormalized = 1.0e-307 / 1000,
?line roundtrip(Denormalized),
?line NegDenormalized = -1.0e-307 / 1000,
?line roundtrip(NegDenormalized),
ok.
roundtrip(N) ->
N = binary_to_term(term_to_binary(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)),
ok.
match_1(1.0) -> one;
match_1(2.0) -> two;
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),
ok.
bad_float_unpack_match(<<F:64/float>>) -> F;
bad_float_unpack_match(<<I:64/integer-signed>>) -> I.
cmp_zero(_Config) ->
cmp(0.5e-323,0).
cmp_integer(_Config) ->
Axis = (1 bsl 53)-2.0, %% The point where floating points become unprecise
span_cmp(Axis,2,200),
cmp(Axis*Axis, round(Axis)).
cmp_bignum(_Config) ->
span_cmp((1 bsl 58) - 1.0),%% Smallest bignum float
%% Test I to I+1 bignum segment overflow
[span_cmp((1 bsl (32*I)) - 1.0) || I <- lists:seq(2,30)],
cmp((1 bsl (64*16)) - 1, (1 bsl (64*15)) * 1.0),
ok.
span_cmp(Axis) ->
span_cmp(Axis, 50).
span_cmp(Axis, Length) ->
span_cmp(Axis, round(Axis) bsr 52, Length).
span_cmp(Axis, Incr, Length) ->
[cmp(round(Axis*-1.0)+1+I*Incr,Axis*-1.0+I*Incr)
|| I <- lists:seq((Length div 2)*-1,(Length div 2))],
[cmp(round(Axis)+1+I*Incr,Axis+I*Incr) ||
I <- lists:seq((Length div 2)*-1,(Length div 2))].
cmp(Big,Small) ->
BigSmall = lists:flatten(
io_lib:format("~p > ~p",[Big,Small])),
SmallBig = lists:flatten(
io_lib:format("~p < ~p",[Big,Small])),
{_,_,_,true} = {Big,Small,BigSmall,
Big > Small},
{_,_,_,false} = {Big,Small,SmallBig,
Big < Small},
{BigSmall, SmallBig}.
id(I) -> I.
start_node(Config) when is_list(Config) ->
?line Pa = filename:dirname(code:which(?MODULE)),
?line {A, B, C} = now(),
?line Name = list_to_atom(atom_to_list(?MODULE)
++ "-"
++ atom_to_list(?config(testcase, Config))
++ "-"
++ integer_to_list(A)
++ "-"
++ integer_to_list(B)
++ "-"
++ integer_to_list(C)),
?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]).
stop_node(Node) ->
?t:stop_node(Node).
