1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1997-2018. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(big_SUITE).
21
22
23-export([all/0, suite/0, groups/0]).
24
25-export([t_div/1, eq_28/1, eq_32/1, eq_big/1, eq_math/1, big_literals/1,
26	 borders/1, negative/1, big_float_1/1, big_float_2/1,
27         bxor_2pow/1, band_2pow/1,
28	 shift_limit_1/1, powmod/1, system_limit/1, toobig/1, otp_6692/1]).
29
30%% Internal exports.
31-export([eval/1]).
32-export([init/3]).
33
34-export([fac/1, fib/1, pow/2, gcd/2, lcm/2]).
35
36
37-include_lib("common_test/include/ct.hrl").
38
39suite() ->
40    [{ct_hooks,[ts_install_cth]},
41     {timetrap, {minutes, 3}}].
42
43all() ->
44    [t_div, eq_28, eq_32, eq_big, eq_math, big_literals,
45     borders, negative, {group, big_float}, shift_limit_1,
46     bxor_2pow, band_2pow,
47     powmod, system_limit, toobig, otp_6692].
48
49groups() ->
50    [{big_float, [], [big_float_1, big_float_2]}].
51
52%%
53%% Syntax of data files:
54%% Expr1 = Expr2.
55%% ...
56%% built in functions are:
57%% fac(N).
58%% fib(N).
59%% pow(X, N)  == X ^ N
60%% gcd(Q, R)
61%% lcm(Q, R)
62%%
63eq_28(Config) when is_list(Config) ->
64    TestFile = test_file(Config, "eq_28.dat"),
65    test(TestFile).
66
67eq_32(Config) when is_list(Config) ->
68    TestFile = test_file(Config, "eq_32.dat"),
69    test(TestFile).
70
71eq_big(Config) when is_list(Config) ->
72    TestFile = test_file(Config, "eq_big.dat"),
73    test(TestFile).
74
75eq_math(Config) when is_list(Config) ->
76    TestFile = test_file(Config, "eq_math.dat"),
77    test(TestFile).
78
79
80%% Tests border cases between small/big.
81borders(Config) when is_list(Config) ->
82    TestFile = test_file(Config, "borders.dat"),
83    test(TestFile).
84
85negative(Config) when is_list(Config) ->
86    TestFile = test_file(Config, "negative.dat"),
87    test(TestFile).
88
89
90%% Find test file
91test_file(Config, Name) ->
92    DataDir = proplists:get_value(data_dir, Config),
93    filename:join(DataDir, Name).
94
95%%
96%%
97%% Run test on file test_big_seq.erl
98%%
99%%
100test(File) ->
101    test(File, [node()]).
102
103test(File, Nodes) ->
104    {ok,Fd} = file:open(File, [read]),
105    Res = test(File, Fd, Nodes),
106    file:close(Fd),
107    case Res of
108	{0,Cases} -> {comment, integer_to_list(Cases) ++ " cases"};
109	{_,_} -> ct:fail("failed")
110    end.
111
112test(File, Fd, Ns) ->
113    test(File, Fd, Ns, 0, 0, 0).
114
115test(File, Fd, Ns, L, Cases, Err) ->
116    case io:parse_erl_exprs(Fd, '') of
117	{eof,_} -> {Err, Cases};
118	{error, {Line,_Mod,Message}, _} ->
119	    Fmt = erl_parse:format_error(Message),
120	    io:format("~s:~w: error ~s~n", [File, Line+L, Fmt]),
121	    {Err+1, Cases};
122	{ok, [{match,ThisLine,Expr1,Expr2}], Line} ->
123	    case multi_match(Ns, {op,0,'-',Expr1,Expr2}) of
124		[] ->
125		    test(File, Fd, Ns, Line+L-1,Cases+1, Err);
126		[_|_] ->
127		    PP = erl_pp:expr({op,0,'=/=',Expr1,Expr2}),
128		    io:format("~s:~w : error ~s~n", [File,ThisLine+L, PP]),
129		    test(File, Fd, Ns, Line+L-1,Cases+1, Err+1)
130	    end;
131	{ok, Exprs, Line} ->
132	    PP = erl_pp:exprs(Exprs),
133	    io:format("~s: ~w: equation expected not ~s~n", [File,Line+L,PP]),
134	    test(File, Fd, Ns, Line+L-1,Cases+1, Err+1)
135    end.
136
137multi_match(Ns, Expr) ->
138    multi_match(Ns, Expr, []).
139
140multi_match([Node|Ns], Expr, Rs) ->
141    X = rpc:call(Node, big_SUITE, eval, [Expr]),
142    if X == 0 -> multi_match(Ns, Expr, Rs);
143       true -> multi_match(Ns, Expr, [{Node,X}|Rs])
144    end;
145multi_match([], _, Rs) -> Rs.
146
147eval(Expr) ->
148    LFH = fun(Name, As) -> apply(?MODULE, Name, As) end,
149
150    %% Applied arithmetic BIFs.
151    {value,V,_} = erl_eval:expr(Expr, [], {value,LFH}),
152
153    %% Real arithmetic instructions.
154    V = eval(Expr, LFH),
155
156    V.
157
158%% Like a subset of erl_eval:expr/3, but uses real arithmetic instructions instead of
159%% applying them (it does make a difference).
160
161eval({op,_,Op,A0}, LFH) ->
162    A = eval(A0, LFH),
163    Res = eval_op(Op, A),
164    erlang:garbage_collect(),
165    Res;
166eval({op,_,Op,A0,B0}, LFH) ->
167    [A,B] = eval_list([A0,B0], LFH),
168    Res = eval_op(Op, A, B),
169    erlang:garbage_collect(),
170    Res;
171eval({integer,_,I}, _) ->
172    %% "Parasitic" ("symbiotic"?) test of squaring all numbers
173    %% found in the test data.
174    test_squaring(I),
175    I;
176eval({call,_,{atom,_,Local},Args0}, LFH) ->
177    Args = eval_list(Args0, LFH),
178    LFH(Local, Args).
179
180eval_list([E|Es], LFH) ->
181    [eval(E, LFH)|eval_list(Es, LFH)];
182eval_list([], _) -> [].
183
184eval_op('-', A) -> -A;
185eval_op('+', A) -> +A;
186eval_op('bnot', A) -> bnot A.
187
188eval_op('-', A, B) -> A - B;
189eval_op('+', A, B) -> A + B;
190eval_op('*', A, B) -> A * B;
191eval_op('div', A, B) -> A div B;
192eval_op('rem', A, B) -> A rem B;
193eval_op('band', A, B) -> A band B;
194eval_op('bor', A, B) -> A bor B;
195eval_op('bxor', A, B) -> A bxor B;
196eval_op('bsl', A, B) -> A bsl B;
197eval_op('bsr', A, B) -> A bsr B.
198
199test_squaring(I) ->
200    %% Multiplying an integer by itself is specially optimized, so we
201    %% should take special care to test squaring.  The optimization
202    %% will kick in when the two operands have the same address.
203    Sqr = I * I,
204
205    %% This expression will be multiplied in the usual way, because
206    %% the the two operands for '*' are stored at different addresses.
207    Sqr = I * ((I + id(1)) - id(1)),
208
209    ok.
210
211%% Built in test functions
212
213fac(0) -> 1;
214fac(1) -> 1;
215fac(N) -> N * fac(N-1).
216
217%%
218%% X ^ N
219%%
220pow(_, 0) -> 1;
221pow(X, 1) -> X;
222pow(X, N) when (N band 1) == 1 ->
223    X2 = pow(X, N bsr 1),
224    X*X2*X2;
225pow(X, N) ->
226    X2 = pow(X, N bsr 1),
227    X2*X2.
228
229fib(0) -> 1;
230fib(1) -> 1;
231fib(N) -> fib(N-1) + fib(N-2).
232
233%%
234%% Gcd
235%%
236gcd(Q, 0) -> Q;
237gcd(Q, R) -> gcd(R, Q rem R).
238
239%%
240%% Least common multiple
241%%
242lcm(Q, R) ->
243    Q*R div gcd(Q, R).
244
245
246%% Test case t_div cut in from R2D test suite.
247
248t_div(Config) when is_list(Config) ->
249    'try'(fun() -> 98765432101234 div 98765432101235 end, 0),
250
251    % Big remainder, small quotient.
252    'try'(fun() -> 339254531512 div 68719476736 end, 4),
253    ok.
254
255'try'(Fun, Result) ->
256    'try'(89, Fun, Result, []).
257
258'try'(0, _, _, _) ->
259    ok;
260'try'(Iter, Fun, Result, Filler) ->
261    spawn(?MODULE, init, [self(), Fun, list_to_tuple(Filler)]),
262    receive
263	{result, Result} ->
264	    'try'(Iter-1, Fun, Result, [0|Filler]);
265	{result, Other} ->
266	    ct:fail("Expected ~p; got ~p~n", [Result, Other])
267    end.
268
269init(ReplyTo, Fun, _Filler) ->
270    ReplyTo ! {result, Fun()}.
271
272%% Tests that big-number literals work correctly.
273big_literals(Config) when is_list(Config) ->
274    %% Note: The literal test cannot be compiler on a pre-R4 Beam emulator,
275    %% so we compile it now.
276    DataDir = proplists:get_value(data_dir, Config),
277    Test = filename:join(DataDir, "literal_test"),
278    {ok, Mod, Bin} = compile:file(Test, [binary]),
279    {module, Mod} = code:load_binary(Mod, Mod, Bin),
280    ok = Mod:t(),
281    ok.
282
283
284%% OTP-2436, part 1
285big_float_1(Config) when is_list(Config) ->
286    %% F is a number very close to a maximum float.
287    F = id(1.7e308),
288    I = trunc(F),
289    true = (I == F),
290    false = (I /= F),
291    true = (I > F/2),
292    false = (I =< F/2),
293    true = (I*2 >= F),
294    false = (I*2 < F),
295    true = (I*I > F),
296    false = (I*I =< F),
297
298    true = (F == I),
299    false = (F /= I),
300    false = (F/2 > I),
301    true = (F/2 =< I),
302    false = (F >= I*2),
303    true = (F < I*2),
304    false = (F > I*I),
305    true = (F =< I*I),
306    ok.
307
308%% "OTP-2436, part 2
309big_float_2(Config) when is_list(Config) ->
310    F = id(1.7e308),
311    I = trunc(F),
312    {'EXIT', _} = (catch 1/(2*I)),
313    _Ignore = 2/I,
314    {'EXIT', _} = (catch 4/(2*I)),
315    ok.
316
317%% OTP-3256
318shift_limit_1(Config) when is_list(Config) ->
319    case catch (id(1) bsl 100000000) of
320	      {'EXIT', {system_limit, _}} ->
321		  ok
322	  end,
323    ok.
324
325powmod(Config) when is_list(Config) ->
326    A = 1696192905348584855517250509684275447603964214606878827319923580493120589769459602596313014087329389174229999430092223701630077631205171572331191216670754029016160388576759960413039261647653627052707047,
327    B = 43581177444506616087519351724629421082877485633442736512567383077022781906420535744195118099822189576169114064491200598595995538299156626345938812352676950427869649947439032133573270227067833308153431095,
328    C = 52751775381034251994634567029696659541685100826881826508158083211003576763074162948462801435204697796532659535818017760528684167216110865807581759669824808936751316879636014972704885388116861127856231,
329    42092892863788727404752752803608028634538446791189806757622214958680350350975318060071308251566643822307995215323107194784213893808887471095918905937046217646432382915847269148913963434734284563536888 = powmod(A, B, C),
330    ok.
331
332powmod(A, 1, C) ->
333    A rem C;
334powmod(A, 2, C) ->
335    A*A rem C;
336powmod(A, B, C) ->
337    B1 = B div 2,
338    B2 = B - B1,
339    P = powmod(A, B1, C),
340    case B2 of
341	B1 ->
342	    (P*P) rem C;
343	_  ->
344	    (P*P*A) rem C
345    end.
346
347system_limit(Config) when is_list(Config) ->
348    Maxbig = maxbig(),
349    {'EXIT',{system_limit,_}} = (catch Maxbig+1),
350    {'EXIT',{system_limit,_}} = (catch -Maxbig-1),
351    {'EXIT',{system_limit,_}} = (catch 2*Maxbig),
352    {'EXIT',{system_limit,_}} = (catch bnot Maxbig),
353    {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bnot'), [Maxbig])),
354    {'EXIT',{system_limit,_}} = (catch Maxbig bsl 2),
355    {'EXIT',{system_limit,_}} = (catch apply(erlang, id('bsl'), [Maxbig,2])),
356    {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 45)),
357    {'EXIT',{system_limit,_}} = (catch id(1) bsl (1 bsl 69)),
358
359    %% There should be no system_limit exception when shifting a zero.
360    0 = id(0) bsl (1 bsl 128),
361    0 = id(0) bsr -(1 bsl 128),
362    Erlang = id(erlang),
363    0 = Erlang:'bsl'(id(0), 1 bsl 128),
364    0 = Erlang:'bsr'(id(0), -(1 bsl 128)),
365    ok.
366
367maxbig() ->
368    %% We assume that the maximum arity is (1 bsl 19) - 1.
369    Ws = erlang:system_info(wordsize),
370    (((1 bsl ((16777184 * (Ws div 4))-1)) - 1) bsl 1) + 1.
371
372id(I) -> I.
373
374toobig(Config) when is_list(Config) ->
375    {'EXIT',{{badmatch,_},_}} = (catch toobig()),
376    ok.
377
378toobig() ->
379    A = erlang:term_to_binary(lists:seq(1000000, 2200000)),
380    ASize = erlang:bit_size(A),
381    <<ANr:ASize>> = A, % should fail
382    ANr band ANr.
383
384%% Tests for DIV/REM bug reported in OTP-6692
385otp_6692(Config) when is_list(Config)->
386    loop1(1,1000).
387
388fact(N) ->
389     fact(N,1).
390
391fact(0,P) -> P;
392fact(N,P) -> fact(N-1,P*N).
393
394raised(X,1) ->
395    X;
396raised(X,N) ->
397    X*raised(X,N-1).
398
399loop1(M,M) ->
400    ok;
401loop1(N,M) ->
402    loop2(fact(N),raised(7,7),1,8),
403    loop1(N+1,M).
404
405loop2(_,_,M,M) ->
406    ok;
407loop2(X,Y,N,M) ->
408    Z = raised(Y,N),
409    case X rem Z of
410	Z ->
411	    exit({failed,X,'REM',Z,'=',Z});
412	0 ->
413	    case (X div Z) * Z of
414		X ->
415		    ok;
416		Wrong ->
417		    exit({failed,X,'DIV',Z,'*',Z,'=',Wrong})
418	    end;
419	_ ->
420	    ok
421    end,
422    loop2(X,Y,N+1,M).
423
424
425%% ERL-450
426bxor_2pow(_Config) ->
427    IL = lists:seq(8*3, 8*16, 4),
428    JL = lists:seq(0, 64),
429    [bxor_2pow_1((1 bsl I), (1 bsl J))
430     || I <- IL, J <- JL],
431    ok.
432
433bxor_2pow_1(A, B) ->
434    for(-1,1, fun(Ad) ->
435                      for(-1,1, fun(Bd) ->
436                                        bxor_2pow_2(A+Ad, B+Bd),
437                                        bxor_2pow_2(-A+Ad, B+Bd),
438                                        bxor_2pow_2(A+Ad, -B+Bd),
439                                        bxor_2pow_2(-A+Ad, -B+Bd)
440                                end)
441              end).
442
443for(From, To, _Fun) when From > To ->
444    ok;
445for(From, To, Fun) ->
446    Fun(From),
447    for(From+1, To, Fun).
448
449bxor_2pow_2(A, B) ->
450    Correct = my_bxor(A, B),
451    case A bxor B of
452        Correct -> ok;
453        Wrong ->
454            io:format("~.16b bxor ~.16b\n", [A,B]),
455            io:format("Expected ~.16b\n", [Correct]),
456            io:format("Got      ~.16b\n", [Wrong]),
457            ct:fail({failed, 'bxor'})
458
459    end.
460
461%% Implement bxor without bxor
462my_bxor(A, B) ->
463    my_bxor(A, B, 0, 0).
464
465my_bxor(0, 0, _, Acc) -> Acc;
466my_bxor(-1, -1, _, Acc) -> Acc;
467my_bxor(-1, 0, N, Acc) -> (-1 bsl N) bor Acc; % sign extension
468my_bxor(0, -1, N, Acc) -> (-1 bsl N) bor Acc; % sign extension
469my_bxor(A, B, N, Acc0) ->
470    Acc1 = case (A band 1) =:= (B band 1) of
471               true -> Acc0;
472               false -> Acc0 bor (1 bsl N)
473          end,
474    my_bxor(A bsr 1, B bsr 1, N+1, Acc1).
475
476
477%% ERL-804
478band_2pow(_Config) ->
479    IL = lists:seq(8*3, 8*16, 4),
480    JL = lists:seq(0, 64),
481    [band_2pow_1((1 bsl I), (1 bsl J))
482     || I <- IL, J <- JL],
483    ok.
484
485band_2pow_1(A, B) ->
486    for(-1,1, fun(Ad) ->
487                      for(-1,1, fun(Bd) ->
488                                        band_2pow_2(A+Ad, B+Bd),
489                                        band_2pow_2(-A+Ad, B+Bd),
490                                        band_2pow_2(A+Ad, -B+Bd),
491                                        band_2pow_2(-A+Ad, -B+Bd)
492                                end)
493              end).
494
495band_2pow_2(A, B) ->
496    Correct = my_band(A, B),
497    case A band B of
498        Correct -> ok;
499        Wrong ->
500            io:format("~.16# band ~.16#\n", [A,B]),
501            io:format("Expected ~.16#\n", [Correct]),
502            io:format("Got      ~.16#\n", [Wrong]),
503            ct:fail({failed, 'band'})
504
505    end.
506
507%% Implement band without band
508my_band(A, B) ->
509    bnot ((bnot A) bor (bnot B)).
510