1: %%
    2: %% %CopyrightBegin%
    3: %% 
    4: %% Copyright Ericsson AB 1999-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: 
   20: -module(beam_literals_SUITE).
   21: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
   22: 	 init_per_group/2,end_per_group/2]).
   23: -export([putting/1, matching_smalls/1, matching_smalls_jt/1,
   24: 	 matching_bigs/1, matching_more_bigs/1,
   25: 	 matching_bigs_and_smalls/1, badmatch/1, case_clause/1,
   26: 	 receiving/1, literal_type_tests/1,
   27: 	 put_list/1, fconv/1, literal_case_expression/1,
   28: 	 increment/1]).
   29: 
   30: -include_lib("test_server/include/test_server.hrl").
   31: 
   32: suite() -> [{ct_hooks,[ts_install_cth]}].
   33: 
   34: all() -> 
   35:     [putting, matching_smalls, matching_smalls_jt,
   36:      matching_bigs, matching_more_bigs,
   37:      matching_bigs_and_smalls, badmatch, case_clause,
   38:      receiving, literal_type_tests, put_list, fconv,
   39:      literal_case_expression, increment].
   40: 
   41: groups() -> 
   42:     [].
   43: 
   44: init_per_suite(Config) ->
   45:     Config.
   46: 
   47: end_per_suite(_Config) ->
   48:     ok.
   49: 
   50: init_per_group(_GroupName, Config) ->
   51:     Config.
   52: 
   53: end_per_group(_GroupName, Config) ->
   54:     Config.
   55: 
   56: 
   57: putting(doc) -> "Test creating lists and tuples containing big number literals.";
   58: putting(Config) when is_list(Config) ->
   59:     -773973888575883407313908 = chksum(putting1(8987697898797)).
   60: 
   61: putting1(X) ->
   62:     {8797987987987987872256443, [1324483773773], {3.1415, 2.71, [2.5, 35.125|9.31]},
   63:      [X|349873987387373],
   64:      [329878349873|-387394729872], -773973937933873929749873}.
   65: 
   66: matching_bigs(doc) -> "Test matching of a few big number literals (in Beam,"
   67: 		      "select_val/3 will NOT be used).";
   68: matching_bigs(Config) when is_list(Config) ->
   69:     a = matching1(3972907842873739),
   70:     b = matching1(-389789298378939783333333333333333333784),
   71:     other = matching1(3141699999999999999999999999999999999),
   72:     other = matching1(42).
   73: 
   74: matching_smalls(doc) -> "Test matching small numbers (both positive and negative).";
   75: matching_smalls(Config) when is_list(Config) ->
   76:     ?line a = m_small(-42),
   77:     ?line b = m_small(0),
   78:     ?line c = m_small(105),
   79:     ?line d = m_small(-13),
   80:     ?line e = m_small(337848),
   81:     ?line other = m_small(324),
   82:     ?line other = m_small(-7),
   83:     ok.
   84: 
   85: m_small(-42) -> a;
   86: m_small(0) -> b;
   87: m_small(105) -> c;
   88: m_small(-13) -> d;
   89: m_small(337848) -> e;
   90: m_small(_) -> other.
   91: 
   92: matching_smalls_jt(doc) ->
   93:     "Test matching small numbers (both positive and negative). "
   94: 	"Make sure that a jump table is used.";
   95: matching_smalls_jt(Config) when is_list(Config) ->
   96:     ?line a = m_small_jt(-2),
   97:     ?line b = m_small_jt(-1),
   98:     ?line c = m_small_jt(0),
   99:     ?line d = m_small_jt(2),
  100:     ?line e = m_small_jt(3),
  101:     ?line other = m_small(324),
  102:     ?line other = m_small(-7),
  103:     ok.
  104: 
  105: m_small_jt(-2) -> a;
  106: m_small_jt(-1) -> b;
  107: m_small_jt(0) -> c;
  108: m_small_jt(2) -> d;
  109: m_small_jt(3) -> e;
  110: m_small_jt(_) -> other.
  111: 
  112: %% Big numbers, no select_val.
  113: 
  114: matching1(3972907842873739) -> a;
  115: matching1(-389789298378939783333333333333333333784) -> b;
  116: matching1(_) -> other.
  117: 
  118: 
  119: matching_more_bigs(doc) -> "Test matching of a big number literals (in Beam,"
  120: 		      "a select_val/3 instruction will be used).";
  121: matching_more_bigs(Config) when is_list(Config) ->
  122:     a = matching2(-999766349740978337),
  123:     b = matching2(9734097866575478),
  124:     c = matching2(-966394677364879734),
  125:     d = matching2(13987294872948990),
  126:     e = matching2(777723896192459245),
  127:     other = matching2(7),
  128:     other = matching2(39789827988888888888888888888347474444444444444444444).
  129: 
  130: %% Big numbers with select_val.
  131: 
  132: matching2(-999766349740978337) -> a;
  133: matching2(9734097866575478) -> b;
  134: matching2(-966394677364879734) -> c;
  135: matching2(13987294872948990) -> d;
  136: matching2(777723896192459245) -> e;
  137: matching2(_) -> other.
  138: 
  139: matching_bigs_and_smalls(doc) -> "Test matching of a mix of big numbers and literals.";
  140: matching_bigs_and_smalls(suite) -> [];
  141: matching_bigs_and_smalls(Config) when is_list(Config) ->
  142:     a = matching3(38472928723987239873873),
  143:     b = matching3(0),
  144:     c = matching3(-3873973932710954671207461057614287561348756348743634876436784367873),
  145:     d = matching3(3978429867297393873),
  146:     e = matching3(42),
  147:     f = matching3(-4533),
  148:     other = matching3(77),
  149:     other = matching3(39274120984379249874219748).
  150: 
  151: %% Mixed small and big.
  152: 
  153: matching3(38472928723987239873873) -> a;
  154: matching3(0) -> b;
  155: matching3(-3873973932710954671207461057614287561348756348743634876436784367873) -> c;
  156: matching3(3978429867297393873) -> d;
  157: matching3(42) -> e;
  158: matching3(-4533) -> f;
  159: matching3(_) -> other.
  160: 
  161: badmatch(doc) -> "Test literal badmatches with big number and floats.";
  162: badmatch(Config) when is_list(Config) ->
  163:     %% We are satisfied if we can load this module and run it.
  164:     Big = id(32984798729847892498297824872982972978239874),
  165:     Float = id(3.1415927),
  166:     ?line catch a = Big,
  167:     ?line catch b = Float,
  168:     ?line {'EXIT',{{badmatch,3879373498378993387},_}} =
  169: 	   (catch c = 3879373498378993387),
  170:     ?line {'EXIT',{{badmatch,7.0},_}} = (catch d = 7.0),
  171:     ?line case Big of
  172: 	      Big -> ok
  173: 	  end,
  174:     ?line case Float of
  175: 	      Float -> ok
  176: 	  end,
  177:     ok.
  178: 
  179: case_clause(Config) when is_list(Config) ->
  180:     ?line {'EXIT',{{case_clause,337.0},_}} = (catch case_clause_float()),
  181:     ?line {'EXIT',{{try_clause,42.0},_}} = (catch try_case_clause_float()),
  182:     ?line {'EXIT',{{case_clause,37932749837839747383847398743789348734987},_}} =
  183: 	(catch case_clause_big()),
  184:     ?line {'EXIT',{{try_clause,977387349872349870423364354398566348},_}} =
  185: 	(catch try_case_clause_big()),
  186:     ok.
  187: 
  188: case_clause_float() ->
  189:     case 337.0 of
  190: 	blurf -> ok
  191:     end.
  192: 
  193: try_case_clause_float() ->
  194:     try 42.0 of
  195: 	blurf -> ok
  196:     catch _:_ ->
  197: 	    error
  198:     end.
  199: 
  200: case_clause_big() ->
  201:     case 37932749837839747383847398743789348734987 of
  202: 	blurf -> ok
  203:     end.
  204: 
  205: try_case_clause_big() ->
  206:     try 977387349872349870423364354398566348 of
  207: 	blurf -> ok
  208:     catch _:_ ->
  209: 	    error
  210:     end.
  211: 
  212: receiving(doc) -> "Test receive with a big number literal (more than 27 bits, "
  213: 		      "less than 32 bits).";
  214: receiving(Config) when is_list(Config) ->
  215:     Self = self(),
  216:     spawn(fun() -> Self ! here_is_a_message end),
  217:     ok = receive
  218: 	     here_is_a_message ->
  219: 		 ok
  220: 	 after 16#f1234567 ->
  221: 		 timeout
  222: 	 end.
  223: 
  224: literal_type_tests(doc) -> "Test type tests on literal values.";
  225: literal_type_tests(Config) when is_list(Config) ->
  226:     %% Generate an Erlang module with all different type of type tests.
  227:     ?line Tests = make_test([{T, L} || T <- type_tests(), L <- literals()]),
  228:     ?line Mod = literal_test,
  229:     ?line Func = {function, 0, test, 0, [{clause,0,[],[],Tests}]},
  230:     ?line Form = [{attribute,0,module,Mod},
  231: 		  {attribute,0,compile,export_all},
  232: 		  Func, {eof,0}],
  233: 
  234:     %% Print generated code for inspection.
  235:     ?line lists:foreach(fun (F) -> io:put_chars([erl_pp:form(F),"\n"]) end, Form),
  236: 
  237:     %% Test compile:form/1.  This implies full optimization (default).
  238:     ?line {ok,Mod,Code1} = compile:forms(Form),
  239:     ?line {module,Mod} = code:load_binary(Mod, Mod, Code1),
  240:     ?line Mod:test(),
  241:     ?line true = code:delete(Mod),
  242:     ?line code:purge(Mod),
  243: 			       
  244:     %% Test compile:form/2.  Turn off all optimizations.
  245:     ?line {ok,Mod,Code2} = compile:forms(Form, [binary,report,time,
  246: 						no_copt,no_postopt]),
  247:     ?line {module,Mod} = code:load_binary(Mod, Mod, Code2),
  248:     ?line Mod:test(),
  249:     ?line true = code:delete(Mod),
  250:     ?line code:purge(Mod),
  251:     ok.
  252: 
  253: make_test([{is_function=T,L}|Ts]) ->
  254:     [test(T, L),test(T, 0, L)|make_test(Ts)];
  255: make_test([{T,L}|Ts]) ->
  256:     [test(T, L)|make_test(Ts)];
  257: make_test([]) -> [].
  258: 
  259: test(T, L) ->
  260:     S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T, L, T, L])),
  261:     {ok,Toks,_Line} = erl_scan:string(S),
  262:     {ok,E} = erl_parse:parse_exprs(Toks),
  263:     {value,Val,_Bs} = erl_eval:exprs(E, []),
  264:     {match,0,{atom,0,Val},hd(E)}.
  265: 
  266: test(T, A, L) ->
  267:     S = lists:flatten(io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ",
  268: 				    [T,L,A,T,L,A])),
  269:     {ok,Toks,_Line} = erl_scan:string(S),
  270:     {ok,E} = erl_parse:parse_exprs(Toks),
  271:     {value,Val,_Bs} = erl_eval:exprs(E, []),
  272:     {match,0,{atom,0,Val},hd(E)}.
  273:     
  274: literals() ->
  275:     [42,
  276:      3.14,
  277:      -3,
  278:      32982724987789283473473838474,
  279:      [],
  280:      xxxx].
  281: 
  282: type_tests() ->
  283:     [is_boolean,
  284:      is_integer,
  285:      is_float,
  286:      is_number,
  287:      is_atom,
  288:      is_list,
  289:      is_tuple,
  290:      is_pid,
  291:      is_reference,
  292:      is_port,
  293:      is_binary,
  294:      is_function].
  295: 
  296: put_list(Config) when is_list(Config) ->
  297:     %% put_list x0 Literal Reg
  298:     ?line [Config|8739757395764] = put_list_rqr(Config),
  299:     ?line {[Config|7779757395764],Config} = put_list_rqx(Config),
  300:     ?line [Config|98765432100000] = put_list_rqy(Config),
  301: 
  302:     %% put_list x Literal Reg
  303:     ?line [Config|16#FFFFF77777137483769] = put_list_xqr(ignore, Config),
  304:     ?line {[Config|16#AAAAAFFFFF77777],{a,b},Config} =  put_list_xqx({a,b}, Config),
  305:     ?line [Config|12777765432979879] = put_list_xqy(ignore, Config),
  306: 
  307:     %% put_list y Literal Reg
  308:     ?line [Config|17424134793676869867] = put_list_yqr(Config),
  309:     ?line {[Config|77424134793676869867],Config} = put_list_yqx(Config),
  310:     ?line {Config,[Config|16#BCDEFF4241676869867]} = put_list_yqy(Config),
  311: 
  312:     %% put_list Literal x0 Reg
  313:     ?line [42.0|Config] = put_list_qrr(Config),
  314:     ?line [Config,42.0|Config] = put_list_qrx(Config),
  315:     ?line [100.0|Config] = put_list_qry(Config),
  316: 
  317:     %% put_list Literal x1 Reg
  318:     ?line [127.0|Config] = put_list_qxr({ignore,me}, Config),
  319:     ?line [Config,130.0|Config] = put_list_qxx(ignore, Config),
  320:     ?line [99.0|Config] = put_list_qxy(Config),
  321: 
  322:     %% put_list Literal y0 Reg
  323:     ?line [200.0|Config] = put_list_qyr(Config),
  324:     ?line [Config,210.0|Config] = put_list_qyx(Config),
  325:     ?line [[300.0|Config]|Config] = put_list_qyy(Config),
  326: 
  327:     ok.
  328:     
  329: %% put_list x0 Literal x0
  330: put_list_rqr(Config) -> [Config|8739757395764].
  331: 
  332: %% put_list x0 Literal x1
  333: put_list_rqx(Config) -> {[Config|7779757395764],Config}.
  334: 
  335: %% put_list x0 Literal y0
  336: put_list_rqy(Config) ->
  337:     Res = [Config|98765432100000],
  338:     id(42),
  339:     Res.
  340: 
  341: %% put_list x1 Literal x0
  342: put_list_xqr(_, Config) -> [Config|16#FFFFF77777137483769].
  343: 
  344: %% put_list x1 Literal x2
  345: put_list_xqx(A, Config) -> {[Config|16#AAAAAFFFFF77777],A,Config}.
  346: 
  347: %% put_list x1 Literal y0
  348: put_list_xqy(_, Config) ->
  349:     Res = [Config|12777765432979879],
  350:     id(42),
  351:     Res.
  352: 
  353: %% put_list y0 Literal x0
  354: put_list_yqr(Config) ->    
  355:     id(Config),
  356:     [Config|17424134793676869867].
  357: 
  358: %% put_list y0 Literal x1
  359: put_list_yqx(Config) ->    
  360:     id(Config),
  361:     {[Config|77424134793676869867],Config}.
  362: 
  363: %% put_list y1 Literal y0
  364: put_list_yqy(Config) ->
  365:     id(Config),
  366:     Res = [Config|16#BCDEFF4241676869867],
  367:     id(Config),
  368:     {Config,Res}.
  369: 
  370: %% put_list Literal x0 x0
  371: put_list_qrr(Config) ->
  372:     [42.0|Config].
  373: 
  374: %% put_list Literal x0 x1
  375: put_list_qrx(Config) ->
  376:     [Config,42.0|Config].
  377: 
  378: %% put_list Literal x0 y0
  379: put_list_qry(Config) ->
  380:     Res = [100.0|Config],
  381:     id(0),
  382:     Res.
  383: 
  384: %% put_list Literal x1 x0
  385: put_list_qxr(_, Config) ->
  386:     [127.0|Config].
  387: 
  388: %% put_list Literal x1 x2
  389: put_list_qxx(_, Config) ->
  390:     [Config,130.0|Config].
  391: 
  392: %% put_list Literal x1 y0
  393: put_list_qxy(Config) ->
  394:     Res = [99.0|Config],
  395:     id(0),
  396:     Res.
  397: 
  398: %% put_list Literal y0 x0
  399: put_list_qyr(Config) ->    
  400:     id(Config),
  401:     [200.0|Config].
  402: 
  403: %% put_list Literal y0 x1
  404: put_list_qyx(Config) ->    
  405:     id(Config),
  406:     [Config,210.0|Config].
  407: 
  408: %% put_list Literal y1 y0
  409: put_list_qyy(Config) ->
  410:     id(Config),
  411:     Res = [300.0|Config],
  412:     id(Config),
  413:     [Res|Config].
  414: 
  415: fconv(Config) when is_list(Config) ->
  416:     ?line 5.0 = fconv_1(-34444444450.0),
  417:     ?line 13.0 = fconv_2(7.0),
  418:     ok.
  419: 
  420: fconv_1(F) when is_float(F) ->
  421:     34444444455 + F.
  422: 
  423: fconv_2(F) when is_float(F) ->
  424:     6.0 + F.
  425: 
  426: literal_case_expression(Config) when is_list(Config) ->
  427:     ?line DataDir = ?config(data_dir, Config),
  428:     ?line Src = filename:join(DataDir, "literal_case_expression"),
  429:     ?line {ok,literal_case_expression=Mod,Code} =
  430: 	compile:file(Src, [from_asm,binary]),
  431:     ?line {module,Mod} = code:load_binary(Mod, Src, Code),
  432:     ?line ok = Mod:x(),
  433:     ?line ok = Mod:y(),
  434:     ?line ok = Mod:zi1(),
  435:     ?line ok = Mod:zi2(),
  436:     ?line ok = Mod:za1(),
  437:     ?line ok = Mod:za2(),
  438:     ?line true = code:delete(Mod),
  439:     ?line code:purge(Mod),
  440:     ok.
  441: 
  442: %% Test the i_increment instruction.
  443: increment(Config) when is_list(Config) ->
  444:     %% In the 32-bit emulator, Neg32 can be represented as a small,
  445:     %% but -Neg32 cannot. Therefore the i_increment instruction must
  446:     %% not be used in the subtraction that follows (since i_increment
  447:     %% cannot handle a bignum literal).
  448:     Neg32 = -(1 bsl 27),
  449:     Big32 = id(1 bsl 32),
  450:     Result32 = (1 bsl 32) + (1 bsl 27),
  451:     ?line Result32 = Big32 + (1 bsl 27),
  452:     ?line Result32 = Big32 - Neg32,
  453: 
  454:     %% Same thing, but for the 64-bit emulator.
  455:     Neg64 = -(1 bsl 59),
  456:     Big64 = id(1 bsl 64),
  457:     Result64 = (1 bsl 64) + (1 bsl 59),
  458:     ?line Result64 = Big64 + (1 bsl 59),
  459:     ?line Result64 = Big64 - Neg64,
  460: 
  461:     %% Test error handling for the i_increment instruction.
  462:     Bad = id(bad),
  463:     ?line {'EXIT',{badarith,_}} = (catch Bad + 42),
  464: 
  465:     %% Small operands, but a big result.
  466:     Res32 = 1 bsl 27,
  467:     Small32 = id(Res32-1),
  468:     ?line Res32 = Small32 + 1,
  469:     Res64 = 1 bsl 59,
  470:     Small64 = id(Res64-1),
  471:     ?line Res64 = Small64 + 1,
  472:     ok.
  473: 
  474: %% Help functions.
  475: 
  476: chksum(Term) ->
  477:     chksum(Term, 0).
  478: 
  479: chksum([List|T], Sum) when is_list(List) ->
  480:     chksum(T, chksum(List, Sum));
  481: chksum([H|T], Sum) ->
  482:     chksum(T, chksum(H, Sum));
  483: chksum([], Sum) -> Sum;
  484: chksum(Tuple, Sum) when is_tuple(Tuple) ->
  485:     chksum(tuple_to_list(Tuple), Sum);
  486: chksum(Int, Sum) when is_integer(Int) ->
  487:     Sum * 5 + Int;
  488: chksum(Other, Sum) ->
  489:     erlang:phash2([Other|Sum], 39729747).
  490: 
  491: id(I) -> I.