1: %%
    2: %% %CopyrightBegin%
    3: %% 
    4: %% Copyright Ericsson AB 1997-2011. 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: -module(big_SUITE).
   20: 
   21: 
   22: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
   23: 	 init_per_group/2,end_per_group/2]).
   24: -export([t_div/1, eq_28/1, eq_32/1, eq_big/1, eq_math/1, big_literals/1,
   25: 	 borders/1, negative/1, big_float_1/1, big_float_2/1,
   26: 	 shift_limit_1/1, powmod/1, system_limit/1, otp_6692/1]).
   27: 
   28: %% Internal exports.
   29: -export([eval/1]).
   30: -export([init/3]).
   31: 
   32: -export([fac/1, fib/1, pow/2, gcd/2, lcm/2]).
   33: 
   34: -export([init_per_testcase/2, end_per_testcase/2]).
   35: 
   36: -include_lib("test_server/include/test_server.hrl").
   37: 
   38: suite() -> [{ct_hooks,[ts_install_cth]}].
   39: 
   40: all() -> 
   41:     [t_div, eq_28, eq_32, eq_big, eq_math, big_literals,
   42:      borders, negative, {group, big_float}, shift_limit_1,
   43:      powmod, system_limit, otp_6692].
   44: 
   45: groups() -> 
   46:     [{big_float, [], [big_float_1, big_float_2]}].
   47: 
   48: init_per_suite(Config) ->
   49:     Config.
   50: 
   51: end_per_suite(_Config) ->
   52:     ok.
   53: 
   54: init_per_group(_GroupName, Config) ->
   55:     Config.
   56: 
   57: end_per_group(_GroupName, Config) ->
   58:     Config.
   59: 
   60: 
   61: init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
   62:     Dog=?t:timetrap(?t:minutes(3)),
   63:     [{watchdog, Dog}|Config].
   64: 
   65: end_per_testcase(_Func, Config) ->
   66:     Dog=?config(watchdog, Config),
   67:     ?t:timetrap_cancel(Dog).
   68: 
   69: %%
   70: %% Syntax of data files:
   71: %% Expr1 = Expr2.
   72: %% ...
   73: %% built in functions are:
   74: %% fac(N).
   75: %% fib(N).
   76: %% pow(X, N)  == X ^ N
   77: %% gcd(Q, R) 
   78: %% lcm(Q, R)
   79: %%
   80: eq_28(Config) when is_list(Config) ->
   81:     TestFile = test_file(Config, "eq_28.dat"),
   82:     test(TestFile).
   83: 
   84: eq_32(Config) when is_list(Config) ->
   85:     TestFile = test_file(Config, "eq_32.dat"),
   86:     test(TestFile).
   87: 
   88: eq_big(Config) when is_list(Config) ->
   89:     TestFile = test_file(Config, "eq_big.dat"),
   90:     test(TestFile).
   91: 
   92: eq_math(Config) when is_list(Config) ->
   93:     TestFile = test_file(Config, "eq_math.dat"),
   94:     test(TestFile).
   95: 
   96: 
   97: borders(doc) -> "Tests border cases between small/big.";
   98: borders(Config) when is_list(Config) ->
   99:     TestFile = test_file(Config, "borders.dat"),
  100:     test(TestFile).
  101: 
  102: negative(Config) when is_list(Config) ->
  103:     TestFile = test_file(Config, "negative.dat"),
  104:     test(TestFile).
  105:     
  106: 
  107: %% Find test file
  108: test_file(Config, Name) ->
  109:     DataDir = ?config(data_dir, Config),
  110:     filename:join(DataDir, Name).
  111: 
  112: %%
  113: %%
  114: %% Run test on file test_big_seq.erl
  115: %%
  116: %%
  117: test(File) ->
  118:     test(File, [node()]).
  119: 
  120: test(File, Nodes) ->
  121:     ?line {ok,Fd} = file:open(File, [read]),
  122:     Res = test(File, Fd, Nodes),
  123:     file:close(Fd),
  124:     case Res of
  125: 	{0,Cases} -> {comment, integer_to_list(Cases) ++ " cases"};
  126: 	{_,_} -> test_server:fail()
  127:     end.
  128: 
  129: test(File, Fd, Ns) ->
  130:     test(File, Fd, Ns, 0, 0, 0).
  131: 
  132: test(File, Fd, Ns, L, Cases, Err) ->
  133:     case io:parse_erl_exprs(Fd, '') of
  134: 	{eof,_} -> {Err, Cases};
  135: 	{error, {Line,_Mod,Message}, _} ->
  136: 	    Fmt = erl_parse:format_error(Message),
  137: 	    io:format("~s:~w: error ~s~n", [File, Line+L, Fmt]),
  138: 	    {Err+1, Cases};
  139: 	{ok, [{match,ThisLine,Expr1,Expr2}], Line} ->
  140: 	    case multi_match(Ns, {op,0,'-',Expr1,Expr2}) of
  141: 		[] ->
  142: 		    test(File, Fd, Ns, Line+L-1,Cases+1, Err);
  143: 		[_|_] ->
  144: 		    PP = erl_pp:expr({op,0,'=/=',Expr1,Expr2}),
  145: 		    io:format("~s:~w : error ~s~n", [File,ThisLine+L, PP]),
  146: 		    test(File, Fd, Ns, Line+L-1,Cases+1, Err+1)
  147: 	    end;
  148: 	{ok, Exprs, Line} ->
  149: 	    PP = erl_pp:exprs(Exprs),
  150: 	    io:format("~s: ~w: equation expected not ~s~n", [File,Line+L,PP]),
  151: 	    test(File, Fd, Ns, Line+L-1,Cases+1, Err+1)
  152:     end.
  153: 
  154: multi_match(Ns, Expr) ->
  155:     multi_match(Ns, Expr, []).
  156: 
  157: multi_match([Node|Ns], Expr, Rs) ->
  158:     ?line X = rpc:call(Node, big_SUITE, eval, [Expr]),
  159:     if X == 0 -> multi_match(Ns, Expr, Rs);
  160:        true -> multi_match(Ns, Expr, [{Node,X}|Rs])
  161:     end;
  162: multi_match([], _, Rs) -> Rs.
  163: 
  164: eval(Expr) ->
  165:     LFH = fun(Name, As) -> apply(?MODULE, Name, As) end,
  166: 
  167:     %% Applied arithmetic BIFs.
  168:     {value,V,_} = erl_eval:expr(Expr, [], {value,LFH}),
  169: 
  170:     %% Real arithmetic instructions.
  171:     V = eval(Expr, LFH),
  172: 
  173:     V.
  174: 
  175: %% Like a subset of erl_eval:expr/3, but uses real arithmetic instructions instead of
  176: %% applying them (it does make a difference).
  177: 
  178: eval({op,_,Op,A0}, LFH) ->
  179:     A = eval(A0, LFH),
  180:     Res = eval_op(Op, A),
  181:     erlang:garbage_collect(),
  182:     Res;
  183: eval({op,_,Op,A0,B0}, LFH) ->
  184:     [A,B] = eval_list([A0,B0], LFH),
  185:     Res = eval_op(Op, A, B),
  186:     erlang:garbage_collect(),
  187:     Res;
  188: eval({integer,_,I}, _) -> I;
  189: eval({call,_,{atom,_,Local},Args0}, LFH) ->
  190:     Args = eval_list(Args0, LFH),
  191:     LFH(Local, Args).
  192: 
  193: eval_list([E|Es], LFH) ->
  194:     [eval(E, LFH)|eval_list(Es, LFH)];
  195: eval_list([], _) -> [].
  196: 
  197: eval_op('-', A) -> -A;
  198: eval_op('+', A) -> +A;
  199: eval_op('bnot', A) -> bnot A.
  200: 
  201: eval_op('-', A, B) -> A - B;
  202: eval_op('+', A, B) -> A + B;
  203: eval_op('*', A, B) -> A * B;
  204: eval_op('div', A, B) -> A div B;
  205: eval_op('rem', A, B) -> A rem B;
  206: eval_op('band', A, B) -> A band B;
  207: eval_op('bor', A, B) -> A bor B;
  208: eval_op('bxor', A, B) -> A bxor B;
  209: eval_op('bsl', A, B) -> A bsl B;
  210: eval_op('bsr', A, B) -> A bsr B.
  211: 
  212: %% Built in test functions
  213: 
  214: fac(0) -> 1;
  215: fac(1) -> 1;
  216: fac(N) -> N * fac(N-1).
  217: 
  218: %%
  219: %% X ^ N
  220: %%
  221: pow(_, 0) -> 1;
  222: pow(X, 1) -> X;
  223: pow(X, N) when (N band 1) == 1 ->
  224:     X2 = pow(X, N bsr 1),
  225:     X*X2*X2;
  226: pow(X, N) ->
  227:     X2 = pow(X, N bsr 1),
  228:     X2*X2.
  229: 
  230: fib(0) -> 1;
  231: fib(1) -> 1;
  232: fib(N) -> fib(N-1) + fib(N-2).
  233: 
  234: %%
  235: %% Gcd 
  236: %%
  237: gcd(Q, 0) -> Q;
  238: gcd(Q, R) -> gcd(R, Q rem R).
  239: 
  240: %%
  241: %% Least common multiple
  242: %%
  243: lcm(Q, R) ->
  244:     Q*R div gcd(Q, R).
  245: 
  246: 
  247: %% Test case t_div cut in from R2D test suite.
  248: 
  249: t_div(Config) when is_list(Config) ->
  250:     ?line 'try'(fun() -> 98765432101234 div 98765432101235 end, 0),
  251: 
  252:     % Big remainder, small quotient.
  253:     ?line 'try'(fun() -> 339254531512 div 68719476736 end, 4),
  254:     ok.
  255: 
  256: 'try'(Fun, Result) ->
  257:     'try'(89, Fun, Result, []).
  258: 
  259: 'try'(0, _, _, _) ->
  260:     ok;
  261: 'try'(Iter, Fun, Result, Filler) ->
  262:     spawn(?MODULE, init, [self(), Fun, list_to_tuple(Filler)]),
  263:     receive
  264: 	{result, Result} ->
  265: 	    'try'(Iter-1, Fun, Result, [0|Filler]);
  266: 	{result, Other} ->
  267: 	    io:format("Expected ~p; got ~p~n", [Result, Other]),
  268: 	    test_server:fail()
  269:     end.
  270: 
  271: init(ReplyTo, Fun, _Filler) ->
  272:     ReplyTo ! {result, Fun()}.
  273: 
  274: big_literals(doc) ->
  275:     "Tests that big-number literals work correctly.";
  276: big_literals(Config) when is_list(Config) ->
  277:     %% Note: The literal test cannot be compiler on a pre-R4 Beam emulator,
  278:     %% so we compile it now.
  279:     ?line DataDir = ?config(data_dir, Config),
  280:     ?line Test = filename:join(DataDir, "literal_test"),
  281:     ?line {ok, Mod, Bin} = compile:file(Test, [binary]),
  282:     ?line {module, Mod} = code:load_binary(Mod, Mod, Bin),
  283:     ?line ok = Mod:t(),
  284:     ok.
  285: 
  286: 
  287: big_float_1(doc) ->
  288:     ["OTP-2436, part 1"];
  289: big_float_1(Config) when is_list(Config) ->
  290:     %% F is a number very close to a maximum float.
  291:     ?line F = id(1.7e308),
  292:     ?line I = trunc(F),
  293:     ?line true = (I == F),
  294:     ?line false = (I /= F),
  295:     ?line true = (I > F/2),
  296:     ?line false = (I =< F/2),
  297:     ?line true = (I*2 >= F),
  298:     ?line false = (I*2 < F),
  299:     ?line true = (I*I > F),
  300:     ?line false = (I*I =< F),
  301: 
  302:     ?line true = (F == I),
  303:     ?line false = (F /= I),
  304:     ?line false = (F/2 > I),
  305:     ?line true = (F/2 =< I),
  306:     ?line false = (F >= I*2),
  307:     ?line true = (F < I*2),
  308:     ?line false = (F > I*I),
  309:     ?line true = (F =< I*I),
  310:     ok.
  311: 
  312: big_float_2(doc) ->
  313:     ["OTP-2436, part 2"];
  314: big_float_2(Config) when is_list(Config) ->
  315:     ?line F = id(1.7e308),
  316:     ?line I = trunc(F),
  317:     ?line {'EXIT', _} = (catch 1/(2*I)),
  318:     ?line _Ignore = 2/I,
  319:     ?line {'EXIT', _} = (catch 4/(2*I)),
  320:     ok.
  321: 
  322: shift_limit_1(doc) ->
  323:     ["OTP-3256"];
  324: shift_limit_1(Config) when is_list(Config) ->
  325:     ?line case catch (id(1) bsl 100000000) of
  326: 	      {'EXIT', {system_limit, _}} ->
  327: 		  ok
  328: 	  end,
  329:     ok.
  330: 
  331: powmod(Config) when is_list(Config) ->
  332:     A = 1696192905348584855517250509684275447603964214606878827319923580493120589769459602596313014087329389174229999430092223701630077631205171572331191216670754029016160388576759960413039261647653627052707047,
  333:     B = 43581177444506616087519351724629421082877485633442736512567383077022781906420535744195118099822189576169114064491200598595995538299156626345938812352676950427869649947439032133573270227067833308153431095,
  334:     C = 52751775381034251994634567029696659541685100826881826508158083211003576763074162948462801435204697796532659535818017760528684167216110865807581759669824808936751316879636014972704885388116861127856231,
  335:     42092892863788727404752752803608028634538446791189806757622214958680350350975318060071308251566643822307995215323107194784213893808887471095918905937046217646432382915847269148913963434734284563536888 = powmod(A, B, C),
  336:     ok.
  337: 
  338: powmod(A, 1, C) ->
  339:     A rem C;
  340: powmod(A, 2, C) ->
  341:     A*A rem C;
  342: powmod(A, B, C) ->
  343:     B1 = B div 2,
  344:     B2 = B - B1,
  345:     P = powmod(A, B1, C),
  346:     case B2 of
  347: 	B1 ->
  348: 	    (P*P) rem C;
  349: 	_  -> 
  350: 	    (P*P*A) rem C
  351:     end.
  352: 
  353: system_limit(Config) when is_list(Config) ->
  354:     ?line Maxbig = maxbig(),
  355:     ?line {'EXIT',{system_limit,_}} = (catch Maxbig+1),
  356:     ?line {'EXIT',{system_limit,_}} = (catch -Maxbig-1),
  357:     ?line {'EXIT',{system_limit,_}} = (catch 2*Maxbig),
  358:     ?line {'EXIT',{system_limit,_}} = (catch bnot Maxbig),
  359:     ?line {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bnot'), [Maxbig])),
  360:     ?line {'EXIT',{system_limit,_}} = (catch Maxbig bsl 2),
  361:     ?line {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bsl'), [Maxbig,2])),
  362:     ?line {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 45)),
  363:     ?line {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 69)),
  364:     ok.
  365: 
  366: maxbig() ->
  367:     %% We assume that the maximum arity is (1 bsl 19) - 1.
  368:     Ws = erlang:system_info(wordsize),
  369:     (((1 bsl ((16777184 * (Ws div 4))-1)) - 1) bsl 1) + 1.
  370: 
  371: id(I) -> I.
  372: 
  373: otp_6692(suite) ->
  374:     [];
  375: otp_6692(doc) ->
  376:     ["Tests for DIV/REM bug reported in OTP-6692"];
  377: otp_6692(Config) when is_list(Config)->
  378:     ?line loop1(1,1000).
  379: 
  380: fact(N) ->
  381:      fact(N,1).
  382: 
  383: fact(0,P) -> P;
  384: fact(N,P) -> fact(N-1,P*N).
  385: 
  386: raised(X,1) ->
  387:     X;
  388: raised(X,N) ->
  389:     X*raised(X,N-1).
  390: 
  391: loop1(M,M) ->
  392:     ok;
  393: loop1(N,M) ->
  394:     loop2(fact(N),raised(7,7),1,8),
  395:     loop1(N+1,M).
  396: 
  397: loop2(_,_,M,M) ->
  398:     ok;
  399: loop2(X,Y,N,M) ->
  400:     Z = raised(Y,N),
  401:     case X rem Z of
  402: 	Z ->
  403: 	    exit({failed,X,'REM',Z,'=',Z});
  404: 	0 ->
  405: 	    case (X div Z) * Z of
  406: 		X ->
  407: 		    ok;
  408: 		Wrong ->
  409: 		    exit({failed,X,'DIV',Z,'*',Z,'=',Wrong})
  410: 	    end;
  411: 	_ ->
  412: 	    ok
  413:     end,
  414:     loop2(X,Y,N+1,M).
  415: