diff options
Diffstat (limited to 'lib/stdlib/test/id_transform_SUITE.erl')
| -rw-r--r-- | lib/stdlib/test/id_transform_SUITE.erl | 398 |
1 files changed, 398 insertions, 0 deletions
diff --git a/lib/stdlib/test/id_transform_SUITE.erl b/lib/stdlib/test/id_transform_SUITE.erl new file mode 100644 index 0000000000..95ee509833 --- /dev/null +++ b/lib/stdlib/test/id_transform_SUITE.erl @@ -0,0 +1,398 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(id_transform_SUITE). +-author('[email protected]'). + +-include_lib("kernel/include/file.hrl"). + +-export([all/1, + id_transform/1]). + +-export([check/2,check2/1,g/0,f/1,t/1,t1/1,t2/1,t3/1,t4/1, + t5/1,t6/1,apa/1,new_fun/0]). + +% Serves as test... +-hej(hopp). +-include("test_server.hrl"). + +all(suite) -> [id_transform]. + +id_transform(doc) -> "Test erl_id_trans."; +id_transform(Config) when is_list(Config) -> + ?line File=filename:join([code:lib_dir(stdlib),"examples", + "erl_id_trans.erl"]), + ?line {ok,erl_id_trans,Bin}=compile:file(File,[binary]), + ?line {module,erl_id_trans}=code:load_binary(erl_id_trans,File,Bin), + ?line case test_server:purify_is_running() of + false -> + Dog = ?t:timetrap(?t:hours(1)), + ?line Res = run_in_test_suite(), + ?t:timetrap_cancel(Dog), + Res; + true -> + {skip,"Purify (too slow)"} + end. + +run_in_test_suite() -> + LibDir = code:lib_dir(), + SuperDir = filename:dirname(filename:dirname(code:which(?MODULE))), + TestDirs = filelib:wildcard(filename:join([SuperDir,"*_test"])), + {All,Res} = case LibDir of + "/clearcase/otp/erts/lib" -> + %% Only test_suites 'cause clearcase is too slow... + {false,run_list(TestDirs)}; + _ -> + {true,run_codepath_and(TestDirs)} + end, + Comment0 = case All of + true -> []; + false -> "Only testsuite directories traversed" + end, + case Res of + {error,Reason} when Comment0 =/= [] -> + {failed,Comment0++"; "++Reason}; + {error,Reason} -> + {failed,Reason}; + ok -> + {comment,Comment0} + end. + +run_codepath_and(DirList) -> + AbsDirs = [filename:absname(X) || X <- code:get_path()], + run_list(ordsets:from_list([X || X <- AbsDirs] ++ DirList)). + +run_list(PathL) -> + io:format("Where to search for beam files:\n~p\n", [PathL]), + io:format("Searching for beam files ...~n",[]), + Beams = collect_beams(PathL, []), + io:format("~p beam files\n", [length(Beams)]), + io:format("Applying erl_id_trans to found beam files...~n",[]), + Res = [do_trans(X) || X <- Beams], + io:format("...done~n",[]), + Successes = [X || {ok,X} <- Res], + SevereFailures = [{F,E} || {failed,{F,{transform,E}}} <- Res], + BeamLib = [{F,E} || {failed,{F,{beam_lib,E}}} <- Res], + io:format("~p files processed", [length(Res)]), + io:format("~p files successfully transformed", [length(Successes)]), + case length(SevereFailures) of + 0 -> ok; + SevLen -> + io:format("\n~p severe failures:\n~p", + [SevLen,SevereFailures]) + end, + case BeamLib of + [] -> ok; + _ -> io:format("\nbeam_lib failures:\n~p", [BeamLib]) + end, + case length(SevereFailures) of + 0 -> ok; + Len -> {error,integer_to_list(Len)++" failures"} + end. + + +collect_beams([P0|Ps], Acc) -> + Wc = filename:join(filename:absname(P0), "*.beam"), + collect_beams(Ps, filelib:wildcard(Wc)++Acc); +collect_beams([], Acc) -> Acc. + +do_trans(Beam) -> + case beam_lib:chunks(Beam, [abstract_code]) of + {ok,{_Mod,[{abstract_code,no_abstract_code}]}} -> + {failed,{Beam,{beam_lib,no_debug_info}}}; + {ok,{_Mod,[{abstract_code,{raw_abstract_v1,Abst}}]}} -> + do_trans_1(Beam, Abst); + {ok,{_Mod,[{abstract_code,{Tag,_}}]}} -> + {failed,{Beam,{beam_lib,{wrong_type_of_debug_info,Tag}}}}; + {ok,{_Mod,[{abstract_code,_}]}} -> + {failed,{Beam,{beam_lib,unknown_type_of_debug_info}}}; + {error,beam_lib,{missing_chunk,_,_}} -> + {failed,{Beam,{beam_lib,no_debug_info}}}; + Error -> + {failed,{Beam,{beam_lib,Error}}} + end. + +do_trans_1(File, Tree0) -> + case catch erl_id_trans:parse_transform(Tree0, []) of + Tree0 when is_list(Tree0) -> + {ok,File}; + Tree when is_list(Tree) -> + {failed,{File,{transform,output_not_same_as_input}}}; + {'EXIT', Reason} -> + {failed,{File,{transform,{crash,Reason}}}}; + Else -> + {failed,{File,{transform,{unknown,Else}}}} + end. + +% From here on there's only fake code to serve as test cases +% for the id_transform. +% They need to be exported. + +check(X,_Y) when X -> + true; +check(A,_) when atom(A) -> + atom; +check(A,_) when erlang:is_list(A) -> + list; +check(A,B) when erlang:'+'(A,B) -> + atom; +check(_,_) -> + false. + +check2(A) -> + case A of + "hej" ++ "hopp" -> + a; + [$l,$e,$k] ++ "hopp" -> + a; + [1] ++ [2] -> + b + end. + +-record(x,{x,y}). +-record(y,{x=1,y=0}). + +g() -> + #y.y. + +f(#y.y) -> + vansinne; + +f(X) when X =:= #y.y -> + {#y.y,_Y} = {X,hej}; +f(#x{_='_'}) -> + hopp; +f(#x{x=true,y=true}) -> + babba; +f(A) when A == #x{x=true,y=true} -> + true; +f(A) when A#x.x == 4 -> + #x{x = 1, _ = 2}; +f(X) -> + if X#x.y -> + ok; + element(3,X) -> + banan; + true -> + nok + end. + +% Stolen from erl_lint_SUITE.erl +-record(apa, {}). + +t(A) when atom(A) -> + atom; +t(A) when binary(A) -> + binary; +t(A) when float(A) -> + float; +t(A) when function(A) -> + function; +t(A) when integer(A) -> + integer; +t(A) when is_atom(A) -> + is_atom; +t(A) when is_binary(A) -> + is_binary; +t(A) when is_float(A) -> + is_float; +t(A) when is_function(A) -> + is_function; +t(A) when is_integer(A) -> + is_integer; +t(A) when is_list(A) -> + is_list; +t(A) when is_number(A) -> + is_number; +t(A) when is_pid(A) -> + is_pid; +t(A) when is_port(A) -> + is_port; +t(A) when is_record(A, apa) -> + is_record; +t(A) when is_reference(A) -> + is_reference; +t(A) when is_tuple(A) -> + is_tuple; +t(A) when list(A) -> + list; +t(A) when number(A) -> + number; +t(A) when pid(A) -> + pid; +t(A) when port(A) -> + port; +t(A) when record(A, apa) -> + record; +t(A) when reference(A) -> + reference; +t(A) when tuple(A) -> + tuple. + +t1(A) when atom(A), atom(A) -> + atom; +t1(A) when binary(A), binary(A) -> + binary; +t1(A) when float(A), float(A) -> + float; +t1(A) when function(A), function(A) -> + function; +t1(A) when integer(A), integer(A) -> + integer; +t1(A) when is_atom(A), is_atom(A) -> + is_atom; +t1(A) when is_binary(A), is_binary(A) -> + is_binary; +t1(A) when is_float(A), is_float(A) -> + is_float; +t1(A) when is_function(A), is_function(A) -> + is_function; +t1(A) when is_integer(A), is_integer(A) -> + is_integer; +t1(A) when is_list(A), is_list(A) -> + is_list; +t1(A) when is_number(A), is_number(A) -> + is_number; +t1(A) when is_pid(A), is_pid(A) -> + is_pid; +t1(A) when is_port(A), is_port(A) -> + is_port; +t1(A) when is_record(A, apa), is_record(A, apa) -> + is_record; +t1(A) when is_reference(A), is_reference(A) -> + is_reference; +t1(A) when is_tuple(A), is_tuple(A) -> + is_tuple; +t1(A) when list(A), list(A) -> + list; +t1(A) when number(A), number(A) -> + number; +t1(A) when pid(A), pid(A) -> + pid; +t1(A) when port(A), port(A) -> + port; +t1(A) when record(A, apa), record(A, apa) -> + record; +t1(A) when reference(A), reference(A) -> + reference; +t1(A) when tuple(A), tuple(A) -> + tuple. + +t2(A) when atom(A); atom(A) -> + atom; +t2(A) when binary(A); binary(A) -> + binary; +t2(A) when float(A); float(A) -> + float; +t2(A) when function(A); function(A) -> + function; +t2(A) when integer(A); integer(A) -> + integer; +t2(A) when is_atom(A); is_atom(A) -> + is_atom; +t2(A) when is_binary(A); is_binary(A) -> + is_binary; +t2(A) when is_float(A); is_float(A) -> + is_float; +t2(A) when is_function(A); is_function(A) -> + is_function; +t2(A) when is_integer(A); is_integer(A) -> + is_integer; +t2(A) when is_list(A); is_list(A) -> + is_list; +t2(A) when is_number(A); is_number(A) -> + is_number; +t2(A) when is_pid(A); is_pid(A) -> + is_pid; +t2(A) when is_port(A); is_port(A) -> + is_port; +t2(A) when is_record(A, apa); is_record(A, apa) -> + is_record; +t2(A) when is_reference(A); is_reference(A) -> + is_reference; +t2(A) when is_tuple(A); is_tuple(A) -> + is_tuple; +t2(A) when list(A); list(A) -> + list; +t2(A) when number(A); number(A) -> + number; +t2(A) when pid(A); pid(A) -> + pid; +t2(A) when port(A); port(A) -> + port; +t2(A) when record(A, apa); record(A, apa) -> + record; +t2(A) when reference(A); reference(A) -> + reference; +t2(A) when tuple(A); tuple(A) -> + tuple. + +t3(A) when is_atom(A) or is_atom(A) -> + is_atom; +t3(A) when is_binary(A) or is_binary(A) -> + is_binary; +t3(A) when is_float(A) or is_float(A) -> + is_float; +t3(A) when is_function(A) or is_function(A) -> + is_function; +t3(A) when is_integer(A) or is_integer(A) -> + is_integer; +t3(A) when is_list(A) or is_list(A) -> + is_list; +t3(A) when is_number(A) or is_number(A) -> + is_number; +t3(A) when is_pid(A) or is_pid(A) -> + is_pid; +t3(A) when is_port(A) or is_port(A) -> + is_port; +t3(A) when is_record(A, apa) or is_record(A, apa) -> + is_record; +t3(A) when is_reference(A) or is_reference(A) -> + is_reference; +t3(A) when is_tuple(A) or is_tuple(A) -> + is_tuple; +t3(A) when record(A, apa) -> + foo; +t3(A) when {erlang,is_record}(A, apa) -> + foo; +t3(A) when erlang:is_record(A, apa) -> + foo; +t3(A) when is_record(A, apa) -> + foo; +t3(A) when record({apa}, apa) -> + {A,foo}. + +t4(_) when {erlang,is_record}({apa}, apa) -> + foo. + +t5(A) when erlang:is_record({apa}, apa) -> + {A,foo}. + +t6(A) when is_record({apa}, apa) -> + {A,foo}. + +-record(apa2,{a=a,b=foo:bar()}). +apa(1) -> + [X || X <- [], #apa2{a = a} == {r,X,foo}]; +apa(2) -> + [X || X <- [], #apa2{b = b} == {r,X,foo}]; +apa(3) -> + [X || X <- [], 3 == X#apa2.a]. + +new_fun() -> + lists:map(fun erlang:abs/1, [-1,3,4]). |