1: %%
    2: %% %CopyrightBegin%
    3: %% 
    4: %% Copyright Ericsson AB 1997-2012. All Rights Reserved.
    5: %% 
    6: %% The contents of this file are subject to the Erlang Public License,
    7: %% Version 1.1, (the "License"); you may not use this file except in
    8: %% compliance with the License. You should have received a copy of the
    9: %% Erlang Public License along with this software. If not, it can be
   10: %% retrieved online at http://www.erlang.org/.
   11: %% 
   12: %% Software distributed under the License is distributed on an "AS IS"
   13: %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
   14: %% the License for the specific language governing rights and limitations
   15: %% under the License.
   16: %% 
   17: %% %CopyrightEnd%
   18: %%
   19: 
   20: -module(float_SUITE).
   21: 
   22: -include_lib("test_server/include/test_server.hrl").
   23: 
   24: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
   25: 	 init_per_group/2,end_per_group/2,
   26: 	 init_per_testcase/2,end_per_testcase/2,
   27: 	 fpe/1,fp_drv/1,fp_drv_thread/1,denormalized/1,match/1,
   28: 	 bad_float_unpack/1, write/1, cmp_zero/1, cmp_integer/1, cmp_bignum/1]).
   29: -export([otp_7178/1]).
   30: -export([hidden_inf/1]).
   31: 
   32: 
   33: init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
   34:     Dog = ?t:timetrap(?t:minutes(3)),
   35:     [{watchdog, Dog},{testcase,Func}|Config].
   36: 
   37: end_per_testcase(_Func, Config) ->
   38:     Dog = ?config(watchdog, Config),
   39:     ?t:timetrap_cancel(Dog).
   40: 
   41: suite() -> [{ct_hooks,[ts_install_cth]}].
   42: 
   43: all() -> 
   44:     [fpe, fp_drv, fp_drv_thread, otp_7178, denormalized,
   45:      match, bad_float_unpack, write, {group, comparison}
   46:      ,hidden_inf
   47:     ].
   48: 
   49: groups() -> 
   50:     [{comparison, [parallel], [cmp_zero, cmp_integer, cmp_bignum]}].
   51: 
   52: init_per_suite(Config) ->
   53:     Config.
   54: 
   55: end_per_suite(_Config) ->
   56:     ok.
   57: 
   58: init_per_group(_GroupName, Config) ->
   59:     Config.
   60: 
   61: end_per_group(_GroupName, Config) ->
   62:     Config.
   63: 
   64: 
   65: %%
   66: %% OTP-7178, list_to_float on very small numbers should give 0.0
   67: %% instead of exception, i.e. ignore underflow.
   68: %%
   69: otp_7178(suite) ->
   70:     [];
   71: otp_7178(doc) ->
   72:     ["test that list_to_float on very small numbers give 0.0"];
   73: otp_7178(Config) when is_list(Config) ->
   74:     ?line X = list_to_float("1.0e-325"),
   75:     ?line true = (X < 0.00000001) and (X > -0.00000001),
   76:     ?line Y = list_to_float("1.0e-325325325"),
   77:     ?line true = (Y < 0.00000001) and (Y > -0.00000001),
   78:     ?line {'EXIT', {badarg,_}} = (catch list_to_float("1.0e83291083210")),
   79:     ok.
   80: 
   81: %% Forces floating point exceptions and tests that subsequent, legal,
   82: %% operations are calculated correctly.  Original version by Sebastian
   83: %% Strollo.
   84: 
   85: fpe(Config) when is_list(Config) ->
   86:     ?line 0.0 = math:log(1.0),
   87:     ?line {'EXIT', {badarith, _}} = (catch math:log(-1.0)),
   88:     ?line 0.0 = math:log(1.0),
   89:     ?line {'EXIT', {badarith, _}} = (catch math:log(0.0)),
   90:     ?line 0.0 = math:log(1.0),
   91:     ?line {'EXIT',{badarith,_}} = (catch 3.23e133 * id(3.57e257)),
   92:     ?line 0.0 = math:log(1.0),
   93:     ?line {'EXIT',{badarith,_}} = (catch 5.0/id(0.0)),
   94:     ?line 0.0 = math:log(1.0),
   95:     ok.
   96: 
   97: 
   98: -define(ERTS_FP_CONTROL_TEST, 0).
   99: -define(ERTS_FP_THREAD_TEST, 1).
  100: 
  101: fp_drv(Config) when is_list(Config) ->
  102:     fp_drv_test(?ERTS_FP_CONTROL_TEST, ?config(data_dir, Config)).
  103: 
  104: fp_drv_thread(Config) when is_list(Config) ->
  105:     %% Run in a separate node since it used to crash the emulator...
  106:     ?line Parent = self(),
  107:     ?line DrvDir = ?config(data_dir, Config),
  108:     ?line {ok,Node} = start_node(Config),
  109:     ?line Tester = spawn_link(Node,
  110: 			      fun () ->
  111: 				      Parent !
  112: 					  {self(),
  113: 					   fp_drv_test(?ERTS_FP_THREAD_TEST,
  114: 						       DrvDir)}
  115: 			      end),
  116:     ?line Result = receive {Tester, Res} -> Res end,
  117:     ?line stop_node(Node),
  118:     ?line Result.
  119: 
  120: fp_drv_test(Test, DrvDir) ->
  121:     ?line Drv = fp_drv,
  122:     ?line try
  123: 	      begin
  124: 		  ?line case erl_ddll:load_driver(DrvDir, Drv) of
  125: 			    ok ->
  126: 				ok;
  127: 			    {error, permanent} ->
  128: 				ok;
  129: 			    {error, LoadError} ->
  130: 				exit({load_error,
  131: 				      erl_ddll:format_error(LoadError)});
  132: 			     LoadError ->
  133: 				exit({load_error, LoadError})
  134: 			end,
  135: 		  case open_port({spawn, Drv}, []) of
  136: 		      Port when is_port(Port) ->
  137: 			      try port_control(Port, Test, "") of
  138: 				  "ok" ->
  139: 				      0.0 = math:log(1.0),
  140: 				      ok;
  141: 				  [$s,$k,$i,$p,$:,$ | Reason] ->
  142: 				      {skipped, Reason};
  143: 				  Error ->
  144: 				      exit(Error)
  145: 			      after
  146: 				  Port ! {self(), close},
  147: 				receive {Port, closed} -> ok end,
  148: 				false = lists:member(Port, erlang:ports()),
  149: 				ok
  150: 			      end;
  151: 		      Error ->
  152: 			  exit({open_port_failed, Error})
  153: 		  end
  154: 	      end
  155: 	  catch
  156: 	      throw:Term -> ?line Term
  157: 	  after
  158: 	      erl_ddll:unload_driver(Drv)
  159: 	  end.
  160: 
  161: denormalized(Config) when is_list(Config) ->
  162:     ?line Denormalized = 1.0e-307 / 1000,
  163:     ?line roundtrip(Denormalized),
  164:     ?line NegDenormalized = -1.0e-307 / 1000,
  165:     ?line roundtrip(NegDenormalized),
  166:     ok.
  167: 
  168: roundtrip(N) ->
  169:     N = binary_to_term(term_to_binary(N)),
  170:     N = binary_to_term(term_to_binary(N, [{minor_version,1}])).
  171: 
  172: match(Config) when is_list(Config) ->
  173:     ?line one = match_1(1.0),
  174:     ?line two = match_1(2.0),
  175:     ?line a_lot = match_1(1000.0),
  176:     ?line {'EXIT',_} = (catch match_1(0.5)),
  177:     ok.
  178:     
  179: match_1(1.0) -> one;
  180: match_1(2.0) -> two;
  181: match_1(1000.0) -> a_lot.
  182: 
  183: %% Thanks to Per Gustafsson.
  184: 
  185: bad_float_unpack(Config) when is_list(Config) ->
  186:     ?line Bin = <<-1:64>>,
  187:     ?line -1 = bad_float_unpack_match(Bin),
  188:     ok.
  189: 
  190: bad_float_unpack_match(<<F:64/float>>) -> F;
  191: bad_float_unpack_match(<<I:64/integer-signed>>) -> I.
  192: 
  193: %% Exposes endianness issues.
  194: 
  195: write(Config) when is_list(Config) ->
  196:     "1.0" = io_lib:write(1.0).
  197: 
  198: cmp_zero(_Config) ->
  199:     cmp(0.5e-323,0).
  200: 
  201: cmp_integer(_Config) ->
  202:     Axis = (1 bsl 53)-2.0, %% The point where floating points become unprecise
  203:     span_cmp(Axis,2,200),
  204:     cmp(Axis*Axis,round(Axis)).
  205: 
  206: cmp_bignum(_Config) ->
  207:     span_cmp((1 bsl 58) - 1.0),%% Smallest bignum float
  208: 
  209:     %% Test when the big num goes from I to I+1 in size
  210:     [span_cmp((1 bsl (32*I)) - 1.0) || I <- lists:seq(2,30)],
  211: 
  212:     %% Test bignum greater then largest float
  213:     cmp((1 bsl (64*16)) - 1, (1 bsl (64*15)) * 1.0),
  214:     %% Test when num is much larger then float
  215:     [cmp((1 bsl (32*I)) - 1, (1 bsl (32*(I-2))) * 1.0) || I <- lists:seq(3,30)],
  216:     %% Test when float is much larger than num
  217:     [cmp((1 bsl (64*15)) * 1.0, (1 bsl (32*(I)))) || I <- lists:seq(1,29)],
  218: 
  219:     %% Test that all int == float works as they should
  220:     [true = 1 bsl N == (1 bsl N)*1.0 || N <- lists:seq(0, 1023)],
  221:     [true = (1 bsl N)*-1 == (1 bsl N)*-1.0 || N <- lists:seq(0, 1023)].
  222: 
  223: span_cmp(Axis) ->
  224:     span_cmp(Axis, 25).
  225: span_cmp(Axis, Length) ->
  226:     span_cmp(Axis, round(Axis) bsr 52, Length).
  227: span_cmp(Axis, Incr, Length) ->
  228:     [span_cmp(Axis, Incr, Length, 1 bsl (1 bsl I)) || I <- lists:seq(0,6)].
  229: %% This function creates tests around number axis. Both <, > and == is tested
  230: %% for both negative and positive numbers.
  231: %%
  232: %% Axis: The number around which to do the tests eg. (1 bsl 58) - 1.0
  233: %% Incr: How much to increment the test numbers inbetween each test.
  234: %% Length: Length/2 is the number of Incr away from Axis to test on the
  235: %%         negative and positive plane.
  236: %% Diff: How much the float and int should differ when comparing
  237: span_cmp(Axis, Incr, Length, Diff) ->
  238:     [begin
  239: 	 cmp(round(Axis*-1.0)+Diff+I*Incr,Axis*-1.0+I*Incr),
  240: 	 cmp(Axis*-1.0+I*Incr,round(Axis*-1.0)-Diff+I*Incr)
  241:      end || I <- lists:seq((Length div 2)*-1,(Length div 2))],
  242:     [begin
  243: 	 cmp(round(Axis)+Diff+I*Incr,Axis+I*Incr),
  244: 	 cmp(Axis+I*Incr,round(Axis)-Diff+I*Incr)
  245:      end || I <- lists:seq((Length div 2)*-1,(Length div 2))].
  246: 
  247: cmp(Big,Small) when is_float(Big) ->
  248:     BigGtSmall = lists:flatten(
  249: 		 io_lib:format("~f > ~p",[Big,Small])),
  250:     BigLtSmall = lists:flatten(
  251: 		 io_lib:format("~f < ~p",[Big,Small])),
  252:     BigEqSmall = lists:flatten(
  253: 		 io_lib:format("~f == ~p",[Big,Small])),
  254:     SmallGtBig = lists:flatten(
  255: 		   io_lib:format("~p > ~f",[Small,Big])),
  256:     SmallLtBig = lists:flatten(
  257: 		   io_lib:format("~p < ~f",[Small,Big])),
  258:     SmallEqBig = lists:flatten(
  259: 		   io_lib:format("~p == ~f",[Small,Big])),
  260:     cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig,
  261: 	SmallEqBig,BigEqSmall);
  262: cmp(Big,Small) when is_float(Small) ->
  263:     BigGtSmall = lists:flatten(
  264: 		   io_lib:format("~p > ~f",[Big,Small])),
  265:     BigLtSmall = lists:flatten(
  266: 		   io_lib:format("~p < ~f",[Big,Small])),
  267:     BigEqSmall = lists:flatten(
  268: 		   io_lib:format("~p == ~f",[Big,Small])),
  269:     SmallGtBig = lists:flatten(
  270: 		   io_lib:format("~f > ~p",[Small,Big])),
  271:     SmallLtBig = lists:flatten(
  272: 		   io_lib:format("~f < ~p",[Small,Big])),
  273:     SmallEqBig = lists:flatten(
  274: 		   io_lib:format("~f == ~p",[Small,Big])),
  275:     cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig,
  276: 	SmallEqBig,BigEqSmall).
  277: 
  278: cmp(Big,Small,BigGtSmall,BigLtSmall,SmallGtBig,SmallLtBig,
  279:     SmallEqBig,BigEqSmall) ->
  280:     {_,_,_,true} = {Big,Small,BigGtSmall,
  281: 		    Big > Small},
  282:     {_,_,_,false} = {Big,Small,BigLtSmall,
  283: 		     Big < Small},
  284:     {_,_,_,false} = {Big,Small,SmallGtBig,
  285: 		     Small > Big},
  286:     {_,_,_,true} = {Big,Small,SmallLtBig,
  287: 		    Small < Big},
  288:     {_,_,_,false} = {Big,Small,SmallEqBig,
  289: 		     Small == Big},
  290:     {_,_,_,false} = {Big,Small,BigEqSmall,
  291: 		     Big == Small}.
  292: 
  293: id(I) -> I.
  294:     
  295: start_node(Config) when is_list(Config) ->
  296:     ?line Pa = filename:dirname(code:which(?MODULE)),
  297:     ?line {A, B, C} = now(),
  298:     ?line Name = list_to_atom(atom_to_list(?MODULE)
  299: 			      ++ "-"
  300: 			      ++ atom_to_list(?config(testcase, Config))
  301: 			      ++ "-"
  302: 			      ++ integer_to_list(A)
  303: 			      ++ "-"
  304: 			      ++ integer_to_list(B)
  305: 			      ++ "-"
  306: 			      ++ integer_to_list(C)),
  307:     ?line ?t:start_node(Name, slave, [{args, "-pa "++Pa}]).
  308: 
  309: stop_node(Node) ->
  310:     ?t:stop_node(Node).
  311: 
  312: 
  313: %% Test that operations that might hide infinite intermediate results
  314: %% do not supress the badarith.
  315: hidden_inf(Config) when is_list(Config) ->
  316:     ZeroP = 0.0,
  317:     ZeroN = id(ZeroP) * (-1),
  318:     [hidden_inf_1(A, B, Z, 9.23e307)
  319:      || A <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN],
  320: 	B <- [1.0, -1.0, 3.1415, -0.00001000131, 3.57e257, ZeroP, ZeroN],
  321: 	Z <- [ZeroP, ZeroN]],
  322:     ok.
  323: 
  324: hidden_inf_1(A, B, Zero, Huge) ->
  325:     {'EXIT',{badarith,_}} = (catch (B / (A / Zero))),
  326:     {'EXIT',{badarith,_}} = (catch (B * (A / Zero))),
  327:     {'EXIT',{badarith,_}} = (catch (B / (Huge * Huge))),
  328:     {'EXIT',{badarith,_}} = (catch (B * (Huge * Huge))),
  329:     {'EXIT',{badarith,_}} = (catch (B / (Huge + Huge))),
  330:     {'EXIT',{badarith,_}} = (catch (B * (Huge + Huge))),
  331:     {'EXIT',{badarith,_}} = (catch (B / (-Huge - Huge))),
  332:     {'EXIT',{badarith,_}} = (catch (B * (-Huge - Huge))).