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: %%
   21: -module(int_eval_SUITE).
   22: 
   23: %% Purpose: Deeper test of the evaluator.
   24: 
   25: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
   26: 	 init_per_group/2,end_per_group/2,
   27: 	 init_per_testcase/2, end_per_testcase/2,
   28: 	 bifs_outside_erlang/1, spawning/1, applying/1,
   29: 	 catch_and_throw/1, external_call/1, test_module_info/1,
   30: 	 apply_interpreted_fun/1, apply_uninterpreted_fun/1,
   31: 	 interpreted_exit/1, otp_8310/1, stacktrace/1]).
   32: 
   33: %% Helpers.
   34: -export([applier/3]).
   35: 
   36: -define(IM, my_int_eval_module).
   37: 
   38: -include_lib("test_server/include/test_server.hrl").
   39: 
   40: suite() -> [{ct_hooks,[ts_install_cth]},
   41: 	    {timetrap,{minutes,1}}].
   42: 
   43: all() -> 
   44:     [bifs_outside_erlang, spawning, applying,
   45:      catch_and_throw, external_call, test_module_info,
   46:      apply_interpreted_fun, apply_uninterpreted_fun,
   47:      interpreted_exit, otp_8310, stacktrace].
   48: 
   49: groups() -> 
   50:     [].
   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: init_per_testcase(_Case, Config) ->
   66:     ?line DataDir = ?config(data_dir, Config),
   67:     ?line {module,?IM} = int:i(filename:join(DataDir, ?IM)),
   68:     ?line ok = io:format("Interpreted modules: ~p",[int:interpreted()]),
   69:     Config.
   70: 
   71: end_per_testcase(_Case, _Config) ->
   72:     ok = io:format("Interpreted modules: ~p", [int:interpreted()]),
   73:     ok.
   74: 
   75: bifs_outside_erlang(doc) ->
   76:     "Test that BIFs outside the erlang module are correctly evaluated.";
   77: bifs_outside_erlang(suite) ->
   78:     [];
   79: bifs_outside_erlang(Config) when is_list(Config) ->
   80:     Fun = fun() ->
   81: 		  Id = ?IM:ets_new(),
   82: 		  Self = self(),
   83: 		  ok = io:format("Self: ~p", [Self]),
   84: 		  Info = ets:info(Id),
   85: 		  Self = proplists:get_value(owner, Info),
   86: 		  ?IM:ets_delete(Id),
   87: 		  ok
   88: 	  end,
   89:     ?line ok = spawn_eval(Fun),
   90:     ok.
   91: 
   92: spawning(doc) ->
   93:     "Try evalutate spawn_link/3.";
   94: spawning(suite) ->
   95:     [];
   96: spawning(Config) when is_list(Config) ->
   97:     ?line ok = spawn_eval(fun() -> ?IM:spawn_test() end).
   98: 
   99: applying(doc) ->
  100:     "Try various sorts of applies.";
  101: applying(suite) ->
  102:     [];
  103: applying(Config) when is_list(Config) ->
  104:     Fun = fun({number,X}, {number,Y}) -> X+Y end,
  105:     ?line ok = spawn_eval(fun() -> ?IM:apply_test(Fun) end).
  106: 
  107: catch_and_throw(doc) ->
  108:     "Test catch and throw/1.";
  109: catch_and_throw(suite) ->
  110:     [];
  111: catch_and_throw(Config) when is_list(Config) ->
  112:     {a,ball} = spawn_eval(fun() -> ok = ?IM:catch_a_ball(),
  113: 				   catch ?IM:throw_a_ball() end),
  114: 
  115:     %% Throw and catch without any extra outer catch.
  116: 
  117:     ?line process_flag(trap_exit, true),
  118:     ?line Pid1 = spawn_link(fun() -> exit(?IM:catch_a_ball()) end),
  119:     receive
  120: 	{'EXIT',Pid1,ok} -> ok;
  121: 	{'EXIT',Pid1,Bad1} -> ?line ?t:fail({bad_message,Bad1})
  122:     after 5000 ->
  123: 	    ?line ?t:fail(timeout)
  124:     end,
  125: 
  126: 
  127:     %% Throw without catch.
  128: 
  129:     ?line Pid2 = spawn_link(fun() -> ?IM:throw_a_ball() end),
  130:     receive
  131: 	{'EXIT',Pid2,{{nocatch,{a,ball}},[_|_]}} -> ok;
  132: 	{'EXIT',Pid2,Bad2} -> ?line ?t:fail({bad_message,Bad2})
  133:     after 5000 ->
  134: 	    ?line ?t:fail(timeout)
  135:     end,
  136: 
  137:     ?line ok = ?IM:more_catch(fun(_) -> ?IM:exit_me() end),
  138:     ?line ok = ?IM:more_catch(fun(_) -> exit({unint, exit}) end),
  139:     ?line {a, ball} = ?IM:more_catch(fun(_) -> ?IM:throw_a_ball() end),
  140:     ?line {b, ball} = ?IM:more_catch(fun(_) -> throw({b,ball}) end),
  141: 
  142:     ExitInt = {'EXIT',{int,exit}},
  143:     ExitU   = {'EXIT',{unint,exit}},
  144: 
  145:     ?line ExitInt = (catch ?IM:more_nocatch(fun(_) -> ?IM:exit_me() end)),
  146:     ?line ExitU   = (catch ?IM:more_nocatch(fun(_) -> exit({unint, exit}) end)),
  147:     ?line {a, ball} = (catch {error, ?IM:more_nocatch(fun(_) -> ?IM:throw_a_ball() end)}),
  148:     ?line {b, ball} = (catch {error, ?IM:more_nocatch(fun(_) -> throw({b,ball}) end)}),
  149:     ok.
  150: 
  151: external_call(doc) ->
  152:     "Test external calls.";
  153: external_call(suite) ->
  154:     [];
  155: external_call(Config) when is_list(Config) ->
  156:     ?line ok = spawn_eval(fun() -> ?IM:external_call_test({some,stupid,data}) end).
  157: 
  158: test_module_info(doc) ->
  159:     "Test the module_info/0,1 functions.";
  160: test_module_info(suite) ->
  161:     [];
  162: test_module_info(Config) when is_list(Config) ->
  163:     ?line ModInfo = ?IM:module_info(),
  164:     ?line {value,{exports,Exp}} = lists:keysearch(exports, 1, ModInfo),
  165:     ?line {value,{attributes,Attr}} = lists:keysearch(attributes, 1, ModInfo),
  166:     ?line Exp = ?IM:module_info(exports),
  167:     ?line Attr = ?IM:module_info(attributes),
  168:     ?line {value,{stupid_attribute,[{a,b}]}} =
  169: 	lists:keysearch(stupid_attribute, 1, Attr),
  170: 
  171:     %% Check exports using a list comprehension in the module itself.
  172: 
  173:     ?line ok = ?IM:check_exports(Exp),
  174: 
  175:     %% Call module_info/0,1 from the module itself.
  176: 
  177:     ?line ok = ?IM:check_module_info(ModInfo, Exp),
  178: 
  179:     ok.
  180: 
  181: apply_interpreted_fun(doc) ->
  182:     "Apply a fun defined in interpreted code.";
  183: apply_interpreted_fun(suite) -> [];
  184: apply_interpreted_fun(Config) when is_list(Config) ->
  185: 
  186:     %% Called from uninterpreted code
  187:     ?line F1 = spawn_eval(fun() -> ?IM:give_me_a_fun_0() end),
  188:     ?line perfectly_alright = spawn_eval(fun() -> F1() end),
  189:     ?line ATerm = {a,term},
  190:     ?line F2 = spawn_eval(fun() -> ?IM:give_me_a_fun_0(ATerm) end),
  191:     ?line {ok,ATerm} = spawn_eval(fun() -> F2() end),
  192: 
  193:     %% Called from uninterpreted code, badarity
  194:     ?line {'EXIT',{{badarity,{F1,[snape]}},[{?MODULE,_,_,_}|_]}} =
  195: 	spawn_eval(fun() -> F1(snape) end),
  196: 
  197:     %% Called from uninterpreted code, error in fun
  198:     ?line F3 = spawn_eval(fun() -> ?IM:give_me_a_bad_fun() end),
  199:     ?line {'EXIT',{snape,[{?IM,_FunName,_,_}|_]}} =
  200: 	spawn_eval(fun() -> F3(snape) end),
  201: 
  202:     %% Called from within interpreted code
  203:     ?line perfectly_alright = spawn_eval(fun() -> ?IM:do_apply(F1) end),
  204: 
  205:     %% Called from within interpreted code, badarity
  206:     ?line {'EXIT',{{badarity,{F1,[snape]}},[{?IM,do_apply,_,_}|_]}} =
  207: 	spawn_eval(fun() -> ?IM:do_apply(F1, snape) end),
  208: 
  209:     %% Called from within interpreted code, error in fun
  210:     ?line {'EXIT',{snape,[{?IM,_FunName,_,_}|_]}} =
  211: 	spawn_eval(fun() -> ?IM:do_apply(F3, snape) end),
  212: 
  213:     %% Try some more complex funs.
  214:     ?line F4 = ?IM:give_me_a_fun_1(14, 42),
  215:     ?line {false,yes,yeah,false} =
  216: 	F4({{1,nope},{14,yes},{42,yeah},{100,forget_it}}),
  217:     ?line [this_is_ok,me_too] =
  218: 	F4([{-24,no_way},{15,this_is_ok},{1333,forget_me},{37,me_too}]),
  219: 
  220:     %% OTP-5837
  221:     %% Try fun with guard containing variable bound in environment
  222:     ?line [yes,no,no,no] = ?IM:otp_5837(1),
  223: 
  224:     ok.
  225: 
  226: apply_uninterpreted_fun(doc) ->
  227:     "Apply a fun defined outside interpreted code.";
  228: apply_uninterpreted_fun(suite) -> [];
  229: apply_uninterpreted_fun(Config) when is_list(Config) ->
  230: 
  231:     ?line F1 = fun(snape) ->
  232: 		       erlang:error(snape);
  233: 		  (_Arg) ->
  234: 		       perfectly_alright
  235: 	       end,
  236: 
  237:     %% Ok
  238:     ?line perfectly_alright =
  239: 	spawn_eval(fun() -> ?IM:do_apply(F1, any_arg) end),
  240: 
  241:     %% Badarity (evaluated in dbg_debugged, which calls erlang:apply/2)
  242:     ?line {'EXIT',{{badarity,{F1,[]}},[{erlang,apply,_,_}|_]}} =
  243: 	spawn_eval(fun() -> ?IM:do_apply(F1) end),
  244: 
  245:     %% Error in fun
  246:     ?line {'EXIT',{snape,[{?MODULE,_FunName,_,_}|_]}} =
  247: 	spawn_eval(fun() -> ?IM:do_apply(F1, snape) end),
  248: 
  249:     ok.
  250: 
  251: %%
  252: %% Try executing an interpreted exit/1 call.
  253: %%
  254: 
  255: interpreted_exit(Config) when is_list(Config) ->
  256:     ?line process_flag(trap_exit, true),
  257:     ?line Reason = make_ref(),
  258:     ?line Pid = spawn_link(fun() -> ?IM:please_call_exit(Reason) end),
  259:     ?line receive
  260: 	      {'EXIT',Pid,Reason} ->
  261: 		  ok;
  262: 	      {'EXIT',Pid,BadReason} ->
  263: 		  ?line ?t:fail({bad_message,BadReason})
  264: 	  after 10000 ->
  265: 		  ?line ?t:fail(timeout)
  266: 	  end,
  267:     ok.
  268: 
  269: otp_8310(doc) ->
  270:     "OTP-8310. Bugfixes lc/bc and andalso/orelse.";
  271: otp_8310(Config) when is_list(Config) ->
  272:     ?line ok = ?IM:otp_8310(),
  273:     ok.
  274: 
  275: applier(M, F, A) ->
  276:     Res = apply(M, F, A),
  277:     io:format("~p:~p(~p) => ~p\n", [M,F,A,Res]),
  278:     Res.
  279: 
  280: stacktrace(Config) when is_list(Config) ->
  281:     ?line {done,Stk} = do_eval(Config, stacktrace),
  282:     ?line 13 = length(Stk),
  283:     ?line OldStackTraceFlag = int:stack_trace(),
  284:     ?line int:stack_trace(no_tail),
  285:     try
  286: 	?line Res = spawn_eval(fun() -> stacktrace:stacktrace() end),
  287: 	?line io:format("\nInterpreted (no_tail):\n~p", [Res]),
  288: 	?line {done,Stk} = Res
  289: 	after
  290: 	    ?line int:stack_trace(OldStackTraceFlag)
  291: 	end,
  292:     ok.
  293: 
  294: 
  295: do_eval(Config, Mod) ->
  296:     ?line DataDir = ?config(data_dir, Config),
  297:     ?line ok = file:set_cwd(DataDir),
  298: 
  299:     ?line {ok,Mod} = compile:file(Mod, [report,debug_info]),
  300:     ?line {module,Mod} = code:load_file(Mod),
  301:     ?line CompiledRes = Mod:Mod(),
  302:     ?line ok = io:format("Compiled:\n~p", [CompiledRes]),
  303:     io:nl(),
  304: 
  305:     ?line {module,Mod} = int:i(Mod),
  306:     ?line IntRes = Mod:Mod(),
  307:     ?line ok = io:format("Interpreted:\n~p", [IntRes]),
  308: 
  309:     ?line CompiledRes = IntRes.
  310: 
  311: %%
  312: %% Evaluate in another process, to prevent the test_case process to become
  313: %% interpreted.
  314: %%
  315: 
  316: spawn_eval(Fun) ->
  317:     Self = self(),
  318:     spawn_link(fun() -> Self ! (catch Fun()) end),
  319:     receive
  320: 	Result ->
  321: 	    Result
  322:     end.