From c75c5a530c10158d4a586a372a165835835bba1b Mon Sep 17 00:00:00 2001 From: Anders Svensson Date: Fri, 22 Jul 2011 12:09:53 +0200 Subject: Add codec suite based on pure ct --- lib/diameter/test/.gitignore | 2 + lib/diameter/test/Makefile | 86 +---- lib/diameter/test/diameter_codec_SUITE.erl | 76 +++++ lib/diameter/test/diameter_codec_test.erl | 500 +++++++++++++++++++++++++++++ lib/diameter/test/diameter_ct.erl | 59 ++++ lib/diameter/test/diameter_enum.erl | 406 +++++++++++++++++++++++ lib/diameter/test/diameter_util.erl | 170 ++++++++++ 7 files changed, 1227 insertions(+), 72 deletions(-) create mode 100644 lib/diameter/test/.gitignore create mode 100644 lib/diameter/test/diameter_codec_SUITE.erl create mode 100644 lib/diameter/test/diameter_codec_test.erl create mode 100644 lib/diameter/test/diameter_ct.erl create mode 100644 lib/diameter/test/diameter_enum.erl create mode 100644 lib/diameter/test/diameter_util.erl (limited to 'lib/diameter/test') diff --git a/lib/diameter/test/.gitignore b/lib/diameter/test/.gitignore new file mode 100644 index 0000000000..8a186ed5b5 --- /dev/null +++ b/lib/diameter/test/.gitignore @@ -0,0 +1,2 @@ + +log diff --git a/lib/diameter/test/Makefile b/lib/diameter/test/Makefile index b3648c7bb1..c8b405a541 100644 --- a/lib/diameter/test/Makefile +++ b/lib/diameter/test/Makefile @@ -302,83 +302,25 @@ test: make -s $(DIAMETER_TEST_SERVER) t $(SUITE) \ $(MAYBE_ESTOP) -utest: make - $(MERL) $(ARGS) -sname diameter_utest $(ERL_PATH) \ - $(MAYBE_ETVIEW) \ - -s $(DIAMETER_TEST_SERVER) t $(SUITE) \ - $(ESTOP) - -# ftest: make -# $(MERL) $(ARGS) -sname diameter_ftest $(ERL_PATH) \ -# -s diameter_filter \ -# -s $(DIAMETER_TEST_SERVER) t $(SUITE) \ -# $(ESTOP) -# +log: + mkdir $@ ########################## -# tickets: make -# $(MERL) $(ARGS) -sname diameter_tickets $(ERL_PATH) \ -# -s $(DIAMETER_TEST_SERVER) tickets $(SUITE) \ -# $(ESTOP) -# - -app: make - $(MERL) $(ARGS) -sname diameter_app $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_app_test \ - $(ESTOP) - -appup: make - $(MERL) $(ARGS) -sname diameter_appup $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_appup_test \ - $(ESTOP) - -compiler: make - $(MERL) $(ARGS) -sname diameter_compiler $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_compiler_test \ - $(ESTOP) - -conf: make - $(MERL) $(ARGS) -sname diameter_config $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_config_test \ - $(ESTOP) - -sync: make - $(MERL) $(ARGS) -sname diameter_sync $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_sync_test \ +# This assumes GNU sed to exit 1 if the output looks to indicate failure. +# diameter_ct:run/1 itself can't tell (it seems). +codec: log make + $(MERL) $(ARGS) \ + -sname diameter_test_$@ \ + -s diameter_ct run $@ \ + -s init stop \ + | sed '/ FAILED /h; p; $$!d; x; /./!d; Q 1' + +app appup compiler conf sync session stats reg peer tcp: make + $(MERL) $(ARGS) -sname diameter_$@ $(ERL_PATH) \ + -s $(DIAMETER_TEST_SERVER) t diameter_$@_test \ $(ESTOP) -session: make - $(MERL) $(ARGS) -sname diameter_session $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_session_test \ - $(ESTOP) - -stats: make - $(MERL) $(ARGS) -sname diameter_stats $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_stats_test \ - $(ESTOP) - -reg: make - $(MERL) $(ARGS) -sname diameter_reg $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_reg_test \ - $(ESTOP) - -peer: make - $(MERL) $(ARGS) -sname diameter_peer $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_peer_test \ - $(ESTOP) - -ptab: make - $(MERL) $(ARGS) -sname diameter_persistent_table $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_persistent_table_test \ - $(ESTOP) - -tcp: make - $(MERL) $(ARGS) -sname diameter_tcp $(ERL_PATH) \ - -s $(DIAMETER_TEST_SERVER) t diameter_tcp_test \ - $(ESTOP) - - node: $(MERL) -sname diameter $(ERL_PATH) diff --git a/lib/diameter/test/diameter_codec_SUITE.erl b/lib/diameter/test/diameter_codec_SUITE.erl new file mode 100644 index 0000000000..07e2a705c3 --- /dev/null +++ b/lib/diameter/test/diameter_codec_SUITE.erl @@ -0,0 +1,76 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. 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% +%% + +%% +%% Test encode/decode of dictionary-related modules. Each test case +%% runs multiple tests in parallel since many of the tests are just +%% the same code with different in-data: implementing each test as a +%% single testcase would make for much duplication with ct's +%% requirement of one function per testcase. (Instead of allowing a +%% testcase to be an MFA instead of function name, say.) +%% + +-module(diameter_codec_SUITE). + +-export([suite/0, + all/0, + init_per_testcase/2, + end_per_testcase/2]). + +%% testcases +-export([base/1, + gen/1, + lib/1]). + +-define(APP, diameter). +-define(L, atom_to_list). + +%% =========================================================================== + +suite() -> + [{timetrap, {seconds, 10}}]. + +all() -> + [base, gen, lib]. + +init_per_testcase(gen, Config) -> + {ok, App} = diameter_util:appfile(?APP), + {modules, Ms} = lists:keyfind(modules, 1, App), + [_|_] = Gs = lists:filter(fun(M) -> + lists:prefix("diameter_gen_", ?L(M)) + end, + Ms), + [{dicts, Gs} | Config]; + +init_per_testcase(_Name, Config) -> + Config. + +end_per_testcase(_, _) -> + ok. + +%% =========================================================================== + +base(_Config) -> + diameter_codec_test:base(). + +gen([{dicts, Ms} | _]) -> + lists:foreach(fun diameter_codec_test:gen/1, Ms). + +lib(_Config) -> + diameter_codec_test:lib(). diff --git a/lib/diameter/test/diameter_codec_test.erl b/lib/diameter/test/diameter_codec_test.erl new file mode 100644 index 0000000000..aab7ab35cc --- /dev/null +++ b/lib/diameter/test/diameter_codec_test.erl @@ -0,0 +1,500 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. 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(diameter_codec_test). + +-compile(export_all). + +%% +%% Test encode/decode of dictionary-related modules. +%% + +-include_lib("diameter/include/diameter.hrl"). + +-define(BASE, diameter_gen_base_rfc3588). +-define(BOOL, [true, false]). + +%% =========================================================================== +%% Interface. + +base() -> + [] = run([{?MODULE, [base, T]} || T <- [zero, decode]]). + +gen(Mod) -> + Fs = [{Mod, F, []} || F <- [name, id, vendor_id, vendor_name]], + [] = run(Fs ++ [{?MODULE, [gen, Mod, T]} || T <- [messages, + command_codes, + avp_types, + grouped, + enums, + import_avps, + import_groups, + import_enums]]). + +lib() -> + Vs = {_,_} = values('Address'), + [] = run([[fun lib/2, N, Vs] || N <- [1,2]]). + +%% =========================================================================== +%% Internal functions. + +lib(N, {_,_} = T) -> + B = 1 == N rem 2, + [] = run([[fun lib/2, A, B] || A <- element(N,T)]); + +lib(IP, B) -> + LA = tuple_to_list(IP), + {SA,Fun} = ip(LA), + [] = run([[fun lib/4, IP, B, Fun, A] || A <- [IP, LA, SA]]). + +lib(IP, B, Fun, A) -> + try Fun(A) of + IP when B -> + ok + catch + error:_ when not B -> + ok + end. + +ip([_,_,_,_] = A) -> + [$.|S] = lists:append(["." ++ integer_to_list(N) || N <- A]), + {S, fun diameter_lib:ip4address/1}; +ip([_,_,_,_,_,_,_,_] = A) -> + [$:|S] = lists:flatten([":" ++ io_lib:format("~.16B", [N]) || N <- A]), + {S, fun diameter_lib:ip6address/1}. + +%% ------------------------------------------------------------------------ +%% base/1 +%% +%% Test of diameter_types. +%% ------------------------------------------------------------------------ + +base(T) -> + [] = run([{?MODULE, [base, T, F]} || F <- types()]). + +%% Ensure that 'zero' values encode only zeros. +base(zero = T, F) -> + B = diameter_types:F(encode, T), + B = z(B); + +%% Ensure that we can decode what we encode and vice-versa, and that +%% we can't decode invalid values. +base(decode, F) -> + {Eq, Vs, Ns} = b(values(F)), + [] = run([{?MODULE, [base_decode, F, Eq, V]} || V <- Vs]), + [] = run([{?MODULE, [base_invalid, F, Eq, V]} || V <- Ns]). + +base_decode(F, Eq, Value) -> + d(fun(X,V) -> diameter_types:F(X,V) end, Eq, Value). + +base_invalid(F, Eq, Value) -> + try + base_decode(F, Eq, Value), + exit(nok) + catch + error: _ -> + ok + end. + +b({_,_,_} = T) -> + T; +b({B,Vs}) + when is_atom(B) -> + {B,Vs,[]}; +b({Vs,Ns}) -> + {true, Vs, Ns}; +b(Vs) -> + {true, Vs, []}. + +types() -> + [F || {F,2} <- diameter_types:module_info(exports)]. + +%% ------------------------------------------------------------------------ +%% gen/2 +%% +%% Test of generated encode/decode module. +%% ------------------------------------------------------------------------ + +gen(M, T) -> + [] = run(lists:map(fun(X) -> {?MODULE, [gen, M, T, X]} end, + fetch(T, M:dict()))). + +fetch(T, Spec) -> + case orddict:find(T, Spec) of + {ok, L} -> + L; + error -> + [] + end. + +gen(M, messages, {Name, Code, Flags, _, _}) -> + Rname = M:msg2rec(Name), + Name = M:rec2msg(Rname), + {Code, F, _} = M:msg_header(Name), + 0 = F band 2#00001111, + Name = case M:msg_name(Code, lists:member('REQ', Flags)) of + N when Name /= 'answer-message' -> + N; + '' when Name == 'answer-message', M == ?BASE -> + Name + end, + [] = arity(M, Name, Rname); + +gen(M, command_codes = T, {Code, {Req, Abbr}, Ans}) -> + Rname = M:msg2rec(Req), + Rname = M:msg2rec(Abbr), + gen(M, T, {Code, Req, Ans}); + +gen(M, command_codes = T, {Code, Req, {Ans, Abbr}}) -> + Rname = M:msg2rec(Ans), + Rname = M:msg2rec(Abbr), + gen(M, T, {Code, Req, Ans}); + +gen(M, command_codes, {Code, Req, Ans}) -> + Msgs = orddict:fetch(messages, M:dict()), + {_, Code, _, _, _} = lists:keyfind(Req, 1, Msgs), + {_, Code, _, _, _} = lists:keyfind(Ans, 1, Msgs); + +gen(M, avp_types, {Name, Code, Type, _Flags, _Encr}) -> + {Code, Flags, VendorId} = M:avp_header(Name), + 0 = Flags band 2#00011111, + V = undefined /= VendorId, + V = 0 /= Flags band 2#10000000, + {Name, Type} = M:avp_name(Code, VendorId), + B = M:empty_value(Name), + B = z(B), + [] = avp_decode(M, Type, Name); + +gen(M, grouped, {Name, _, _, _}) -> + Rname = M:name2rec(Name), + [] = arity(M, Name, Rname); + +gen(M, enums, {Name, ED}) -> + [] = run([{?MODULE, [enum, M, Name, T]} || T <- ED]); + +gen(M, Tag, {_Mod, L}) -> + T = retag(Tag), + [] = run([{?MODULE, [gen, M, T, I]} || I <- L]). + +%% avp_decode/3 + +avp_decode(Mod, Type, Name) -> + {Eq, Vs, _} = b(values(Type, Name, Mod)), + [] = run([{?MODULE, [avp_decode, Mod, Name, Type, Eq, V]} + || V <- v(Vs)]). + +avp_decode(Mod, Name, Type, Eq, Value) -> + d(fun(X,V) -> avp(Mod, X, V, Name, Type) end, Eq, Value). + +avp(Mod, decode = X, V, Name, 'Grouped') -> + {Rec, _} = Mod:avp(X, V, Name), + Rec; +avp(Mod, X, V, Name, _) -> + Mod:avp(X, V, Name). + +%% v/1 + +%% List of values ... +v(Vs) + when is_list(Vs) -> + Vs; + +%% .. or enumeration for grouped avps. This could be quite large +%% (millions of values) but since the avps are also tested +%% individually don't bother trying everything. Instead, choose a +%% reasonable number of values at random. +v(E) -> + v(2000, E(0), E). + +v(Max, Ord, E) + when Ord =< Max -> + diameter_enum:to_list(E); +v(Max, Ord, E) -> + {M,S,U} = now(), + random:seed(M,S,U), + v(Max, Ord, E, []). + +v(0, _, _, Acc) -> + Acc; +v(N, Ord, E, Acc) -> + v(N-1, Ord, E, [E(random:uniform(Ord)) | Acc]). + +%% arity/3 + +arity(M, Name, Rname) -> + Rec = M:'#new-'(Rname), + [] = run([{?MODULE, [arity, M, Name, F, Rec]} + || F <- M:'#info-'(Rname, fields)]). + +arity(M, Name, AvpName, Rec) -> + Def = M:'#get-'(AvpName, Rec), + Def = case M:avp_arity(Name, AvpName) of + 1 -> + undefined; + A when 0 /= A -> + [] + end. + +%% enum/3 + +enum(M, Name, {E,_}) -> + B = <>, + B = M:avp(encode, E, Name), + E = M:avp(decode, B, Name). + +retag(import_avps) -> avp_types; +retag(import_groups) -> grouped; +retag(import_enums) -> enums; + +retag(avp_types) -> import_avps; +retag(enums) -> import_enums. + +%% =========================================================================== + +d(F, Eq, V) -> + B = F(encode, V), + D = F(decode, B), + V = if Eq -> %% test for value equality ... + D; + true -> %% ... or that encode/decode is idempotent + D = F(decode, F(encode, D)), + V + end. + +z(B) -> + << <<0>> || <<_>> <= B >>. + +%% values/1 +%% +%% Return a list of base type values. Can also be wrapped in a tuple +%% with 'false' to indicate that encode followed by decode may not be +%% the identity map. (Although that this composition is idempotent is +%% tested.) + +values('OctetString' = T) -> + {["", atom_to_list(T)], [-1, 256]}; + +values('Integer32') -> + Mx = (1 bsl 31) - 1, + Mn = -1*Mx, + {[Mn, 0, random(Mn,Mx), Mx], [Mn - 1, Mx + 1]}; + +values('Integer64') -> + Mx = (1 bsl 63) - 1, + Mn = -1*Mx, + {[Mn, 0, random(Mn,Mx), Mx], [Mn - 1, Mx + 1]}; + +values('Unsigned32') -> + M = (1 bsl 32) - 1, + {[0, random(M), M], [-1, M + 1]}; + +values('Unsigned64') -> + M = (1 bsl 64) - 1, + {[0, random(M), M], [-1, M + 1]}; + +values('Float32') -> + E = (1 bsl 8) - 2, + F = (1 bsl 23) - 1, + <> = <<0:1/integer, E:8/integer, F:23/integer>>, + <> = <<1:1/integer, E:8/integer, F:23/integer>>, + {[0.0, infinity, '-infinity', Mx, Mn], [0]}; + +values('Float64') -> + E = (1 bsl 11) - 2, + F = (1 bsl 52) - 1, + <> = <<0:1/integer, E:11/integer, F:52/integer>>, + <> = <<1:1/integer, E:11/integer, F:52/integer>>, + {[0.0, infinity, '-infinity', Mx, Mn], [0]}; + +values('Address') -> + {[{255,0,random(16#FF),1}, {65535,0,0,random(16#FFFF),0,0,0,1}], + [{256,0,0,1}, {65536,0,0,0,0,0,0,1}]}; + +values('DiameterIdentity') -> + {["x", "diameter.com"], [""]}; + +values('DiameterURI') -> + {false, ["aaa" ++ S ++ "://diameter.se" ++ P ++ Tr ++ Pr + || S <- ["", "s"], + P <- ["", ":1234"], + Tr <- ["" | [";transport=" ++ X + || X <- ["tcp", "sctp", "udp"]]], + Pr <- ["" | [";protocol=" ++ X + || X <- ["diameter","radius","tacacs+"]]]]}; + +values(T) + when T == 'IPFilterRule'; + T == 'QoSFilterRule' -> + ["deny in 0 from 127.0.0.1 to 10.0.0.1"]; + +%% RFC 3629 defines the UTF-8 encoding of U+0000 through U+10FFFF with the +%% exception of U+D800 through U+DFFF. +values('UTF8String') -> + {[[], + lists:seq(0,16#1FF), + [0,16#D7FF,16#E000,16#10FFFF], + [random(16#D7FF), random(16#E000,16#10FFFF)]], + [[-1], + [16#D800], + [16#DFFF], + [16#110000]]}; + +values('Time') -> + {[{{1968,1,20},{3,14,8}}, %% 19000101T000000 + 1 bsl 31 + {date(), time()}, + {{2036,2,7},{6,28,15}}, + {{2036,2,7},{6,28,16}}, %% 19000101T000000 + 2 bsl 31 + {{2104,2,26},{9,42,23}}], + [{{1968,1,20},{3,14,7}}, + {{2104,2,26},{9,42,24}}]}. %% 19000101T000000 + 3 bsl 31 + +%% values/3 +%% +%% Return list or enumerations of values for a given AVP. Can be +%% wrapped as for values/1. + +values('Enumerated', Name, Mod) -> + {_Name, Vals} = lists:keyfind(Name, 1, types(enums, Mod)), + lists:map(fun({N,_}) -> N end, Vals); + +values('Grouped', Name, Mod) -> + Rname = Mod:name2rec(Name), + Rec = Mod:'#new-'(Rname), + Avps = Mod:'#info-'(Rname, fields), + Enum = diameter_enum:combine(lists:map(fun({_,Vs,_}) -> to_enum(Vs) end, + [values(F, Mod) || F <- Avps])), + {false, diameter_enum:append(group(Mod, Name, Rec, Avps, Enum))}; + +values(_, 'Framed-IP-Address', _) -> + [{127,0,0,1}]; + +values(Type, _, _) -> + values(Type). + +to_enum(Vs) + when is_list(Vs) -> + diameter_enum:new(Vs); +to_enum(E) -> + E. + +%% values/2 + +values('AVP', _) -> + {true, [#diameter_avp{code = 0, data = <<0>>}], []}; + +values(Name, Mod) -> + Avps = types(avp_types, Mod), + {Name, _Code, Type, _Flags, _Encr} = lists:keyfind(Name, 1, Avps), + b(values(Type, Name, Mod)). + +%% group/5 +%% +%% Pack four variants of group values: tagged list containing all +%% values, the corresponding record, a minimal tagged list and the +%% coresponding record. + +group(Mod, Name, Rec, Avps, Enum) -> + lists:map(fun(B) -> group(Mod, Name, Rec, Avps, Enum, B) end, + [{A,R} || A <- ?BOOL, R <- ?BOOL]). + +group(Mod, Name, Rec, Avps, Enum, B) -> + diameter_enum:map(fun(Vs) -> g(Mod, Name, Rec, Avps, Vs, B) end, Enum). + +g(Mod, Name, Rec, Avps, Values, {All, AsRec}) -> + {Tagged, []} + = lists:foldl(fun(N, {A, [V|Vs]}) -> + {pack(All, Mod:avp_arity(Name, N), N, V, A), Vs} + end, + {[], Values}, + Avps), + g(AsRec, Mod, Tagged, Rec). + +g(true, Mod, Vals, Rec) -> + Mod:'#set-'(Vals, Rec); +g(false, _, Vals, _) -> + Vals. + +pack(true, Arity, Avp, Value, Acc) -> + [all(Arity, Avp, Value) | Acc]; +pack(false, Arity, Avp, Value, Acc) -> + min(Arity, Avp, Value, Acc). + +all(Mod, Name, Avp, V) -> + all(Mod:avp_arity(Name, Avp), Avp, V). + +all(1, Avp, V) -> + {Avp, V}; +all({0,'*'}, Avp, V) -> + a(1, Avp, V); +all({N,'*'}, Avp, V) -> + a(N, Avp, V); +all({_,N}, Avp, V) -> + a(N, Avp, V). + +a(N, Avp, V) + when N /= 0 -> + {Avp, lists:duplicate(N,V)}. + +min(Mod, Name, Avp, V, Acc) -> + min(Mod:avp_arity(Name, Avp), Avp, V, Acc). + +min(1, Avp, V, Acc) -> + [{Avp, V} | Acc]; +min({0,_}, _, _, Acc) -> + Acc; +min({N,_}, Avp, V, Acc) -> + [{Avp, lists:duplicate(N,V)} | Acc]. + +%% types/2 + +types(T, Mod) -> + types(T, retag(T), Mod). + +types(T, IT, Mod) -> + Dict = Mod:dict(), + fetch(T, Dict) ++ lists:flatmap(fun({_,As}) -> As end, fetch(IT, Dict)). + +%% random/[12] + +random(M) -> + random(0,M). + +random(Mn,Mx) -> + seed(get({?MODULE, seed})), + Mn + random:uniform(Mx - Mn + 1) - 1. + +seed(undefined) -> + put({?MODULE, seed}, true), + random:seed(now()); + +seed(true) -> + ok. + +%% run/1 +%% +%% Unravel nested badmatches resulting from [] matches on calls to +%% run/1 to make for more readable failures. + +run(L) -> + lists:flatmap(fun flatten/1, diameter_util:run(L)). + +flatten({_, {{badmatch, [{_, {{badmatch, _}, _}} | _] = L}, _}}) -> + L; +flatten(T) -> + [T]. diff --git a/lib/diameter/test/diameter_ct.erl b/lib/diameter/test/diameter_ct.erl new file mode 100644 index 0000000000..6842ca03c5 --- /dev/null +++ b/lib/diameter/test/diameter_ct.erl @@ -0,0 +1,59 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. 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(diameter_ct). + +%% +%% Module used to run suites from Makefile. +%% + +-export([run/1]). + +%% ct:run_test/1 is currently documented as returning a list of test +%% results ... but no. Instead it returns the phenomenally useful +%% value 'ok' regardless of whether or not the suite in question has +%% failed testcases. + +run([Name]) -> + Start = info(), + ok = ct:run_test([{suite, suite(Name)}, + {logdir, "./log"}, + {auto_compile, false}]), + info(Start , info()). + +suite(Name) -> + list_to_atom("diameter_" ++ atom_to_list(Name) ++ "_SUITE"). + +info() -> + [{time, now()}, + {process_count, erlang:system_info(process_count)} + | erlang:memory()]. + +info(L0, L1) -> + [T, C | M] + = lists:zipwith(fun({T,N0}, {T,N1}) -> {T, N1, diff(T, N0, N1)} end, + L0, + L1), + Diff = [T, C, {memory, M}], + ct:pal("INFO: ~p~n", [Diff]). + +diff(time, T0, T1) -> + timer:now_diff(T1, T0); +diff(_, N0, N1) -> + N1 - N0. diff --git a/lib/diameter/test/diameter_enum.erl b/lib/diameter/test/diameter_enum.erl new file mode 100644 index 0000000000..dfb6d04e3c --- /dev/null +++ b/lib/diameter/test/diameter_enum.erl @@ -0,0 +1,406 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. 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(diameter_enum). + +%% +%% This module constructs finite enumerations. +%% +%% An enumeration is represented as a function on integers, 0 mapping +%% to the number of values enumerated and successive integers mapping +%% to enumerated values. The function will fail on anything but 0 and +%% positive integers less then or equal to the value of the function +%% at 0. +%% +%% The purpose of this is to provide a way of stepping through a large +%% number of values without explicitly constructing the list of all +%% possible values. For example, consider the following function that +%% given a list of lists constructs the list of all possible lists +%% constructed by choosing one element from each sublist. +%% +%% combine([H]) -> +%% [[X] || X <- H]; +%% combine([H|T]) -> +%% Ys = combine(T), +%% [[X|Y] || X <- H, Y <- Ys]. +%% +%% Eg. [[1,2],[3,4,5]] -> [[1,3],[1,4],[1,5],[2,3],[2,4],[2,5]] +%% +%% If L is a list of three 1000 element lists then combine(L) would +%% construct a list of length 10^9 which will likely exhaust available +%% memory. (Which is how this module came into being. A tail-recursive +%% implementation doesn't fare much better.) By contrast, +%% +%% F = enum:combine([enum:new(L) || L <- Lists]) +%% +%% only maps existing lists. It may still be undesirable to step +%% through a very large number of values but it's possible, and easy +%% to step through a selection of values as an alternative. +%% + +%% Functions that return enumerations. +-export([new/1, + combine/1, + reverse/1, + map/2, + append/1, + duplicate/2, + nthtail/2, + seq/2, + seq/3, + zip/1, + zip/2, + slice/3, + split/2]). + +%% Functions that operate on existing enumerations. +-export([foreach/2, + foldl/3, + foldr/3, + all/2, + any/2, + member/2, + last/1, + nth/2, + to_list/1]). + +%% ------------------------------------------------------------------------ +%% new/1 +%% +%% Turn a list/tuple of values into an enumeration that steps through +%% each element. Turn anything else into an enumeration of that single +%% value. +%% ------------------------------------------------------------------------ + +new(L) + when is_list(L) -> + new(list_to_tuple(L)); + +new(T) + when is_tuple(T) -> + enum(size(T), fun(N) -> element(N,T) end); + +new(T) -> + fun(0) -> 1; (1) -> T end. + +enum(Ord, F) -> + fun(0) -> Ord; (N) when 0 < N, N =< Ord -> F(N) end. + +%% ------------------------------------------------------------------------ +%% combine/1 +%% +%% Map a list/tuple of enumerations to the enumeration of all +%% lists/tuples constructed by choosing one value from each +%% enumeration in the list/tuple. +%% ------------------------------------------------------------------------ + +combine(T) + when is_tuple(T) -> + F = combine(tuple_to_list(T)), + enum(F(0), fun(N) -> list_to_tuple(F(N)) end); + +combine([]) -> + fun(0) -> 0 end; + +%% Given positive integers n_1,...,n_k, construct a bijection from +%% {0,...,\prod_{i=1}^k} n_i - 1} to {0,...,n_1} x ... x {0,...,n_k} +%% that maps N to (N_1,...,N_k) where: +%% +%% N_1 = (N div 1) rem n_1 +%% ... +%% N_k = (N div n_1*...*n_{k-1}) rem n_k +%% +%% That is: +%% +%% N_i = (N div \prod_{j=1}^{i-1} n_j) rem n_i +%% +%% This corresponds to looping through N_1, incrementing N_2 as N_1 +%% loops, and so on up through N_k. The inverse map is as follows. +%% +%% (N_1,...,N_k) -> N = N_1 + N_2*n_1 + ... + N_k*n_{k-1}*...*n_1 +%% +%% = \sum_{i=1}^k N_i*\prod_{j=i}^{i-1} n_j +%% +%% [Proof: Induction on k. For k=1 we have the identity map. If +%% g_k : (N_1,...,N_k) |-> N above is bijective then consider +%% the bijection +%% +%% G : (t,n) |--> t + n*K, K = n_k*...*n_1 +%% +%% from {0,...,K-1} x {0,...,n_{k+1}-1} onto {0,...,n_{k+1}*K - 1} +%% with inverse F : n |--> (n rem K, n div K). Since +%% +%% g_{k+1}(N_1,...,N_{k+1}) = g_k(N_1,...,N_K) + N_{k+1}*K +%% = G(g_k(N_1,...,N_K), N_{k+1}) +%% +%% and G, g_k and ((N-1,...,N_k),N_{k+1}) -> (N_1,...,N_{k+1}) +%% are all bijections, so is g_{k+1}.] + +combine([_|_] = L) -> + [Ord | Divs] = lists:foldl(fun(F,[D|_] = A) -> [F(0)*D | A] end, [1], L), + RL = lists:reverse(L), + enum(Ord, fun(N) -> combine(N, Ord, Divs, RL) end). + +%% Since we use 0 to return the number of elements enumerated, use +%% bijections from {1,...,N} rather than {0,...,N-1}. + +combine(N, Ord, Divs, L) + when 0 < N, N =< Ord -> + {Vs, []} = lists:foldl(fun(F, {A, [D|Ds]}) -> + {[F(1 + (((N-1) div D) rem F(0))) | A], Ds} + end, + {[], Divs}, + L), + Vs. + +%% ------------------------------------------------------------------------ +%% reverse/1 +%% +%% Construct the enumeration that reverses the order in which values +%% are traversed. +%% ------------------------------------------------------------------------ + +reverse(E) -> + Ord = E(0), + enum(Ord, fun(N) -> E(Ord + 1 - N) end). + +%% ------------------------------------------------------------------------ +%% map/2 +%% +%% Construct an enumeration that maps enumerated values. +%% ------------------------------------------------------------------------ + +map(Fun, E) -> + enum(E(0), fun(N) -> Fun(E(N)) end). + +%% ------------------------------------------------------------------------ +%% append/2 +%% +%% Construct an enumeration that successively steps through each of a +%% list of enumerations. +%% ------------------------------------------------------------------------ + +append(Es) -> + [Ord | Os] = lists:foldl(fun(E, [N|_] = A) -> [N+E(0)|A] end, [0], Es), + Rev = lists:reverse(Es), + enum(Ord, fun(N) -> append(N, Os, Rev) end). + +append(N, [Ord | _], [E | _]) + when N > Ord -> + E(N - Ord); +append(N, [_|Os], [_|Es]) -> + append(N, Os, Es). + +%% ------------------------------------------------------------------------ +%% duplicate/2 +%% +%% Construct an enumeration that traverses an enumeration multiple +%% times. Equivalent to append(lists:duplicate(N, E)). +%% ------------------------------------------------------------------------ + +duplicate(N, E) -> + Ord = E(0), + enum(N*Ord, fun(M) -> E(1 + ((M-1) rem Ord)) end). + +%% ------------------------------------------------------------------------ +%% nthtail/2 +%% +%% Construct an enumeration that omits values at the head of an +%% existing enumeration. +%% ------------------------------------------------------------------------ + +nthtail(N, E) + when 0 =< N -> + nthtail(E(0) - N, N, E). + +nthtail(Ord, N, E) + when 0 =< Ord -> + enum(Ord, fun(M) -> E(M+N) end). + +%% ------------------------------------------------------------------------ +%% seq/[23] +%% +%% Construct an enumeration that steps through a sequence of integers. +%% ------------------------------------------------------------------------ + +seq(From, To) -> + seq(From, To, 1). + +seq(From, To, Incr) + when From =< To -> + enum((To - From + Incr) div Incr, fun(N) -> From + (N-1)*Incr end). + +%% ------------------------------------------------------------------------ +%% zip/[12] +%% +%% Construct an enumeration whose nth value is the list of nth values +%% of a list of enumerations. +%% ------------------------------------------------------------------------ + +zip(Es) -> + zip(fun(T) -> T end, Es). + +zip(_, []) -> + []; +zip(Fun, Es) -> + enum(lists:min([E(0) || E <- Es]), fun(N) -> Fun([E(N) || E <- Es]) end). + +%% ------------------------------------------------------------------------ +%% slice/3 +%% +%% Construct an enumeration of a given length from a given starting point. +%% ------------------------------------------------------------------------ + +slice(N, Len, E) + when is_integer(N), N > 0, is_integer(Len), Len >= 0 -> + slice(N, Len, E(0) - (N - 1), E). + +slice(_, _, Tail, _) + when Tail < 1 -> + fun(0) -> 0 end; + +slice(N, Len, Tail, E) -> + enum(lists:min([Len, Tail]), fun(M) -> E(N-1+M) end). + +%% ------------------------------------------------------------------------ +%% split/2 +%% +%% Split an enumeration into a list of enumerations of the specified +%% length. The last enumeration of the list may have order less than +%% this length. +%% ------------------------------------------------------------------------ + +split(Len, E) + when is_integer(Len), Len > 0 -> + split(1, E(0), Len, E, []). + +split(N, Ord, _, _, Acc) + when N > Ord -> + lists:reverse(Acc); + +split(N, Ord, Len, E, Acc) -> + split(N+Len, Ord, Len, E, [slice(N, Len, E) | Acc]). + +%% ------------------------------------------------------------------------ +%% foreach/2 +%% +%% Apply a fun to each value of an enumeration. +%% ------------------------------------------------------------------------ + +foreach(Fun, E) -> + foldl(fun(N,ok) -> Fun(N), ok end, ok, E). + +%% ------------------------------------------------------------------------ +%% foldl/3 +%% foldr/3 +%% +%% Fold through values in an enumeration. +%% ------------------------------------------------------------------------ + +foldl(Fun, Acc, E) -> + foldl(E(0), 1, Fun, Acc, E). + +foldl(M, N, _, Acc, _) + when N == M+1 -> + Acc; +foldl(M, N, Fun, Acc, E) -> + foldl(M, N+1, Fun, Fun(E(N), Acc), E). + +foldr(Fun, Acc, E) -> + foldl(Fun, Acc, reverse(E)). + +%% ------------------------------------------------------------------------ +%% all/2 +%% +%% Do all values of an enumeration satisfy a predicate? +%% ------------------------------------------------------------------------ + +all(Pred, E) -> + all(E(0), 1, Pred, E). + +all(M, N, _, _) + when N == M+1 -> + true; +all(M, N, Pred, E) -> + Pred(E(N)) andalso all(M, N+1, Pred, E). + +%% Note that andalso/orelse are tail-recusive as of R13A. + +%% ------------------------------------------------------------------------ +%% any/2 +%% +%% Does any value of an enumeration satisfy a predicate? +%% ------------------------------------------------------------------------ + +any(Pred, E) -> + any(E(0), 1, Pred, E). + +any(M, N, _, _) + when N == M+1 -> + false; +any(M, N, Pred, E) -> + Pred(E(N)) orelse any(M, N+1, Pred, E). + +%% ------------------------------------------------------------------------ +%% member/2 +%% +%% Does a value match any in an enumeration? +%% ------------------------------------------------------------------------ + +member(X, E) -> + member(E(0), 1, X, E). + +member(M, N, _, _) + when N == M+1 -> + false; +member(M, N, X, E) -> + match(E(N), X) orelse member(M, N+1, X, E). + +match(X, X) -> + true; +match(_, _) -> + false. + +%% ------------------------------------------------------------------------ +%% last/1 +%% +%% Return the last value of an enumeration. +%% ------------------------------------------------------------------------ + +last(E) -> + E(E(0)). + +%% ------------------------------------------------------------------------ +%% nth/2 +%% +%% Return a selected value of an enumeration. +%% ------------------------------------------------------------------------ + +nth(N, E) -> + E(N). + +%% ------------------------------------------------------------------------ +%% to_list/1 +%% +%% Turn an enumeration into a list. Not good if the very many values +%% are enumerated. +%% ------------------------------------------------------------------------ + +to_list(E) -> + foldr(fun(X,A) -> [X|A] end, [], E). diff --git a/lib/diameter/test/diameter_util.erl b/lib/diameter/test/diameter_util.erl new file mode 100644 index 0000000000..93760a1c07 --- /dev/null +++ b/lib/diameter/test/diameter_util.erl @@ -0,0 +1,170 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2010-2011. 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(diameter_util). + +%% +%% Utility functions. +%% + +-export([appfile/1, + run/1, + fold/3, + foldl/3, + scramble/1, + ps/0]). + +%% appfile/1 +%% +%% Extract info from the app file of the named application. + +appfile(Name) -> + appfile(code:lib_dir(Name, ebin), Name). + +appfile({error = E, Reason}, _) -> + {E, {code, Reason}}; +appfile(Dir, Name) -> + case file:consult(filename:join([Dir, atom_to_list(Name) ++ ".app"])) of + {ok, [{application, Name, App}]} -> + {ok, App}; + {ok, Huh} -> + {error, {content, Huh}}; + {error, Reason} -> + {error, {file, Reason}} + end. + +%% run/1 +%% +%% Evaluate functions in parallel and return a list of those that +%% failed to return. The fun takes a boolean (did the function return +%% or not), the function that was evaluated, the return value or exit +%% reason and the prevailing accumulator. + +run(L) -> + fold(fun cons/4, [], L). + +cons(true, _, _, Acc) -> + Acc; +cons(false, F, RC, Acc) -> + [{F, RC} | Acc]. + +%% fold/3 +%% +%% Parallel fold. Results are folded in the order received. + +fold(Fun, Acc0, L) + when is_function(Fun, 4) -> + Ref = make_ref(), + %% Spawn a middleman to collect down messages from processes + %% spawned for each function so as not to assume that all DOWN + %% messages are ours. + MRef = run1([fun fold/4, Ref, Fun, Acc0, L], Ref), + {Ref, RC} = down(MRef), + RC. + +fold(Ref, Fun, Acc0, L) -> + recv(run(Ref, L), Ref, Fun, Acc0). + +run(Ref, L) -> + [{run1(F, Ref), F} || F <- L]. + +run1(F, Ref) -> + {_, MRef} = spawn_monitor(fun() -> exit({Ref, eval(F)}) end), + MRef. + +recv([], _, _, Acc) -> + Acc; +recv(L, Ref, Fun, Acc) -> + {MRef, R} = down(), + {MRef, F} = lists:keyfind(MRef, 1, L), + recv(lists:keydelete(MRef, 1, L), + Ref, + Fun, + acc(R, Ref, F, Fun, Acc)). + +acc({Ref, RC}, Ref, F, Fun, Acc) -> + Fun(true, F, RC, Acc); +acc(Reason, _, F, Fun, Acc) -> + Fun(false, F, Reason, Acc). + +down(MRef) -> + receive {'DOWN', MRef, process, _, Reason} -> Reason end. + +down() -> + receive {'DOWN', MRef, process, _, Reason} -> {MRef, Reason} end. + +%% foldl/3 +%% +%% Parallel fold. Results are folded in order of the function list. + +foldl(Fun, Acc0, L) + when is_function(Fun, 4) -> + Ref = make_ref(), + recvl(run(Ref, L), Ref, Fun, Acc0). + +recvl([], _, _, Acc) -> + Acc; +recvl([{MRef, F} | L], Ref, Fun, Acc) -> + R = down(MRef), + recvl(L, Ref, Fun, acc(R, Ref, F, Fun, Acc)). + +%% scramble/1 +%% +%% Sort a list into random order. + +scramble(L) -> + foldl(fun(true, _, S, false) -> S end, + false, + [[fun s/1, L]]). + +s(L) -> + random:seed(now()), + s([], L). + +s(Acc, []) -> + Acc; +s(Acc, L) -> + {H, [T|Rest]} = lists:split(random:uniform(length(L)) - 1, L), + s([T|Acc], H ++ Rest). + +%% ps/0 + +ps() -> + [{P, process_info(P)} || P <- erlang:processes()]. + +%% eval/1 + +eval({M,[F|A]}) + when is_atom(F) -> + apply(M,F,A); + +eval({M,F,A}) -> + apply(M,F,A); + +eval([F|A]) + when is_function(F) -> + apply(F,A); + +eval(L) + when is_list(L) -> + run(L); + +eval(F) + when is_function(F,0) -> + F(). -- cgit v1.2.3