%%
%% %CopyrightBegin%
%%
%% Copyright Ericsson AB 2003-2010. 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(ms_transform_SUITE).
-author('[email protected]').
-include_lib("test_server/include/test_server.hrl").
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2]).
-export([basic_ets/1]).
-export([basic_dbg/1]).
-export([from_shell/1]).
-export([records/1]).
-export([record_index/1]).
-export([multipass/1]).
-export([top_match/1]).
-export([old_guards/1]).
-export([autoimported/1]).
-export([semicolon/1]).
-export([bitsyntax/1]).
-export([record_defaults/1]).
-export([andalso_orelse/1]).
-export([float_1_function/1]).
-export([action_function/1]).
-export([warnings/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
init_per_testcase(_Func, Config) ->
Dog=test_server:timetrap(test_server:seconds(360)),
[{watchdog, Dog}|Config].
end_per_testcase(_Func, Config) ->
Dog=?config(watchdog, Config),
test_server:timetrap_cancel(Dog).
suite() -> [{suite_callbacks,[ts_install_scb]}].
all() ->
[from_shell, basic_ets, basic_dbg, records,
record_index, multipass, bitsyntax, record_defaults,
andalso_orelse, float_1_function, action_function,
warnings, top_match, old_guards, autoimported,
semicolon].
groups() ->
[].
init_per_suite(Config) ->
Config.
end_per_suite(_Config) ->
ok.
init_per_group(_GroupName, Config) ->
Config.
end_per_group(_GroupName, Config) ->
Config.
%% This may be subject to change
-define(WARN_NUMBER_SHADOW,50).
warnings(suite) ->
[];
warnings(doc) ->
["Check that shadowed variables in fun head generate warning"];
warnings(Config) when is_list(Config) ->
?line setup(Config),
Prog = <<"A=5, "
"ets:fun2ms(fun({A,B}) "
" when is_integer(A) and (A+5 > B) -> "
" A andalso B "
" end)">>,
?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}}]}] =
compile_ww(Prog),
Prog2 = <<"C=5, "
"ets:fun2ms(fun({A,B} = C) "
" when is_integer(A) and (A+5 > B) -> "
" {A andalso B,C} "
" end)">>,
?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] =
compile_ww(Prog2),
Rec3 = <<"-record(a,{a,b,c,d=foppa}).">>,
Prog3 = <<"A=3,C=5, "
"ets:fun2ms(fun(#a{a = A, b = B} = C) "
" when is_integer(A) and (A+5 > B) -> "
" {A andalso B,C} "
" end)">>,
?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}},
{_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] =
compile_ww(Rec3,Prog3),
Rec4 = <<"-record(a,{a,b,c,d=foppa}).">>,
Prog4 = <<"A=3,C=5, "
"F = fun(B) -> B*3 end,"
"erlang:display(F(A)),"
"ets:fun2ms(fun(#a{a = A, b = B} = C) "
" when is_integer(A) and (A+5 > B) -> "
" {A andalso B,C} "
" end)">>,
?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}},
{_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] =
compile_ww(Rec4,Prog4),
Rec5 = <<"-record(a,{a,b,c,d=foppa}).">>,
Prog5 = <<"A=3,C=5, "
"F = fun(B) -> B*3 end,"
"erlang:display(F(A)),"
"B = ets:fun2ms(fun(#a{a = A, b = B} = C) "
" when is_integer(A) and (A+5 > B) -> "
" {A andalso B,C} "
" end)">>,
?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}},
{_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] =
compile_ww(Rec5,Prog5),
Prog6 = <<" X=bar, "
" A = case X of"
" foo ->"
" foo;"
" Y ->"
" ets:fun2ms(fun(Y) ->" % This is a warning
" 3*Y"
" end)"
" end,"
" ets:fun2ms(fun(Y) ->" % Y out of "scope" here, so no warning
" {3*Y,A}"
" end)">>,
?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'Y'}}]}] =
compile_ww(Prog6),
Prog7 = <<" X=bar, "
" A = case X of"
" foo ->"
" Y = foo;"
" Y ->"
" bar"
" end,"
" ets:fun2ms(fun(Y) ->" % Y exported from case and safe, so warn
" {3*Y,A}"
" end)">>,
?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'Y'}}]}] =
compile_ww(Prog7),
ok.
andalso_orelse(suite) ->
[];
andalso_orelse(doc) ->
["Tests that andalso and orelse are allowed in guards."];
andalso_orelse(Config) when is_list(Config) ->
?line setup(Config),
?line [{{'$1','$2'},
[{'and',{is_integer,'$1'},{'>',{'+','$1',5},'$2'}}],
[{'andalso','$1','$2'}]}] =
compile_and_run(<<"ets:fun2ms(fun({A,B}) "
" when is_integer(A) and (A+5 > B) -> "
" A andalso B "
" end)">>),
?line [{{'$1','$2'},
[{'or',{is_atom,'$1'},{'>',{'+','$1',5},'$2'}}],
[{'orelse','$1','$2'}]}] =
compile_and_run(<<"ets:fun2ms(fun({A,B}) "
" when is_atom(A) or (A+5 > B) -> "
" A orelse B "
" end)">>),
?line [{{'$1','$2'},
[{'andalso',{is_integer,'$1'},{'>',{'+','$1',5},'$2'}}],
['$1']}] =
compile_and_run(
<<"ets:fun2ms(fun({A,B}) when is_integer(A) andalso (A+5 > B) ->"
" A "
" end)">>),
?line [{{'$1','$2'},
[{'orelse',{is_atom,'$1'},{'>',{'+','$1',5},'$2'}}],
['$1']}] =
compile_and_run(
<<"ets:fun2ms(fun({A,B}) when is_atom(A) orelse (A+5 > B) -> "
" A "
" end)">>),
ok.
bitsyntax(suite) ->
[];
bitsyntax(doc) ->
["Tests that bitsyntax works and does not work where appropriate"];
bitsyntax(Config) when is_list(Config) ->
?line setup(Config),
?line [{'_',[],
[<<0,27,0,27>>]}] =
compile_and_run(<<"A = 27, "
"ets:fun2ms(fun(_) -> <<A:16,27:16>> end)">>),
?line [{{<<15,47>>,
'$1',
'$2'},
[{'=:=','$1',
<<0,27>>},
{'=:=','$2',
<<27,28,19>>}],
[<<188,0,13>>]}] =
compile_and_run(<<"A = 27, "
"ets:fun2ms("
" fun({<<15,47>>,B,C}) "
" when B =:= <<A:16>>, C =:= <<27,28,19>> -> "
" <<A:4,12:4,13:16>> "
" end)">>),
?line expect_failure(
<<>>,
<<"ets:fun2ms(fun({<<15,47>>,B,C}) "
" when B =:= <<16>>, C =:= <<27,28,19>> -> "
" <<B:4,12:4,13:16>> "
" end)">>),
?line expect_failure(
<<>>,
<<"ets:fun2ms(fun({<<A:15,47>>,B,C}) "
" when B =:= <<16>>, C =:= <<27,28,19>> -> "
" <<B:4,12:4,13:16>> "
" end)">>),
ok.
record_defaults(suite) ->
[];
record_defaults(doc) ->
["Tests that record defaults works"];
record_defaults(Config) when is_list(Config) ->
?line setup(Config),
?line [{{<<27>>,{a,5,'$1',hej,hej}},
[],
[{{a,hej,{'*','$1',2},flurp,flurp}}]}] =
compile_and_run(<<"-record(a,{a,b,c,d=foppa}).">>,
<<"ets:fun2ms(fun({<<27>>,#a{a=5, b=B,_=hej}}) -> "
"#a{a=hej,b=B*2,_=flurp} "
"end)">>),
ok.
basic_ets(suite) ->
[];
basic_ets(doc) ->
["Tests basic ets:fun2ms"];
basic_ets(Config) when is_list(Config) ->
?line setup(Config),
?line [{{a,b},[],[true]}] = compile_and_run(
<<"ets:fun2ms(fun({a,b}) -> true end)">>),
?line [{{'$1',foo},[{is_list,'$1'}],[{{{hd,'$1'},'$_'}}]},
{{'$1','$1'},[{is_tuple,'$1'}],[{{{element,1,'$1'},'$*'}}]}] =
compile_and_run(<<"ets:fun2ms(fun({X,foo}) when is_list(X) -> ",
"{hd(X),object()};",
"({X,X}) when is_tuple(X) ->",
"{element(1,X),bindings()}",
"end)">>),
?line [{{'$1','$2'},[],[{{'$2','$1'}}]}] =
compile_and_run(<<"ets:fun2ms(fun({A,B}) -> {B,A} end)">>),
?line [{{'$1','$2'},[],[['$2','$1']]}] =
compile_and_run(<<"ets:fun2ms(fun({A,B}) -> [B,A] end)">>),
ok.
basic_dbg(suite) ->
[];
basic_dbg(doc) ->
["Tests basic ets:fun2ms"];
basic_dbg(Config) when is_list(Config) ->
?line setup(Config),
?line [{[a,b],[],[{message,banan},{return_trace}]}] =
compile_and_run(<<"dbg:fun2ms(fun([a,b]) -> message(banan), ",
"return_trace() end)">>),
?line [{['$1','$2'],[],[{{'$2','$1'}}]}] =
compile_and_run(<<"dbg:fun2ms(fun([A,B]) -> {B,A} end)">>),
?line [{['$1','$2'],[],[['$2','$1']]}] =
compile_and_run(<<"dbg:fun2ms(fun([A,B]) -> [B,A] end)">>),
?line [{['$1','$2'],[],['$*']}] =
compile_and_run(<<"dbg:fun2ms(fun([A,B]) -> bindings() end)">>),
?line [{['$1','$2'],[],['$_']}] =
compile_and_run(<<"dbg:fun2ms(fun([A,B]) -> object() end)">>),
ok.
from_shell(suite) ->
[];
from_shell(doc) ->
["Test calling of ets/dbg:fun2ms from the shell"];
from_shell(Config) when is_list(Config) ->
?line setup(Config),
?line Fun = do_eval("fun({a,b}) -> true end"),
?line [{{a,b},[],[true]}] = apply(ets,fun2ms,[Fun]),
?line [{{a,b},[],[true]}] = do_eval("ets:fun2ms(fun({a,b}) -> true end)"),
?line Fun2 = do_eval("fun([a,b]) -> message(banan), return_trace() end"),
?line [{[a,b],[],[{message,banan},{return_trace}]}]
= apply(dbg,fun2ms,[Fun2]),
?line [{[a,b],[],[{message,banan},{return_trace}]}] =
do_eval(
"dbg:fun2ms(fun([a,b]) -> message(banan), return_trace() end)"),
ok.
records(suite) ->
[];
records(doc) ->
["Tests expansion of records in fun2ms"];
records(Config) when is_list(Config) ->
?line setup(Config),
?line RD = <<"-record(t, {"
"t1 = [],"
"t2 = foo,"
"t3,"
"t4"
"}).">>,
?line [{{t,'$1','$2',foo,'_'},[{is_list,'$1'}],[{{{hd,'$1'},'$_'}}]},
{{t,'_','_','_','_'},[{'==',{element,2,'$_'},nisse}],[{{'$*'}}]}] =
compile_and_run(RD,<<
"ets:fun2ms(fun(#t{t1 = X, t2 = Y, t3 = foo}) when is_list(X) ->
{hd(X),object()};
(#t{}) when (object())#t.t1 == nisse ->
{bindings()}
end)">>),
?line [{{t,'$1','$2','_',foo},
[{'==',{element,4,'$_'},7},{is_list,'$1'}],
[{{{hd,'$1'},'$_'}}]},
{'$1',[{is_record,'$1',t,5}],
[{{{element,2,'$1'},
{{t,'$1',foo,undefined,undefined}},
{{t,{element,2,'$1'},{element,3,'$1'},{element,4,'$1'},boooo}}}}]}] =
compile_and_run(RD,<<
"ets:fun2ms(fun(#t{t1 = X, t2 = Y, t4 = foo}) when
(object())#t.t3==7,is_list(X) ->
{hd(X),object()};
(A) when is_record(A,t) ->
{A#t.t1
,#t{t1=A}
,A#t{t4=boooo}
}
end)"
>>),
?line [{[{t,'$1','$2',foo,'_'}],[{is_list,'$1'}],[{{{hd,'$1'},'$_'}}]},
{[{t,'_','_','_','_'}],[{'==',{element,2,{hd,'$_'}},nisse}],[{{'$*'}}]}]=
compile_and_run(RD,<<
"dbg:fun2ms(fun([#t{t1 = X, t2 = Y, t3 = foo}]) when is_list(X) ->
{hd(X),object()};
([#t{}]) when (hd(object()))#t.t1 == nisse ->
{bindings()}
end)"
>>),
ok.
record_index(suite) ->
[];
record_index(doc) ->
["Tests expansion of records in fun2ms, part 2"];
record_index(Config) when is_list(Config) ->
?line setup(Config),
?line RD = <<"-record(a,{a,b}).">>,
?line [{{2},[],[true]}] = compile_and_run(RD,
<<"ets:fun2ms(fun({#a.a}) -> true end)">>),
?line [{{2},[],[2]}] = compile_and_run(RD,
<<"ets:fun2ms(fun({#a.a}) -> #a.a end)">>),
?line [{{2,'$1'},[{'>','$1',2}],[2]}] = compile_and_run(RD,
<<"ets:fun2ms(fun({#a.a,A}) when A > #a.a -> #a.a end)">>),
ok.
top_match(suite) ->
[];
top_match(doc) ->
["Tests matching on top level in head to give alias for object()"];
top_match(Config) when is_list(Config) ->
?line setup(Config),
?line RD = <<"-record(a,{a,b}).">>,
?line [{{a,3,'_'},[],['$_']}] =
compile_and_run(RD,
<<"ets:fun2ms(fun(A = #a{a=3}) -> A end)">>),
?line [{{a,3,'_'},[],['$_']}] =
compile_and_run(RD,
<<"ets:fun2ms(fun(#a{a=3} = A) -> A end)">>),
?line [{[a,b],[],['$_']}] =
compile_and_run(RD,
<<"dbg:fun2ms(fun(A = [a,b]) -> A end)">>),
?line [{[a,b],[],['$_']}] =
compile_and_run(RD,
<<"dbg:fun2ms(fun([a,b] = A) -> A end)">>),
?line expect_failure(RD,
<<"ets:fun2ms(fun({a,A = {_,b}}) -> A end)">>),
?line expect_failure(RD,
<<"dbg:fun2ms(fun([a,A = {_,b}]) -> A end)">>),
?line expect_failure(RD,
<<"ets:fun2ms(fun(A#a{a = 2}) -> A end)">>),
ok.
multipass(suite) ->
[];
multipass(doc) ->
["Tests that multi-defined fields in records give errors."];
multipass(Config) when is_list(Config) ->
?line setup(Config),
?line RD = <<"-record(a,{a,b}).">>,
?line expect_failure(RD,<<"ets:fun2ms(fun(A) -> #a{a=2,a=3} end)">>),
?line expect_failure(RD,<<"ets:fun2ms(fun(A) -> A#a{a=2,a=3} end)">>),
?line expect_failure(RD,<<"ets:fun2ms(fun(A) when A =:= #a{a=2,a=3} ->",
" true end)">>),
?line expect_failure(RD,<<"ets:fun2ms(fun({A,B})when A =:= B#a{a=2,a=3}->",
"true end)">>),
?line expect_failure(RD,<<"ets:fun2ms(fun(#a{a=3,a=3}) -> true end)">>),
?line compile_and_run(RD,<<"ets:fun2ms(fun(A) -> #a{a=2,b=3} end)">>),
?line compile_and_run(RD,<<"ets:fun2ms(fun(A) -> A#a{a=2,b=3} end)">>),
?line compile_and_run(RD,<<"ets:fun2ms(fun(A) when A =:= #a{a=2,b=3} ->",
" true end)">>),
?line compile_and_run(RD,<<"ets:fun2ms(fun({A,B})when A=:= B#a{a=2,b=3}->",
"true end)">>),
?line compile_and_run(RD,<<"ets:fun2ms(fun(#a{a=3,b=3}) -> true end)">>),
ok.
old_guards(suite) ->
[];
old_guards(doc) ->
["Tests that old type tests in guards are translated"];
old_guards(Config) when is_list(Config) ->
?line setup(Config),
Tests = [
{atom,is_atom},
{constant,is_constant},
{float,is_float},
{integer,is_integer},
{list,is_list},
{number,is_number},
{pid,is_pid},
{port,is_port},
{reference,is_reference},
{tuple,is_tuple},
{binary,is_binary},
{function,is_function}],
?line lists:foreach(
fun({Old,New}) ->
Bin = list_to_binary([<<"ets:fun2ms(fun(X) when ">>,
atom_to_list(Old),
<<"(X) -> true end)">>]),
case compile_and_run(Bin) of
[{'$1',[{New,'$1'}],[true]}] ->
ok;
_ ->
exit({bad_result_for, binary_to_list(Bin)})
end
end,
Tests),
?line RD = <<"-record(a,{a,b}).">>,
?line [{'$1',[{is_record,'$1',a,3}],[true]}] =
compile_and_run(RD,
<<"ets:fun2ms(fun(X) when record(X,a) -> true end)">>),
?line expect_failure
(RD,
<<"ets:fun2ms(fun(X) when integer(X) and constant(X) -> "
"true end)">>),
?line [{'$1',[{is_integer,'$1'},
{is_float,'$1'},
{is_atom,'$1'},
{is_constant,'$1'},
{is_list,'$1'},
{is_number,'$1'},
{is_pid,'$1'},
{is_port,'$1'},
{is_reference,'$1'},
{is_tuple,'$1'},
{is_binary,'$1'},
{is_record,'$1',a,3}],
[true]}] =
compile_and_run(RD, <<
"ets:fun2ms(fun(X) when integer(X),"
"float(X), atom(X), constant(X),"
"list(X), number(X), pid(X),"
"port(X), reference(X), tuple(X),"
"binary(X), record(X,a) -> true end)"
>>),
ok.
autoimported(suite) ->
[];
autoimported(doc) ->
["Tests use of autoimported bif's used like erlang:'+'(A,B) in guards"
" and body."];
autoimported(Config) when is_list(Config) ->
?line setup(Config),
Allowed = [
{abs,1},
{element,2},
{hd,1},
{length,1},
{node,0},
{node,1},
{round,1},
{size,1},
{tl,1},
{trunc,1},
{self,0},
%{float,1}, see float_1_function/1
{is_atom,1},
{is_constant,1},
{is_float,1},
{is_integer,1},
{is_list,1},
{is_number,1},
{is_pid,1},
{is_port,1},
{is_reference,1},
{is_tuple,1},
{is_binary,1},
{is_function,1},
{is_record,2,magic},
{'and',2,infix},
{'or',2,infix},
{'xor',2,infix},
{'not',1},
%{'andalso',2,infix},
%{'orelse',2,infix},
{'+',1},
{'+',2,infix},
{'-',1},
{'-',2,infix},
{'*',2,infix},
{'/',2,infix},
{'div',2,infix},
{'rem',2,infix},
{'band',2,infix},
{'bor',2,infix},
{'bxor',2,infix},
{'bnot',1},
{'bsl',2,infix},
{'bsr',2,infix},
{'>',2,infix},
{'>=',2,infix},
{'<',2,infix},
{'=<',2,infix},
{'==',2,infix},
{'=:=',2,infix},
{'/=',2,infix},
{'=/=',2,infix}],
?line RD = <<"-record(a,{a,b}).">>,
?line lists:foreach(
fun({A,0}) ->
L = atom_to_list(A),
Bin1 = list_to_binary(
[
<<"ets:fun2ms(fun(X) when ">>,
L,<<"() -> ">>,
L,<<"() end)">>
]),
Bin2 = list_to_binary(
[
<<"ets:fun2ms(fun(X) when erlang:'">>,
L,<<"'() -> erlang:'">>,
L,<<"'() end)">>
]),
Res1 = compile_and_run(Bin1),
Res2 = compile_and_run(Bin2),
case Res1 =:= Res2 of
true ->
ok;
false ->
exit({not_equal,{Res1,Res2,A}})
end;
({A,1}) ->
L = atom_to_list(A),
Bin1 = list_to_binary(
[
<<"ets:fun2ms(fun(X) when ">>,
L,<<"(X) -> ">>,
L,<<"(X) end)">>
]),
Bin2 = list_to_binary(
[
<<"ets:fun2ms(fun(X) when erlang:'">>,
L,<<"'(X) -> erlang:'">>,
L,<<"'(X) end)">>
]),
Res1 = compile_and_run(Bin1),
Res2 = compile_and_run(Bin2),
case Res1 =:= Res2 of
true ->
ok;
false ->
exit({not_equal,{Res1,Res2,A}})
end;
({A,2}) ->
L = atom_to_list(A),
Bin1 = list_to_binary(
[
<<"ets:fun2ms(fun({X,Y}) when ">>,
L,<<"(X,Y) -> ">>,
L,<<"(X,Y) end)">>
]),
Bin2 = list_to_binary(
[
<<"ets:fun2ms(fun({X,Y}) when erlang:'">>,
L,<<"'(X,Y) -> erlang:'">>,
L,<<"'(X,Y) end)">>
]),
Res1 = compile_and_run(Bin1),
Res2 = compile_and_run(Bin2),
case Res1 =:= Res2 of
true ->
ok;
false ->
exit({not_equal,{Res1,Res2,A}})
end;
({A,2,infix}) ->
L = atom_to_list(A),
Bin1 = list_to_binary(
[
<<"ets:fun2ms(fun({X,Y}) when X ">>,
L,<<" Y -> X ">>,
L,<<" Y end)">>
]),
Bin2 = list_to_binary(
[
<<"ets:fun2ms(fun({X,Y}) when erlang:'">>,
L,<<"'(X,Y) -> erlang:'">>,
L,<<"'(X,Y) end)">>
]),
Res1 = compile_and_run(Bin1),
Res2 = compile_and_run(Bin2),
case Res1 =:= Res2 of
true ->
ok;
false ->
exit({not_equal,{Res1,Res2,A}})
end;
({A,2,magic}) -> %is_record
L = atom_to_list(A),
Bin1 = list_to_binary(
[
<<"ets:fun2ms(fun(X) when ">>,
L,<<"(X,a) -> ">>,
L,<<"(X,a) end)">>
]),
Bin2 = list_to_binary(
[
<<"ets:fun2ms(fun(X) when erlang:'">>,
L,<<"'(X,a) -> erlang:'">>,
L,<<"'(X,a) end)">>
]),
Res1 = compile_and_run(RD,Bin1),
Res2 = compile_and_run(RD,Bin2),
case Res1 =:= Res2 of
true ->
ok;
false ->
exit({not_equal,{Res1,Res2,A}})
end
end,
Allowed),
ok.
semicolon(suite) ->
[];
semicolon(doc) ->
["Tests semicolon in guards of match_specs."];
semicolon(Config) when is_list(Config) ->
?line setup(Config),
?line Res01 = compile_and_run
(<<"ets:fun2ms(fun(X) when is_integer(X); "
"is_float(X) -> true end)">>),
?line Res02 = compile_and_run
(<<"ets:fun2ms(fun(X) when is_integer(X) -> true; "
"(X) when is_float(X) -> true end)">>),
?line Res01 = Res02,
?line Res11 = compile_and_run
(<<"ets:fun2ms(fun(X) when is_integer(X); "
"is_float(X); atom(X) -> true end)">>),
?line Res12 = compile_and_run
(<<"ets:fun2ms(fun(X) when is_integer(X) -> true; "
"(X) when is_float(X) -> true; "
"(X) when is_atom(X) -> true end)">>),
?line Res11 = Res12,
ok.
float_1_function(suite) ->
[];
float_1_function(doc) ->
["OTP-5297. The function float/1."];
float_1_function(Config) when is_list(Config) ->
?line setup(Config),
RunMS = fun(L, MS) ->
ets:match_spec_run(L, ets:match_spec_compile(MS))
end,
?line MS1 = compile_and_run
(<<"ets:fun2ms(fun(X) -> float(X) end)">>),
?line [F1] = RunMS([3], MS1),
?line true = is_float(F1) and (F1 == 3),
?line MS1b = compile_and_run
(<<"dbg:fun2ms(fun(X) -> float(X) end)">>),
?line [F2] = RunMS([3], MS1b),
?line true = is_float(F2) and (F2 == 3),
?line MS2 = compile_and_run
(<<"ets:fun2ms(fun(X) when is_pid(X) or float(X) -> true end)">>),
?line [] = RunMS([3.0], MS2),
?line MS3 = compile_and_run
(<<"dbg:fun2ms(fun(X) when is_pid(X); float(X) -> true end)">>),
?line [true] = RunMS([3.0], MS3),
?line MS4 = compile_and_run
(<<"ets:fun2ms(fun(X) when erlang:float(X) > 1 -> big;"
" (_) -> small end)">>),
?line [small,big] = RunMS([1.0, 3.0], MS4),
?line MS5 = compile_and_run
(<<"ets:fun2ms(fun(X) when float(X) > 1 -> big;"
" (_) -> small end)">>),
?line [small,big] = RunMS([1.0, 3.0], MS5),
%% This is the test from autoimported/1.
?line [{'$1',[{is_float,'$1'}],[{float,'$1'}]}] =
compile_and_run
(<<"ets:fun2ms(fun(X) when float(X) -> float(X) end)">>),
?line [{'$1',[{float,'$1'}],[{float,'$1'}]}] =
compile_and_run
(<<"ets:fun2ms(fun(X) when erlang:'float'(X) -> "
"erlang:'float'(X) end)">>),
ok.
action_function(suite) ->
[];
action_function(doc) ->
["Test all 'action functions'."];
action_function(Config) when is_list(Config) ->
?line setup(Config),
?line [{['$1','$2'],[],
[{set_seq_token,label,0},
{get_seq_token},
{message,'$1'},
{return_trace},
{exception_trace}]}] =
compile_and_run
(<<"dbg:fun2ms(fun([X,Y]) -> "
"set_seq_token(label, 0), "
"get_seq_token(), "
"message(X), "
"return_trace(), "
"exception_trace() end)">>),
?line [{['$1','$2'],[],
[{process_dump},
{enable_trace,send},
{enable_trace,'$2',send},
{disable_trace,procs},
{disable_trace,'$2',procs}]}] =
compile_and_run
(<<"dbg:fun2ms(fun([X,Y]) -> "
"process_dump(), "
"enable_trace(send), "
"enable_trace(Y, send), "
"disable_trace(procs), "
"disable_trace(Y, procs) end)">>),
?line [{['$1','$2'],
[],
[{display,'$1'},
{caller},
{set_tcw,{const,16}},
{silent,true},
{trace,[send],[procs]},
{trace,'$2',[procs],[send]}]}] =
compile_and_run
(<<"A = 16, dbg:fun2ms(fun([X,Y]) -> "
"display(X), "
"caller(), "
"set_tcw(A), "
"silent(true), "
"trace([send], [procs]), "
"trace(Y, [procs], [send]) end)">>),
ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Helpers
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
setup(Config) ->
put(mts_config,Config),
put(mts_tf_counter,0).
temp_name() ->
Conf = get(mts_config),
C = get(mts_tf_counter),
put(mts_tf_counter,C+1),
filename:join([?config(priv_dir,Conf),
"tempfile"++integer_to_list(C)++".tmp"]).
expect_failure(Recs,Code) ->
case (catch compile_and_run(Recs,Code)) of
{'EXIT',_Foo} ->
%erlang:display(_Foo),
ok;
Other ->
exit({expected,failure,got,Other})
end.
compile_and_run(Expr) ->
compile_and_run(<<>>,Expr).
compile_and_run(Records,Expr) ->
Prog = <<
"-module(tmp).\n",
"-include_lib(\"stdlib/include/ms_transform.hrl\").\n",
"-export([tmp/0]).\n",
Records/binary,"\n",
"tmp() ->\n",
Expr/binary,".\n">>,
FN=temp_name(),
file:write_file(FN,Prog),
{ok,Forms} = epp:parse_file(FN,"",""),
{ok,tmp,Bin} = compile:forms(Forms),
code:load_binary(tmp,FN,Bin),
tmp:tmp().
compile_ww(Expr) ->
compile_ww(<<>>,Expr).
compile_ww(Records,Expr) ->
Prog = <<
"-module(tmp).\n",
"-include_lib(\"stdlib/include/ms_transform.hrl\").\n",
"-export([tmp/0]).\n",
Records/binary,"\n",
"tmp() ->\n",
Expr/binary,".\n">>,
FN=temp_name(),
file:write_file(FN,Prog),
{ok,Forms} = epp:parse_file(FN,"",""),
{ok,tmp,_Bin,Wlist} = compile:forms(Forms,[return_warnings,
nowarn_unused_vars,
nowarn_unused_record]),
Wlist.
do_eval(String) ->
{done,{ok,T,_},[]} = erl_scan:tokens(
[],
String++".\n",1),
{ok,Tree} = erl_parse:parse_exprs(T),
{value,Res,[]} = erl_eval:exprs(Tree,[]),
Res.
