1: %%
    2: %% %CopyrightBegin%
    3: %% 
    4: %% Copyright Ericsson AB 2003-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: -module(id_transform_SUITE).
   20: -author('pan@erix.ericsson.se').
   21: 
   22: -include_lib("kernel/include/file.hrl").
   23:           
   24: -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
   25: 	 init_per_group/2,end_per_group/2,
   26: 	 id_transform/1]).
   27: 
   28: -export([check/2,check2/1,g/0,f/1,t/1,t1/1,t2/1,t3/1,t4/1,
   29: 	 t5/1,apa/1,new_fun/0]).
   30: 
   31: 						% Serves as test...
   32: -hej(hopp).
   33: -include_lib("test_server/include/test_server.hrl").
   34: 
   35: suite() -> [{ct_hooks,[ts_install_cth]}].
   36: 
   37: all() -> 
   38:     [id_transform].
   39: 
   40: groups() -> 
   41:     [].
   42: 
   43: init_per_suite(Config) ->
   44:     Config.
   45: 
   46: end_per_suite(_Config) ->
   47:     ok.
   48: 
   49: init_per_group(_GroupName, Config) ->
   50:     Config.
   51: 
   52: end_per_group(_GroupName, Config) ->
   53:     Config.
   54: 
   55: 
   56: id_transform(doc) -> "Test erl_id_trans.";
   57: id_transform(Config) when is_list(Config) ->
   58:     ?line File=filename:join([code:lib_dir(stdlib),"examples",
   59: 			      "erl_id_trans.erl"]),
   60:     ?line {ok,erl_id_trans,Bin}=compile:file(File,[binary]),
   61:     ?line {module,erl_id_trans}=code:load_binary(erl_id_trans,File,Bin),
   62:     ?line case test_server:purify_is_running() of
   63: 	      false ->
   64: 		  Dog = ct:timetrap(?t:hours(1)),
   65: 		  ?line Res = run_in_test_suite(),
   66: 		  ?t:timetrap_cancel(Dog),
   67: 		  Res;
   68: 	      true ->
   69: 		  {skip,"Purify (too slow)"}
   70: 	  end.
   71: 
   72: run_in_test_suite() ->
   73:     LibDir = code:lib_dir(),
   74:     SuperDir = filename:dirname(filename:dirname(code:which(?MODULE))),
   75:     TestDirs = filelib:wildcard(filename:join([SuperDir,"*_test"])),
   76:     {All,Res} = case LibDir of
   77: 		    "/clearcase/otp/erts/lib" ->
   78: 			%% Only test_suites 'cause clearcase is too slow...
   79: 			{false,run_list(TestDirs)};
   80: 		    _ ->
   81: 			{true,run_codepath_and(TestDirs)}
   82: 		end,
   83:     Comment0 = case All of
   84: 		   true -> [];
   85: 		   false -> "Only testsuite directories traversed"
   86: 	       end,
   87:     case Res of
   88: 	{error,Reason} when Comment0 =/= [] ->
   89: 	    {failed,Comment0++"; "++Reason};
   90: 	{error,Reason} ->
   91: 	    {failed,Reason};
   92: 	ok ->
   93: 	    {comment,Comment0}
   94:     end.
   95: 
   96: run_codepath_and(DirList) ->
   97:     AbsDirs = [filename:absname(X) || X <- code:get_path()],
   98:     run_list(ordsets:from_list([X || X <- AbsDirs] ++ DirList)).
   99: 
  100: run_list(PathL) ->
  101:     io:format("Where to search for beam files:\n~p\n", [PathL]),
  102:     io:format("Searching for beam files ...~n",[]),
  103:     Beams = collect_beams(PathL, []),
  104:     io:format("~p beam files\n", [length(Beams)]),
  105:     io:format("Applying erl_id_trans to found beam files...~n",[]),
  106:     Res = [do_trans(X) || X <- Beams],
  107:     io:format("...done~n",[]),
  108:     Successes = [X || {ok,X} <- Res],
  109:     SevereFailures = [{F,E} || {failed,{F,{transform,E}}} <- Res],
  110:     BeamLib = [{F,E} || {failed,{F,{beam_lib,E}}} <- Res],
  111:     io:format("~p files processed", [length(Res)]),
  112:     io:format("~p files successfully transformed", [length(Successes)]),
  113:     case length(SevereFailures) of
  114: 	0 -> ok;
  115: 	SevLen ->
  116: 	    io:format("\n~p severe failures:\n~p",
  117: 		      [SevLen,SevereFailures])
  118:     end,
  119:     case BeamLib of
  120: 	[] -> ok;
  121: 	_ -> io:format("\nbeam_lib failures:\n~p", [BeamLib])
  122:     end,
  123:     case length(SevereFailures) of
  124: 	0 -> ok;
  125: 	Len -> {error,integer_to_list(Len)++" failures"}
  126:     end.
  127:     
  128: 
  129: collect_beams([P0|Ps], Acc) ->
  130:     Wc = filename:join(filename:absname(P0), "*.beam"),
  131:     collect_beams(Ps, filelib:wildcard(Wc)++Acc);
  132: collect_beams([], Acc) -> Acc.
  133:     
  134: do_trans(Beam) ->
  135:     case beam_lib:chunks(Beam, [abstract_code]) of
  136: 	{ok,{_Mod,[{abstract_code,no_abstract_code}]}} ->
  137: 	    {failed,{Beam,{beam_lib,no_debug_info}}};
  138: 	{ok,{_Mod,[{abstract_code,{raw_abstract_v1,Abst}}]}} ->
  139: 	    do_trans_1(Beam, Abst);
  140: 	{ok,{_Mod,[{abstract_code,{Tag,_}}]}} ->
  141: 	    {failed,{Beam,{beam_lib,{wrong_type_of_debug_info,Tag}}}};
  142: 	{ok,{_Mod,[{abstract_code,_}]}} ->
  143: 	    {failed,{Beam,{beam_lib,unknown_type_of_debug_info}}};
  144: 	{error,beam_lib,{missing_chunk,_,_}} ->
  145: 	    {failed,{Beam,{beam_lib,no_debug_info}}};	    
  146: 	Error ->
  147: 	    {failed,{Beam,{beam_lib,Error}}}
  148:     end.
  149: 
  150: do_trans_1(File, Tree0) ->
  151:     case catch erl_id_trans:parse_transform(Tree0, []) of
  152: 	Tree0 when is_list(Tree0) ->
  153: 	    {ok,File};
  154: 	Tree when is_list(Tree) ->
  155: 	    {failed,{File,{transform,output_not_same_as_input}}};
  156: 	{'EXIT', Reason} ->
  157: 	    {failed,{File,{transform,{crash,Reason}}}};
  158: 	Else ->
  159: 	    {failed,{File,{transform,{unknown,Else}}}}
  160:     end.
  161: 
  162: % From here on there's only fake code to serve as test cases 
  163: % for the id_transform.
  164: % They need to be exported.
  165: 
  166: check(X,_Y) when X ->   
  167:     true;
  168: check(A,_) when atom(A) ->
  169:     atom;
  170: check(A,_) when erlang:is_list(A) ->
  171:     list;
  172: check(A,B) when erlang:'+'(A,B) ->
  173:     atom;
  174: check(_,_) ->
  175:     false.
  176: 
  177: check2(A) ->
  178:     case A of
  179: 	"hej" ++ "hopp" ->
  180: 	    a;
  181: 	[$l,$e,$k] ++ "hopp" ->
  182: 	    a;
  183: 	[1] ++ [2] ->
  184: 	    b
  185:     end.
  186: 
  187: -record(x,{x,y}).
  188: -record(y,{x=1,y=0}).
  189: 
  190: g() ->
  191:     #y.y.
  192: 
  193: f(#y.y) ->
  194:     vansinne;
  195: 
  196: f(X) when X =:= #y.y ->
  197:     {#y.y,_Y} = {X,hej};
  198: f(#x{_='_'}) ->
  199:     hopp;
  200: f(#x{x=true,y=true}) ->
  201:     babba;
  202: f(A) when A == #x{x=true,y=true} ->
  203:     true;
  204: f(A) when A#x.x == 4 ->
  205:     #x{x = 1, _ = 2};
  206: f(X) ->
  207:     if X#x.y ->
  208: 	    ok;
  209:        element(3,X) ->
  210: 	    banan;
  211:        true ->
  212: 	    nok
  213:     end.
  214: 
  215: % Stolen from erl_lint_SUITE.erl
  216: -record(apa, {}).
  217: 
  218: t(A) when atom(A) ->
  219:     atom;
  220: t(A) when binary(A) ->
  221:     binary;
  222: t(A) when float(A) ->
  223:     float;
  224: t(A) when function(A) ->
  225:     function;
  226: t(A) when integer(A) ->
  227:     integer;
  228: t(A) when is_atom(A) ->
  229:     is_atom;
  230: t(A) when is_binary(A) ->
  231:     is_binary;
  232: t(A) when is_float(A) ->
  233:     is_float;
  234: t(A) when is_function(A) ->
  235:     is_function;
  236: t(A) when is_integer(A) ->
  237:     is_integer;
  238: t(A) when is_list(A) ->
  239:     is_list;
  240: t(A) when is_number(A) ->
  241:     is_number;
  242: t(A) when is_pid(A) ->
  243:     is_pid;
  244: t(A) when is_port(A) ->
  245:     is_port;
  246: t(A) when is_record(A, apa) ->
  247:     is_record;
  248: t(A) when is_reference(A) ->
  249:     is_reference;
  250: t(A) when is_tuple(A) ->
  251:     is_tuple;
  252: t(A) when list(A) ->
  253:     list;
  254: t(A) when number(A) ->
  255:     number;
  256: t(A) when pid(A) ->
  257:     pid;
  258: t(A) when port(A) ->
  259:     port;
  260: t(A) when record(A, apa) ->
  261:     record;
  262: t(A) when reference(A) ->
  263:     reference;
  264: t(A) when tuple(A) ->
  265:     tuple.
  266: 
  267: t1(A) when atom(A), atom(A) ->
  268:     atom;
  269: t1(A) when binary(A), binary(A) ->
  270:     binary;
  271: t1(A) when float(A), float(A) ->
  272:     float;
  273: t1(A) when function(A), function(A) ->
  274:     function;
  275: t1(A) when integer(A), integer(A) ->
  276:     integer;
  277: t1(A) when is_atom(A), is_atom(A) ->
  278:     is_atom;
  279: t1(A) when is_binary(A), is_binary(A) ->
  280:     is_binary;
  281: t1(A) when is_float(A), is_float(A) ->
  282:     is_float;
  283: t1(A) when is_function(A), is_function(A) ->
  284:     is_function;
  285: t1(A) when is_integer(A), is_integer(A) ->
  286:     is_integer;
  287: t1(A) when is_list(A), is_list(A) ->
  288:     is_list;
  289: t1(A) when is_number(A), is_number(A) ->
  290:     is_number;
  291: t1(A) when is_pid(A), is_pid(A) ->
  292:     is_pid;
  293: t1(A) when is_port(A), is_port(A) ->
  294:     is_port;
  295: t1(A) when is_record(A, apa), is_record(A, apa) ->
  296:     is_record;
  297: t1(A) when is_reference(A), is_reference(A) ->
  298:     is_reference;
  299: t1(A) when is_tuple(A), is_tuple(A) ->
  300:     is_tuple;
  301: t1(A) when list(A), list(A) ->
  302:     list;
  303: t1(A) when number(A), number(A) ->
  304:     number;
  305: t1(A) when pid(A), pid(A) ->
  306:     pid;
  307: t1(A) when port(A), port(A) ->
  308:     port;
  309: t1(A) when record(A, apa), record(A, apa) ->
  310:     record;
  311: t1(A) when reference(A), reference(A) ->
  312:     reference;
  313: t1(A) when tuple(A), tuple(A) ->
  314:     tuple.
  315: 
  316: t2(A) when atom(A); atom(A) ->
  317:     atom;
  318: t2(A) when binary(A); binary(A) ->
  319:     binary;
  320: t2(A) when float(A); float(A) ->
  321:     float;
  322: t2(A) when function(A); function(A) ->
  323:     function;
  324: t2(A) when integer(A); integer(A) ->
  325:     integer;
  326: t2(A) when is_atom(A); is_atom(A) ->
  327:     is_atom;
  328: t2(A) when is_binary(A); is_binary(A) ->
  329:     is_binary;
  330: t2(A) when is_float(A); is_float(A) ->
  331:     is_float;
  332: t2(A) when is_function(A); is_function(A) ->
  333:     is_function;
  334: t2(A) when is_integer(A); is_integer(A) ->
  335:     is_integer;
  336: t2(A) when is_list(A); is_list(A) ->
  337:     is_list;
  338: t2(A) when is_number(A); is_number(A) ->
  339:     is_number;
  340: t2(A) when is_pid(A); is_pid(A) ->
  341:     is_pid;
  342: t2(A) when is_port(A); is_port(A) ->
  343:     is_port;
  344: t2(A) when is_record(A, apa); is_record(A, apa) ->
  345:     is_record;
  346: t2(A) when is_reference(A); is_reference(A) ->
  347:     is_reference;
  348: t2(A) when is_tuple(A); is_tuple(A) ->
  349:     is_tuple;
  350: t2(A) when list(A); list(A) ->
  351:     list;
  352: t2(A) when number(A); number(A) ->
  353:     number;
  354: t2(A) when pid(A); pid(A) ->
  355:     pid;
  356: t2(A) when port(A); port(A) ->
  357:     port;
  358: t2(A) when record(A, apa); record(A, apa) ->
  359:     record;
  360: t2(A) when reference(A); reference(A) ->
  361:     reference;
  362: t2(A) when tuple(A); tuple(A) ->
  363:     tuple.
  364: 
  365: t3(A) when is_atom(A) or is_atom(A) ->
  366:     is_atom;
  367: t3(A) when is_binary(A) or is_binary(A) ->
  368:     is_binary;
  369: t3(A) when is_float(A) or is_float(A) ->
  370:     is_float;
  371: t3(A) when is_function(A) or is_function(A) ->
  372:     is_function;
  373: t3(A) when is_integer(A) or is_integer(A) ->
  374:     is_integer;
  375: t3(A) when is_list(A) or is_list(A) ->
  376:     is_list;
  377: t3(A) when is_number(A) or is_number(A) ->
  378:     is_number;
  379: t3(A) when is_pid(A) or is_pid(A) ->
  380:     is_pid;
  381: t3(A) when is_port(A) or is_port(A) ->
  382:     is_port;
  383: t3(A) when is_record(A, apa) or is_record(A, apa) ->
  384:    is_record;
  385: t3(A) when is_reference(A) or is_reference(A) ->
  386:    is_reference;
  387: t3(A) when is_tuple(A) or is_tuple(A) ->
  388:    is_tuple; 
  389: t3(A) when record(A, apa) ->
  390:    foo;
  391: t3(A) when erlang:is_record(A, apa) ->
  392:    foo;
  393: t3(A) when is_record(A, apa) ->
  394:    foo;
  395: t3(A) when record({apa}, apa) ->
  396:    {A,foo}.
  397: 
  398: t4(A) when erlang:is_record({apa}, apa) ->
  399:    {A,foo}.
  400: 
  401: t5(A) when is_record({apa}, apa) ->
  402:    {A,foo}.
  403: 
  404: -record(apa2,{a=a,b=foo:bar()}).
  405: apa(1) ->
  406:     [X || X <- [], #apa2{a = a} == {r,X,foo}];
  407: apa(2) ->
  408:     [X || X <- [], #apa2{b = b} == {r,X,foo}];
  409: apa(3) ->
  410:     [X || X <- [], 3 == X#apa2.a].
  411: 
  412: new_fun() ->
  413:     lists:map(fun erlang:abs/1, [-1,3,4]).