1: %%
    2: %% %CopyrightBegin%
    3: %%
    4: %% Copyright Ericsson AB 1999-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(fun_SUITE).
   21: -compile({nowarn_deprecated_function, {erlang,hash,2}}).
   22: 
   23: -define(default_timeout, ?t:minutes(1)).
   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: 	 bad_apply/1,bad_fun_call/1,badarity/1,ext_badarity/1,
   29: 	 equality/1,ordering/1,
   30: 	 fun_to_port/1,t_hash/1,t_phash/1,t_phash2/1,md5/1,
   31: 	 refc/1,refc_ets/1,refc_dist/1,
   32: 	 const_propagation/1,t_arity/1,t_is_function2/1,
   33: 	 t_fun_info/1]).
   34: 
   35: -export([nothing/0]).
   36: 
   37: -include_lib("test_server/include/test_server.hrl").
   38: 
   39: suite() -> [{ct_hooks,[ts_install_cth]}].
   40: 
   41: all() -> 
   42:     [bad_apply, bad_fun_call, badarity, ext_badarity,
   43:      equality, ordering, fun_to_port, t_hash, t_phash,
   44:      t_phash2, md5, refc, refc_ets, refc_dist,
   45:      const_propagation, t_arity, t_is_function2, t_fun_info].
   46: 
   47: groups() -> 
   48:     [].
   49: 
   50: init_per_suite(Config) ->
   51:     Config.
   52: 
   53: end_per_suite(_Config) ->
   54:     ok.
   55: 
   56: init_per_group(_GroupName, Config) ->
   57:     Config.
   58: 
   59: end_per_group(_GroupName, Config) ->
   60:     Config.
   61: 
   62: 
   63: init_per_testcase(_Case, Config) ->
   64:     ?line Dog = test_server:timetrap(?default_timeout),
   65:     [{watchdog, Dog}|Config].
   66: 
   67: end_per_testcase(_Case, Config) ->
   68:     Dog=?config(watchdog, Config),
   69:     test_server:timetrap_cancel(Dog),
   70:     ok.
   71: 
   72: bad_apply(doc) ->
   73:     "Test that the correct EXIT code is returned for all types of bad funs.";
   74: bad_apply(suite) -> [];
   75: bad_apply(Config) when is_list(Config) ->
   76:     ?line bad_apply_fc(42, [0]),
   77:     ?line bad_apply_fc(xx, [1]),
   78:     ?line bad_apply_fc({}, [2]),
   79:     ?line bad_apply_fc({1}, [3]),
   80:     ?line bad_apply_fc({1,2,3}, [4]),
   81:     ?line bad_apply_fc({1,2,3}, [5]),
   82:     ?line bad_apply_fc({1,2,3,4}, [6]),
   83:     ?line bad_apply_fc({1,2,3,4,5,6}, [7]),
   84:     ?line bad_apply_fc({1,2,3,4,5}, [8]),
   85:     ?line bad_apply_badarg({1,2}, [9]),
   86:     ok.
   87: 
   88: bad_apply_fc(Fun, Args) ->
   89:     Res = (catch apply(Fun, Args)),
   90:     erlang:garbage_collect(),
   91:     erlang:yield(),
   92:     case Res of
   93: 	{'EXIT',{{badfun,Fun},_Where}} ->
   94: 	    ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]);
   95: 	Other ->
   96: 	    ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]),
   97: 	    ?t:fail({bad_result,Other})
   98:     end.
   99: 
  100: bad_apply_badarg(Fun, Args) ->
  101:     Res = (catch apply(Fun, Args)),
  102:     erlang:garbage_collect(),
  103:     erlang:yield(),
  104:     case Res of
  105: 	{'EXIT',{{badfun,Fun},_Where}} ->
  106: 	    ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]);
  107: 	Other ->
  108: 	    ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res]),
  109: 	    ?t:fail({bad_result, Other})
  110:     end.
  111: 
  112: bad_fun_call(doc) ->
  113:     "Try directly calling bad funs.";
  114: bad_fun_call(suite) -> [];
  115: bad_fun_call(Config) when is_list(Config) ->
  116:     ?line bad_call_fc(42),
  117:     ?line bad_call_fc(xx),
  118:     ?line bad_call_fc({}),
  119:     ?line bad_call_fc({1}),
  120:     ?line bad_call_fc({1,2,3}),
  121:     ?line bad_call_fc({1,2,3}),
  122:     ?line bad_call_fc({1,2,3,4}),
  123:     ?line bad_call_fc({1,2,3,4,5,6}),
  124:     ?line bad_call_fc({1,2,3,4,5}),
  125:     ?line bad_call_fc({1,2}),
  126:     ok.
  127: 
  128: bad_call_fc(Fun) ->
  129:     Args = [some,stupid,args],
  130:     Res = (catch Fun(Fun(Args))),
  131:     case Res of
  132: 	{'EXIT',{{badfun,Fun},_Where}} ->
  133: 	    ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]);
  134: 	Other ->
  135: 	    ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]),
  136: 	    ?t:fail({bad_result,Other})
  137:     end.
  138: 
  139: %% Call and apply valid funs with wrong number of arguments.
  140: 
  141: badarity(Config) when is_list(Config) ->
  142:     ?line Fun = fun() -> ok end,
  143:     ?line Stupid = {stupid,arguments},
  144:     ?line Args = [some,{stupid,arguments},here],
  145: 
  146:     %% Simple call.
  147: 
  148:     ?line Res = (catch Fun(some, Stupid, here)),
  149:     erlang:garbage_collect(),
  150:     erlang:yield(),
  151:     case Res of
  152: 	{'EXIT',{{badarity,{Fun,Args}},_}} ->
  153: 	    ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]);
  154: 	_ ->
  155: 	    ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]),
  156: 	    ?line ?t:fail({bad_result,Res})
  157:     end,
  158: 
  159:     %% Apply.
  160: 
  161:     ?line Res2 = (catch apply(Fun, Args)),
  162:     erlang:garbage_collect(),
  163:     erlang:yield(),
  164:     case Res2 of
  165: 	{'EXIT',{{badarity,{Fun,Args}},_}} ->
  166: 	    ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]);
  167: 	_ ->
  168: 	    ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]),
  169: 	    ?line ?t:fail({bad_result,Res2})
  170:     end,
  171:     ok.
  172: 
  173: %% Call and apply valid external funs with wrong number of arguments.
  174: 
  175: ext_badarity(Config) when is_list(Config) ->
  176:     ?line Fun = fun ?MODULE:nothing/0,
  177:     ?line Stupid = {stupid,arguments},
  178:     ?line Args = [some,{stupid,arguments},here],
  179: 
  180:     %% Simple call.
  181: 
  182:     ?line Res = (catch Fun(some, Stupid, here)),
  183:     erlang:garbage_collect(),
  184:     erlang:yield(),
  185:     case Res of
  186: 	{'EXIT',{{badarity,{Fun,Args}},_}} ->
  187: 	    ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]);
  188: 	_ ->
  189: 	    ?line ok = io:format("~p(~p) -> ~p\n", [Fun,Args,Res]),
  190: 	    ?line ?t:fail({bad_result,Res})
  191:     end,
  192: 
  193:     %% Apply.
  194: 
  195:     ?line Res2 = (catch apply(Fun, Args)),
  196:     erlang:garbage_collect(),
  197:     erlang:yield(),
  198:     case Res2 of
  199: 	{'EXIT',{{badarity,{Fun,Args}},_}} ->
  200: 	    ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]);
  201: 	_ ->
  202: 	    ?line ok = io:format("apply(~p, ~p) -> ~p\n", [Fun,Args,Res2]),
  203: 	    ?line ?t:fail({bad_result,Res2})
  204:     end,
  205:     ok.
  206: 
  207: nothing() ->
  208:     ok.
  209: 
  210: %% Test equality of funs.
  211: 
  212: equality(Config) when is_list(Config) ->
  213:     F0 = fun() -> 1 end,
  214:     F0_copy = copy_term(F0),
  215:     ?line true = eq(F0, F0),
  216:     ?line true = eq(F0, F0_copy),
  217: 
  218:     %% Compare different arities.
  219:     F1 = fun(X) -> X + 1 end,
  220:     ?line true = eq(F1, F1),
  221:     ?line false = eq(F0, F1),
  222:     ?line false = eq(F0_copy, F1),
  223: 
  224:     %% Compare different environments.
  225:     G1 = make_fun(1),
  226:     G2 = make_fun(2),
  227:     ?line true = eq(G1, G1),
  228:     ?line true = eq(G2, G2),
  229:     ?line false = eq(G1, G2),
  230:     ?line false = eq(G2, G1),
  231:     G1_copy = copy_term(G1),
  232:     ?line true = eq(G1, G1_copy),
  233: 
  234:     %% Compare fun with binaries.
  235:     B = list_to_binary([7,8,9]),
  236:     ?line false = eq(B, G1),
  237:     ?line false = eq(G1, B),
  238: 
  239:     %% Compare external funs.
  240:     FF0 = fun aa:blurf/0,
  241:     FF0_copy = copy_term(FF0),
  242:     FF1 = fun erlang:abs/0,
  243:     FF2 = fun erlang:exit/1,
  244:     FF3 = fun erlang:exit/2,
  245:     FF4 = fun z:ff/0,
  246: 
  247:     ?line true = eq(FF0, FF0),
  248:     ?line true = eq(FF0, FF0_copy),
  249:     ?line true = eq(FF1, FF1),
  250:     ?line true = eq(FF2, FF2),
  251:     ?line true = eq(FF3, FF3),
  252:     ?line true = eq(FF4, FF4),
  253:     ?line false = eq(FF0, FF1),
  254:     ?line false = eq(FF0, FF2),
  255:     ?line false = eq(FF0, FF3),
  256:     ?line false = eq(FF0, FF4),
  257:     ?line false = eq(FF1, FF0),
  258:     ?line false = eq(FF1, FF2),
  259:     ?line false = eq(FF1, FF3),
  260:     ?line false = eq(FF1, FF4),
  261:     ?line false = eq(FF2, FF3),
  262:     ?line false = eq(FF2, FF4),
  263:     ?line false = eq(FF3, FF4),
  264: 
  265:     ok.
  266: 
  267: eq(X, X) -> true;
  268: eq(_, _) -> false.
  269: 
  270: copy_term(Term) ->
  271:     binary_to_term(term_to_binary(Term)).
  272: 
  273: make_fun(X) ->
  274:     fun() -> X end.
  275: 	    
  276: ordering(doc) -> "Tests ordering of funs.";
  277: ordering(Config) when is_list(Config) ->
  278:     F1 = make_fun(1, 2),
  279:     F1_copy = copy_term(F1),
  280:     F2 = make_fun(1, 3),
  281:     F3 = make_fun(3, 4),
  282: 
  283:     FF0 = fun aa:blurf/0,
  284:     FF1 = fun erlang:abs/0,
  285:     FF2 = fun erlang:exit/1,
  286:     FF3 = fun erlang:exit/2,
  287:     FF4 = fun z:ff/0,
  288: 
  289:     ?line true = FF0 < FF1,
  290:     ?line true = FF1 < FF2,
  291:     ?line true = FF2 < FF3,
  292:     ?line true = FF3 < FF4,
  293: 
  294:     ?line true = FF0 > F1,
  295:     ?line true = FF0 > F2,
  296:     ?line true = FF0 > F3,
  297:     ?line true = FF4 > F1,
  298:     ?line true = FF4 > F2,
  299:     ?line true = FF4 > F3,
  300: 
  301:     ?line true = F1 == F1,
  302:     ?line true = F1 == F1_copy,
  303:     ?line true = F1 /= F2,
  304: 
  305:     ?line true = F1 < F2,
  306:     ?line true = F2 > F1,
  307:     ?line true = F2 < F3,
  308:     ?line true = F3 > F2,
  309: 
  310:     ?line false = F1 > F2,
  311:     ?line false = F2 > F3,
  312: 
  313:     %% Compare with binaries.
  314: 
  315:     B = list_to_binary([7,8,9,10]),
  316:     ?line false = B == F1,
  317:     ?line false = F1 == B,
  318: 
  319:     ?line true = F1 < B,
  320:     ?line true = B > F2,
  321: 
  322:     ?line false = F1 > B,
  323:     ?line false = B < F2,
  324: 
  325:     ?line false = F1 >= B,
  326:     ?line false = B =< F2,
  327: 
  328:     %% Compare module funs with binaries.
  329:     ?line false = B == FF1,
  330:     ?line false = FF1 == B,
  331: 
  332:     ?line true = FF1 < B,
  333:     ?line true = B > FF2,
  334: 
  335:     ?line false = FF1 > B,
  336:     ?line false = B < FF2,
  337: 
  338:     ?line false = FF1 >= B,
  339:     ?line false = B =< FF2,
  340: 
  341:     %% Create a port and ref.
  342: 
  343:     ?line Path = ?config(priv_dir, Config),
  344:     ?line AFile = filename:join(Path, "vanilla_file"),
  345:     ?line P = open_port(AFile, [out]),
  346:     ?line R = make_ref(),
  347: 
  348:     %% Compare funs with ports and refs.
  349: 
  350:     ?line true = R < F3,
  351:     ?line true = F3 > R,
  352:     ?line true = F3 < P,
  353:     ?line true = P > F3,
  354: 
  355:     ?line true = R =< F3,
  356:     ?line true = F3 >= R,
  357:     ?line true = F3 =< P,
  358:     ?line true = P >= F3,
  359: 
  360:     ?line false = R > F3,
  361:     ?line false = F3 < R,
  362:     ?line false = F3 > P,
  363:     ?line false = P < F3,
  364: 
  365:     %% Compare funs with conses and nils.
  366: 
  367:     ?line true = F1 < [a],
  368:     ?line true = F1 < [],
  369:     ?line true = [a,b] > F1,
  370:     ?line true = [] > F1,
  371: 
  372:     ?line false = [1] < F1,
  373:     ?line false = [] < F1,
  374:     ?line false = F1 > [2],
  375:     ?line false = F1 > [],
  376: 
  377:     ?line false = [1] =< F1,
  378:     ?line false = [] =< F1,
  379:     ?line false = F1 >= [2],
  380:     ?line false = F1 >= [],
  381: 
  382:     %% Compare module funs with conses and nils.
  383: 
  384:     ?line true = FF1 < [a],
  385:     ?line true = FF1 < [],
  386:     ?line true = [a,b] > FF1,
  387:     ?line true = [] > FF1,
  388: 
  389:     ?line false = [1] < FF1,
  390:     ?line false = [] < FF1,
  391:     ?line false = FF1 > [2],
  392:     ?line false = FF1 > [],
  393: 
  394:     ?line false = [1] =< FF1,
  395:     ?line false = [] =< FF1,
  396:     ?line false = FF1 >= [2],
  397:     ?line false = FF1 >= [],
  398:     ok.
  399: 
  400: make_fun(X, Y) ->
  401:     fun(A) -> A*X+Y end.
  402: 
  403: fun_to_port(doc) -> "Try sending funs to ports (should fail).";
  404: fun_to_port(suite) -> [];
  405: fun_to_port(Config) when is_list(Config) ->
  406:     ?line fun_to_port(Config, xxx),
  407:     ?line fun_to_port(Config, fun() -> 42 end),
  408:     ?line fun_to_port(Config, [fun() -> 43 end]),
  409:     ?line fun_to_port(Config, [1,fun() -> 44 end]),
  410:     ?line fun_to_port(Config, [0,1|fun() -> 45 end]),
  411:     B64K = build_io_list(65536),
  412:     ?line fun_to_port(Config, [B64K,fun() -> 45 end]),
  413:     ?line fun_to_port(Config, [B64K|fun() -> 45 end]),
  414:     ok.
  415: 
  416: fun_to_port(Config, IoList) ->
  417:     Path = ?config(priv_dir, Config),
  418:     AFile = filename:join(Path, "vanilla_file"),
  419:     Port = open_port(AFile, [out]),
  420:     case catch port_command(Port, IoList) of
  421: 	{'EXIT',{badarg,_}} -> ok;
  422: 	Other -> ?t:fail({unexpected_retval,Other})
  423:     end.
  424: 
  425: build_io_list(0) -> [];
  426: build_io_list(1) -> [7];
  427: build_io_list(N) ->
  428:     L = build_io_list(N div 2),
  429:     case N rem 2 of
  430: 	0 -> [L|L];
  431: 	1 -> [7,L|L]
  432:     end.
  433: 
  434: t_hash(doc) -> "Test the hash/2 BIF on funs.";
  435: t_hash(suite) -> [];
  436: t_hash(Config) when is_list(Config) ->
  437:     F1 = fun(_X) -> 1 end,
  438:     F2 = fun(_X) -> 2 end,
  439:     ?line true = hash(F1) /= hash(F2),
  440: 
  441:     G1 = make_fun(1, 2, 3),
  442:     G2 = make_fun(1, 2, 3),
  443:     G3 = make_fun(1, 2, 4),
  444:     ?line true = hash(G1) == hash(G2),
  445:     ?line true = hash(G2) /= hash(G3),
  446: 
  447:     FF0 = fun erlang:abs/1,
  448:     FF1 = fun erlang:exit/1,
  449:     FF2 = fun erlang:exit/2,
  450:     FF3 = fun blurf:exit/2,
  451:     ?line true = hash(FF0) =/= hash(FF1),
  452:     ?line true = hash(FF0) =/= hash(FF2),
  453:     ?line true = hash(FF0) =/= hash(FF3),
  454:     ?line true = hash(FF1) =/= hash(FF2),
  455:     ?line true = hash(FF1) =/= hash(FF3),
  456:     ?line true = hash(FF2) =/= hash(FF3),
  457:     ok.
  458: 
  459: hash(Term) ->
  460:     erlang:hash(Term, 16#7ffffff).
  461: 
  462: t_phash(doc) -> "Test the phash/2 BIF on funs.";
  463: t_phash(suite) -> [];
  464: t_phash(Config) when is_list(Config) ->
  465:     F1 = fun(_X) -> 1 end,
  466:     F2 = fun(_X) -> 2 end,
  467:     ?line true = phash(F1) /= phash(F2),
  468: 
  469:     G1 = make_fun(1, 2, 3),
  470:     G2 = make_fun(1, 2, 3),
  471:     G3 = make_fun(1, 2, 4),
  472:     ?line true = phash(G1) == phash(G2),
  473:     ?line true = phash(G2) /= phash(G3),
  474: 
  475:     FF0 = fun erlang:abs/1,
  476:     FF1 = fun erlang:exit/1,
  477:     FF2 = fun erlang:exit/2,
  478:     FF3 = fun blurf:exit/2,
  479:     ?line true = phash(FF0) =/= phash(FF1),
  480:     ?line true = phash(FF0) =/= phash(FF2),
  481:     ?line true = phash(FF0) =/= phash(FF3),
  482:     ?line true = phash(FF1) =/= phash(FF2),
  483:     ?line true = phash(FF1) =/= phash(FF3),
  484:     ?line true = phash(FF2) =/= phash(FF3),
  485:     
  486:     ok.
  487: 
  488: phash(Term) ->
  489:     erlang:phash(Term, 16#7ffffff).
  490: 
  491: t_phash2(doc) -> "Test the phash2/2 BIF on funs.";
  492: t_phash2(suite) -> [];
  493: t_phash2(Config) when is_list(Config) ->
  494:     F1 = fun(_X) -> 1 end,
  495:     F2 = fun(_X) -> 2 end,
  496:     ?line true = phash2(F1) /= phash2(F2),
  497: 
  498:     G1 = make_fun(1, 2, 3),
  499:     G2 = make_fun(1, 2, 3),
  500:     G3 = make_fun(1, 2, 4),
  501:     ?line true = phash2(G1) == phash2(G2),
  502:     ?line true = phash2(G2) /= phash2(G3),
  503: 
  504:     FF0 = fun erlang:abs/1,
  505:     FF1 = fun erlang:exit/1,
  506:     FF2 = fun erlang:exit/2,
  507:     FF3 = fun blurf:exit/2,
  508:     ?line true = phash2(FF0) =/= phash2(FF1),
  509:     ?line true = phash2(FF0) =/= phash2(FF2),
  510:     ?line true = phash2(FF0) =/= phash2(FF3),
  511:     ?line true = phash2(FF1) =/= phash2(FF2),
  512:     ?line true = phash2(FF1) =/= phash2(FF3),
  513:     ?line true = phash2(FF2) =/= phash2(FF3),
  514:     
  515:     ok.
  516: 
  517: phash2(Term) ->
  518:     erlang:phash2(Term, 16#7ffffff).
  519: 
  520: make_fun(X, Y, Z) ->
  521:     fun() -> {X,Y,Z} end.
  522: 
  523: md5(doc) -> "Test that MD5 bifs reject funs properly.";
  524: md5(suite) -> [];
  525: md5(Config) when is_list(Config) ->
  526:     _ = size(erlang:md5_init()),
  527: 
  528:     %% Try funs in the i/o list.
  529:     ?line bad_md5(fun(_X) -> 42 end),
  530:     ?line bad_md5([fun(_X) -> 43 end]),
  531:     ?line bad_md5([1,fun(_X) -> 44 end]),
  532:     ?line bad_md5([1|fun(_X) -> 45 end]),
  533:     ?line B64K = build_io_list(65536),
  534:     ?line bad_md5([B64K,fun(_X) -> 46 end]),
  535:     ?line bad_md5([B64K|fun(_X) -> 46 end]),
  536:     ok.
  537:     
  538: bad_md5(Bad) ->
  539:     {'EXIT',{badarg,_}} = (catch erlang:md5(Bad)).
  540: 
  541: refc(Config) when is_list(Config) ->
  542:     ?line F1 = fun_factory(2),
  543:     ?line {refc,2} = erlang:fun_info(F1, refc),
  544:     ?line F2 = fun_factory(42),
  545:     ?line {refc,3} = erlang:fun_info(F1, refc),
  546: 
  547:     ?line process_flag(trap_exit, true),
  548:     ?line Pid = spawn_link(fun() -> {refc,4} = erlang:fun_info(F1, refc) end),
  549:     receive
  550: 	{'EXIT',Pid,normal} -> ok;
  551: 	Other -> ?line ?t:fail({unexpected,Other})
  552:     end,
  553:     ?line process_flag(trap_exit, false),
  554:     ?line {refc,3} = erlang:fun_info(F1, refc),
  555: 
  556:     %% Garbage collect. Only the F2 fun will be left.
  557:     ?line 7 = F1(5),
  558:     ?line true = erlang:garbage_collect(),
  559:     ?line 40 = F2(-2),
  560:     ?line {refc,2} = erlang:fun_info(F2, refc),
  561:     ok.
  562: 
  563: fun_factory(Const) ->
  564:     fun(X) -> X + Const end.
  565: 
  566: refc_ets(Config) when is_list(Config) ->
  567:     ?line F = fun(X) -> X + 33 end,
  568:     ?line {refc,2} = erlang:fun_info(F, refc),
  569: 
  570:     refc_ets_set(F, [set]),
  571:     refc_ets_set(F, [ordered_set]),
  572:     refc_ets_bag(F, [bag]),
  573:     refc_ets_bag(F, [duplicate_bag]),
  574:     ok.
  575: 
  576: refc_ets_set(F1, Options) ->
  577:     ?line io:format("~p", [Options]),
  578:     ?line Tab = ets:new(kalle, Options),
  579:     ?line true = ets:insert(Tab, {a_key,F1}),
  580:     ?line 3 = fun_refc(F1),
  581:     ?line [{a_key,F3}] = ets:lookup(Tab, a_key),
  582:     ?line 4 = fun_refc(F1),
  583:     ?line true = ets:insert(Tab, {a_key,not_a_fun}),
  584:     ?line 3 = fun_refc(F1),
  585:     ?line true = ets:insert(Tab, {another_key,F1}),
  586:     ?line 4 = fun_refc(F1),
  587:     ?line true = ets:delete(Tab),
  588:     ?line 3 = fun_refc(F1),
  589:     ?line 10 = F3(-23),
  590:     ?line true = erlang:garbage_collect(),
  591:     ?line 2 = fun_refc(F1),
  592:     ok.
  593: 
  594: refc_ets_bag(F1, Options) ->
  595:     ?line io:format("~p", [Options]),
  596:     ?line Tab = ets:new(kalle, Options),
  597:     ?line true = ets:insert(Tab, {a_key,F1}),
  598:     ?line 3 = fun_refc(F1),
  599:     ?line [{a_key,F3}] = ets:lookup(Tab, a_key),
  600:     ?line 4 = fun_refc(F1),
  601:     ?line true = ets:insert(Tab, {a_key,not_a_fun}),
  602:     ?line 4 = fun_refc(F1),
  603:     ?line true = ets:insert(Tab, {another_key,F1}),
  604:     ?line 5 = fun_refc(F1),
  605:     ?line true = ets:delete(Tab),
  606:     ?line 3 = fun_refc(F1),
  607:     ?line 10 = F3(-23),
  608:     ?line true = erlang:garbage_collect(),
  609:     ?line 2 = fun_refc(F1),
  610:     ok.
  611: 
  612: refc_dist(Config) when is_list(Config) ->
  613:     ?line {ok,Node} = start_node(fun_SUITE_refc_dist),
  614:     ?line process_flag(trap_exit, true),
  615:     ?line Pid = spawn_link(Node,
  616: 			   fun() -> receive
  617: 					Fun when is_function(Fun) ->
  618: 					    2 = fun_refc(Fun),
  619: 					    exit({normal,Fun}) end
  620: 			   end),
  621:     ?line F = fun() -> 42 end,
  622:     ?line 2 = fun_refc(F),
  623:     ?line Pid ! F,
  624:     F2 = receive
  625: 	     {'EXIT',Pid,{normal,Fun}} -> Fun;
  626: 	     Other -> ?line ?t:fail({unexpected,Other})
  627: 	 end,
  628:     %% dist.c:net_mess2 have a reference to Fun for a while since
  629:     %% Fun is passed in an exit signal. Wait until it is gone.
  630:     ?line wait_until(fun () -> 4 =/= fun_refc(F2) end),
  631:     ?line 3 = fun_refc(F2),
  632:     ?line true = erlang:garbage_collect(),
  633:     ?line 2 = fun_refc(F),
  634:     refc_dist_send(Node, F).
  635: 
  636: refc_dist_send(Node, F) ->
  637:     ?line Pid = spawn_link(Node,
  638: 			   fun() -> receive
  639: 					{To,Fun} when is_function(Fun) ->
  640: 					    wait_until(fun () ->
  641: 							       2 =:= fun_refc(Fun)
  642: 						       end),
  643: 					    To ! Fun
  644: 				    end
  645: 			   end),
  646:     ?line 2 = fun_refc(F),
  647:     Pid ! {self(),F},
  648:     F2 = receive
  649: 	     Fun when is_function(Fun) -> Fun;
  650: 	     Other -> ?line ?t:fail({unexpected,Other})
  651: 	 end,
  652:     receive {'EXIT',Pid,normal} -> ok end,
  653:     %% No reference from dist.c:net_mess2 since Fun is passed
  654:     %% in an ordinary message.
  655:     ?line 3 = fun_refc(F),
  656:     ?line 3 = fun_refc(F2),
  657:     refc_dist_reg_send(Node, F).
  658: 
  659: refc_dist_reg_send(Node, F) ->
  660:     ?line true = erlang:garbage_collect(),
  661:     ?line 2 = fun_refc(F),
  662:     ?line Ref = make_ref(),
  663:     ?line Me = self(),
  664:     ?line Pid = spawn_link(Node,
  665: 			   fun() ->
  666: 				   true = register(my_fun_tester, self()),
  667: 				   Me ! Ref,
  668: 				   receive
  669: 				       {Me,Fun} when is_function(Fun) ->
  670: 					   2 = fun_refc(Fun),
  671: 					   Me ! Fun
  672: 				   end
  673: 			   end),
  674:     erlang:yield(),
  675:     ?line 2 = fun_refc(F),
  676:     receive Ref -> ok end,
  677:     {my_fun_tester,Node} ! {self(),F},
  678:     F2 = receive
  679: 	     Fun when is_function(Fun) -> Fun;
  680: 	     Other -> ?line ?t:fail({unexpected,Other})
  681: 	 end,
  682:     receive {'EXIT',Pid,normal} -> ok end,
  683: 
  684:     ?line 3 = fun_refc(F),
  685:     ?line 3 = fun_refc(F2),
  686:     ok.
  687:     
  688: fun_refc(F) ->
  689:     {refc,Count} = erlang:fun_info(F, refc),
  690:     Count.
  691: 
  692: const_propagation(Config) when is_list(Config) ->
  693:     ?line Fun1 = fun start_node/1,
  694:     ?line 2 = fun_refc(Fun1),
  695:     ?line Fun2 = Fun1,
  696:     ?line my_cmp({Fun1,Fun2}),
  697: 
  698:     ?line Fun3 = fun() -> ok end,
  699:     ?line 2 = fun_refc(Fun3),
  700:     ?line Fun4 = Fun3,
  701:     ?line my_cmp({Fun3,Fun4}),
  702:     ok.
  703: 
  704: my_cmp({Fun,Fun}) -> ok;
  705: my_cmp({Fun1,Fun2}) ->
  706:     io:format("Fun1: ~p", [erlang:fun_info(Fun1)]),
  707:     io:format("Fun2: ~p", [erlang:fun_info(Fun2)]),
  708:     ?t:fail().
  709: 
  710: t_arity(Config) when is_list(Config) ->
  711:     ?line 0 = fun_arity(fun() -> ok end),
  712:     ?line 0 = fun_arity(fun() -> Config end),
  713:     ?line 1 = fun_arity(fun(X) -> X+1 end),
  714:     ?line 1 = fun_arity(fun(X) -> Config =:= X end),
  715:     A = id(42),
  716: 
  717:     %% Test that the arity is transferred properly.
  718:     ?line process_flag(trap_exit, true),
  719:     ?line {ok,Node} = start_node(fun_test_arity),
  720:     ?line hello_world = spawn_call(Node, fun() -> hello_world end),
  721:     ?line 0 = spawn_call(Node, fun(X) -> X end),
  722:     ?line 42 = spawn_call(Node, fun(_X) -> A end),
  723:     ?line 43 = spawn_call(Node, fun(X, Y) -> A+X+Y end),
  724:     ?line 1 = spawn_call(Node, fun(X, Y) -> X+Y end),
  725:     ?line 45 = spawn_call(Node, fun(X, Y, Z) -> A+X+Y+Z end),
  726:     ok.
  727: 
  728: t_is_function2(Config) when is_list(Config) ->
  729:     false = is_function(id({a,b}), 0),
  730:     false = is_function(id({a,b}), 234343434333433433),
  731:     ?line true = is_function(fun() -> ok end, 0),
  732:     ?line true = is_function(fun(_) -> ok end, 1),
  733:     ?line false = is_function(fun(_) -> ok end, 0),
  734: 
  735:     ?line true = is_function(fun erlang:abs/1, 1),
  736:     ?line true = is_function(fun erlang:abs/99, 99),
  737:     ?line false = is_function(fun erlang:abs/1, 0),
  738:     ?line false = is_function(fun erlang:abs/99, 0),
  739: 
  740:     ?line false = is_function(id(self()), 0),
  741:     ?line false = is_function(id({a,b,c}), 0),
  742:     ?line false = is_function(id({a}), 0),
  743:     ?line false = is_function(id([a,b,c]), 0),
  744: 
  745:     %% Bad arity argument.
  746:     ?line bad_arity(a),
  747:     ?line bad_arity(-1),
  748:     ?line bad_arity(-9738974938734938793873498378),
  749:     ?line bad_arity([]),
  750:     ?line bad_arity(fun() -> ok end),
  751:     ?line bad_arity({}),
  752:     ?line bad_arity({a,b}),
  753:     ?line bad_arity(self()),
  754:     ok.
  755: 
  756: bad_arity(A) ->
  757:     {'EXIT',_} = (catch is_function(fun() -> ok end, A)),
  758:     {'EXIT',_} = (catch is_function(no_fun, A)),
  759:     ok.
  760: 
  761: t_fun_info(Config) when is_list(Config) ->
  762:     ?line F = fun t_fun_info/1,
  763:     ?line try F(blurf) of
  764: 	      FAny ->
  765: 		  io:format("should fail; returned ~p\n", [FAny]),
  766: 		  ?line ?t:fail()
  767: 	  catch
  768: 	      error:function_clause -> ok
  769: 	  end,
  770:     ?line {module,?MODULE} = erlang:fun_info(F, module),
  771:     ?line case erlang:fun_info(F, name) of
  772: 	      undefined ->
  773: 		  ?line ?t:fail();
  774: 	      _ -> ok
  775: 	  end,
  776:     ?line {arity,1} = erlang:fun_info(F, arity),
  777:     ?line {env,[]} = erlang:fun_info(F, env),
  778:     ?line verify_not_undef(F, index),
  779:     ?line verify_not_undef(F, uniq),
  780:     ?line verify_not_undef(F, new_index),
  781:     ?line verify_not_undef(F, new_uniq),
  782:     ?line verify_not_undef(F, refc),
  783:     ?line {'EXIT',_} = (catch erlang:fun_info(F, blurf)),    
  784: 
  785:     %% Module fun.
  786:     ?line FF = fun ?MODULE:t_fun_info/1,
  787:     ?line try FF(blurf) of
  788: 	      FFAny ->
  789: 		  io:format("should fail; returned ~p\n", [FFAny]),
  790: 		  ?line ?t:fail()
  791: 	  catch
  792: 	      error:function_clause -> ok
  793: 	  end,
  794: 
  795:     ?line {module,?MODULE} = erlang:fun_info(FF, module),
  796:     ?line {name,t_fun_info} = erlang:fun_info(FF, name),
  797:     ?line {arity,1} = erlang:fun_info(FF, arity),
  798:     ?line {env,[]} = erlang:fun_info(FF, env),
  799:     ?line verify_undef(FF, index),
  800:     ?line verify_undef(FF, uniq),
  801:     ?line verify_undef(FF, new_index),
  802:     ?line verify_undef(FF, new_uniq),
  803:     ?line verify_undef(FF, refc),
  804:     ?line {'EXIT',_} = (catch erlang:fun_info(FF, blurf)),
  805: 
  806:     %% Not fun.
  807:     ?line bad_info(abc),
  808:     ?line bad_info(42),
  809:     ?line bad_info({fun erlang:list_to_integer/1}),
  810:     ?line bad_info([42]),
  811:     ?line bad_info([]),
  812:     ?line bad_info(self()),
  813:     ?line bad_info(<<>>),
  814:     ?line bad_info(<<1,2>>),
  815:     ok.
  816: 
  817: bad_info(Term) ->
  818:     try	erlang:fun_info(Term, module) of
  819: 	Any ->
  820: 	    io:format("should fail; returned ~p\n", [Any]),
  821: 	    ?t:fail()
  822:     catch
  823: 	error:badarg -> ok
  824:     end.
  825: 
  826: verify_undef(Fun, Tag) ->
  827:     {Tag,undefined} = erlang:fun_info(Fun, Tag).
  828: 
  829: verify_not_undef(Fun, Tag) ->
  830:     case erlang:fun_info(Fun, Tag) of
  831: 	{Tag,undefined} ->
  832: 	    ?t:fail();
  833: 	{Tag,_} -> ok
  834:     end.
  835: 	    
  836: id(X) ->
  837:     X.
  838: 
  839: spawn_call(Node, AFun) ->
  840:     Pid = spawn_link(Node,
  841: 		     fun() ->
  842: 			     receive
  843: 				 {Fun,Fun,Fun} when is_function(Fun) ->
  844: 				     Arity = fun_arity(Fun),
  845: 				     Args = case Arity of
  846: 						0 -> [];
  847: 						_ -> lists:seq(0, Arity-1)
  848: 					    end,
  849: 				     Res = apply(Fun, Args),
  850: 				     {pid,Creator} = erlang:fun_info(Fun, pid),
  851: 				     Creator ! {result,Res}
  852: 			     end
  853: 		     end),
  854:     Pid ! {AFun,AFun,AFun},
  855:     Res = receive
  856: 	      {result,R} -> R;
  857: 	      Other -> ?t:fail({bad_message,Other})
  858: 	  after 10000 ->
  859: 		  ?t:fail(timeout_waiting_for_result)
  860: 	  end,
  861:     receive
  862: 	{'EXIT',Pid,normal} -> ok;
  863: 	Other2 -> ?t:fail({bad_message_waiting_for_exit,Other2})
  864:     after 10000 ->
  865: 	    ?t:fail(timeout_waiting_for_exit)
  866:     end,
  867:     Res.
  868: 
  869: fun_arity(F) ->
  870:     {arity,Arity} = erlang:fun_info(F, arity),
  871:     Arity.
  872: 
  873: start_node(Name) ->
  874:     Pa = filename:dirname(code:which(?MODULE)),
  875:     Cookie = atom_to_list(erlang:get_cookie()),
  876:     test_server:start_node(Name, slave, 
  877: 			   [{args, "-setcookie " ++ Cookie ++" -pa " ++ Pa}]).
  878: 
  879: wait_until(Fun) ->
  880:     case catch Fun() of
  881: 	true -> ok;
  882: 	_ -> receive after 100 -> wait_until(Fun) end
  883:     end.
  884: 
  885: % stop_node(Node) ->
  886: %    test_server:stop_node(Node).