The R13B03 release.OTP_R13B03

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]).