aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib/test/ms_transform_SUITE.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stdlib/test/ms_transform_SUITE.erl')
-rw-r--r--lib/stdlib/test/ms_transform_SUITE.erl730
1 files changed, 730 insertions, 0 deletions
diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl
new file mode 100644
index 0000000000..cf0926b7fa
--- /dev/null
+++ b/lib/stdlib/test/ms_transform_SUITE.erl
@@ -0,0 +1,730 @@
+%%
+%% %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(ms_transform_SUITE).
+-author('[email protected]').
+
+-include("test_server.hrl").
+
+-export([all/1]).
+-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([init_per_testcase/2, fin_per_testcase/2]).
+
+init_per_testcase(_Func, Config) ->
+ Dog=test_server:timetrap(test_server:seconds(360)),
+ [{watchdog, Dog}|Config].
+
+fin_per_testcase(_Func, Config) ->
+ Dog=?config(watchdog, Config),
+ test_server:timetrap_cancel(Dog).
+
+all(suite) -> [from_shell,basic_ets,basic_dbg,records,record_index,multipass,
+ bitsyntax, record_defaults, andalso_orelse,
+ float_1_function, action_function,
+ top_match, old_guards, autoimported, semicolon].
+
+andalso_orelse(suite) ->
+ [];
+andalso_orelse(doc) ->
+ ["Tests that andalso and orelse are allowed in guards."];
+andalso_orelse(Config) when 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 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 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 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 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 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 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 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 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 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 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 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 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().
+
+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.
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-03 23:03:45 +0000