1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2004-2019. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20
21%%
22%%----------------------------------------------------------------------
23%% Purpose: Test library module for Megaco/H.248 encode/decode
24%%----------------------------------------------------------------------
25
26-module(megaco_codec_test_lib).
27
28%% ----
29
30-include_lib("megaco/include/megaco.hrl").
31-include_lib("megaco/include/megaco_message_v1.hrl").
32-include("megaco_test_lib.hrl").
33
34%% ----
35
36-export([
37	 skip/1,
38
39	 display_text_messages/2, display_text_messages/3,
40	 generate_text_messages/4,
41	 test_msgs/6,
42
43	 plain_decode_encode/5,
44	 plain_encode_decode/5,
45	 trans_first_encode_decode/5,
46	 actions_first_encode_decode/5,
47	 action_first_encode_decode/5,
48
49	 encode_message/4,
50	 decode_message/5, decode_message/6,
51
52	 expect_instruction/3,
53	 expect_encode/3,
54	 expect_encode_only/3,
55	 expect_encode_decode/4,
56	 expect_encode_decode_only/4,
57	 expect_decode/3,
58	 expect_decode_only/3,
59	 expect_decode_encode/4,
60	 expect_decode_encode_only/4,
61	 expect_exec/2
62	]).
63
64
65-record(expect_instruction,
66	{
67	  %% Short description of what this instruction does
68	  description, % string()
69
70	  %% The actual instruction
71	  command,     % function(Data) -> term()
72
73	  %% Verification function of the instruction
74	  verify       % function(Res, Data) -> {ok, NewData} | {error, Reason}
75	  }
76	).
77
78
79%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
80
81display_text_messages(V, Msgs) ->
82    display_text_messages(V, [], Msgs).
83
84display_text_messages(_, _, []) ->
85    ok;
86display_text_messages(V, EC, [{Name, Msg, _ED, _Conf}|Msgs]) ->
87    (catch display_text_message(Name, EC, Msg, V)),
88    display_text_messages(V, EC, Msgs).
89
90
91display_text_message(Name, EC, Msg, V) when is_tuple(Msg) ->
92    io:format("~n(Erlang) message ~p:~n~p~n", [Name, Msg]),
93    case (catch megaco_pretty_text_encoder:encode_message(EC,V,Msg)) of
94	{'EXIT', _R} ->
95	    io:format("~nPretty encoded: failed (exit)~n", []);
96	{error, {{deprecated, PWhat}, _}} ->
97 	    io:format("~nPretty encoded: deprecated~n~p~n", [PWhat]),
98	    throw(continue);
99	{error, PReason} ->
100 	    io:format("~nPretty encoded: failed (error)~n~p~n", [PReason]),
101	    throw(continue);
102	{ok, Pretty} ->
103	    io:format("~nPretty encoded:~n~s~n", [binary_to_list(Pretty)])
104    end,
105    case (catch megaco_compact_text_encoder:encode_message(EC,V,Msg)) of
106 	{'EXIT', _} ->
107 	    io:format("~nCompact encoded: failed~n", []);
108 	{error, {{deprecated, CWhat}, _}} ->
109  	    io:format("~nPretty encoded: deprecated~n~p~n", [CWhat]);
110 	{ok, Compact} ->
111 	    io:format("~nCompact encoded:~n~s~n", [binary_to_list(Compact)])
112    end;
113display_text_message(_, _, _, _) ->
114    skipping.
115
116generate_text_messages(DirName, V, EC, Msgs) when is_atom(DirName) ->
117    generate_text_messages(atom_to_list(DirName), V, EC, Msgs);
118generate_text_messages(DirName, V, EC, Msgs) when is_list(DirName) ->
119    DirPath = filename:join(["/tmp", DirName]),
120    case file:make_dir(DirPath) of
121	ok ->
122	    generate_text_messages2(DirPath, V, EC, Msgs);
123	{error, eexist} ->
124	    generate_text_messages2(DirPath, V, EC, Msgs);
125	{error, Reason} ->
126	    io:format("Failed creating directory ~s: ~p~n", [DirPath, Reason]),
127	    ok
128    end.
129
130generate_text_messages2(_, _, _, []) ->
131    ok;
132generate_text_messages2(Dir, V, EC, [{Name, Msg, _ED, _Conf}|Msgs]) ->
133    (catch generate_text_message(Dir, Name, EC, Msg, V)),
134    generate_text_messages2(Dir, V, EC, Msgs).
135
136generate_text_message(Dir, Name, EC, Msg, V) ->
137    io:format("~p: ", [Name]),
138    case (catch megaco_pretty_text_encoder:encode_message(EC,V,Msg)) of
139	{'EXIT', EReason} ->
140	    io:format("failed encoding [exit]: ~n~p~n", [EReason]),
141	    throw(continue);
142	{error, {{deprecated, PWhat}, _}} ->
143 	    io:format("failed encoding [deprecated]: ~n~p~n", [PWhat]),
144	    throw(continue);
145	{error, PReason} ->
146 	    io:format("failed encoding [error]: ~n~p~n", [PReason]),
147	    throw(continue);
148	{ok, Pretty} ->
149	    io:format("encoded", []),
150	    FName = filename:flatten([Name, ".txt"]),
151	    Filename = filename:join([Dir, FName]),
152	    case (catch file:open(Filename, [write])) of
153		{ok, Fd} ->
154		    io:format(Fd, "~s", [binary_to_list(Pretty)]),
155		    io:format(" - written to disk~n", []),
156		    (catch file:close(Fd)),
157		    ok;
158		{error, OReason} ->
159		    io:format(" - failed writing to disk: "
160			      "~n~p~n~s~n",
161			      [OReason, binary_to_list(Pretty)]),
162		    throw(continue)
163	    end
164    end.
165
166test_msgs(Codec, DynamicDecode, Ver, EC, Check, Msgs)
167  when is_function(Check) andalso is_list(Msgs) ->
168    io:format("~n", []),
169    test_msgs(Codec, DynamicDecode, Ver, EC, Check, Msgs, []).
170
171test_msgs(_Codec, _DD, _Ver, _EC, _Check, [], []) ->
172    ok;
173test_msgs(_Codec, _DD, _Ver, _EC, _Check, [], Errs) ->
174    ?ERROR(lists:reverse(Errs));
175test_msgs(Codec, DD, Ver, EC, Check,
176	  [{Name, {error, Error}, _ED, _Conf}|Msgs], Acc) ->
177    io:format("error~n", []),
178    test_msgs(Codec, DD, Ver, EC, Check, Msgs, [{Name, Error}|Acc]);
179test_msgs(Codec, DD, Ver, EC, Check,
180	  [{Name, Msg, ED, Conf}|Msgs], Acc) ->
181    Dbg = test_msgs_debug(Conf),
182    put(dbg, Dbg),
183    io:format("~-16w ", [Name]),
184    case (catch encode_decode(ED, Check, Codec, DD, Ver, EC, Msg)) of
185	ok ->
186	    io:format("ok~n", []),
187	    erase(dbg),
188	    test_msgs(Codec, DD, Ver, EC, Check, Msgs, Acc);
189	Error ->
190	    io:format("error~n", []),
191	    erase(dbg),
192	    test_msgs(Codec, DD, Ver, EC, Check, Msgs, [{Name, Error}|Acc])
193    end.
194
195test_msgs_debug(Conf) ->
196    case lists:keysearch(dbg, 1, Conf) of
197	{value, {dbg, true}} ->
198	    true;
199	_ ->
200	    false
201    end.
202
203encode_decode(Func, Check, Codec, DynamicDecode, Ver, EC, Msg1)
204  when is_function(Func) ->
205    d("encode_decode -> entry with"
206      "~n   Func:          ~p"
207      "~n   Check:         ~p"
208      "~n   Codec:         ~p"
209      "~n   DynamicDecode: ~p"
210      "~n   Ver:           ~p"
211      "~n   EC:            ~p",
212      [Func, Check, Codec, DynamicDecode, Ver, EC]),
213    case (catch Func(Codec, DynamicDecode, Ver, EC, Msg1)) of
214	{ok, Msg1} ->
215	    d("encode_decode -> expected result"),
216	    ok;
217	{ok, Msg2} ->
218	    d("encode_decode -> unexpected result - check"),
219	    case (catch Check(Msg1, Msg2)) of
220		ok ->
221		    d("encode_decode -> check - ok"),
222		    ok;
223		{error, Reason} ->
224		    d("encode_decode -> check - error: "
225		      "~n   Reason: ~p", [Reason]),
226		    {error, {Reason, Msg1, Msg2}};
227		Else ->
228		    d("encode_decode -> check - failed: "
229		      "~n   Else: ~p", [Else]),
230		    {error, {invalid_check_result, Else}}
231	    end;
232	Else ->
233	    d("encode_decode -> failed: "
234	      "~n   Else: ~p", [Else]),
235	    Else
236    end.
237
238
239%% *** plain_encode_decode ***
240
241plain_encode_decode(Codec, DynamicDecode, Ver, EC, M1) ->
242    d("plain_encode_decode -> entry with"
243      "~n   Codec:         ~p"
244      "~n   DynamicDecode: ~p"
245      "~n   Ver:           ~p"
246      "~n   EC:            ~p", [Codec, DynamicDecode, Ver, EC]),
247    case (catch encode_message(Codec, Ver, EC, M1)) of
248	{ok, Bin} ->
249	    d("plain_encode_decode -> encode - ok"),
250	    decode_message(Codec, DynamicDecode, Ver, EC, Bin, true);
251	Error ->
252	    d("plain_encode_decode -> encode - failed: "
253	      "~n   Error: ~p", [Error]),
254	    Error
255    end.
256
257
258%% *** plain_decode_encode ***
259
260plain_decode_encode(Codec, DynamicDecode, Ver, EC, M) when is_list(M) ->
261    Bin = list_to_binary(M),
262    plain_decode_encode(Codec, DynamicDecode, Ver, EC, Bin);
263plain_decode_encode(Codec, DynamicDecode, Ver, EC, B) when is_binary(B) ->
264    case (catch decode_message(Codec, DynamicDecode, Ver, EC, B, true)) of
265	{ok, M} ->
266	    encode_message(Codec, Ver, EC, M);
267	Error ->
268	    Error
269    end.
270
271
272%% *** trans_first_encode_decode ***
273
274trans_first_encode_decode(Codec, DynamicDecode, Ver, EC, M1) ->
275    d("trans_first_encode_decode -> entry"),
276    case (catch trans_first_encode_message(Codec, Ver, EC, M1)) of
277	{ok, Bin} ->
278	    decode_message(Codec, DynamicDecode, Ver, EC, Bin, true);
279	Error ->
280	    Error
281    end.
282
283trans_first_encode_message(Codec, Ver, EC, M1) ->
284    d("trans_first_encode_message -> entry"),
285    Mess1 = M1#'MegacoMessage'.mess,
286    {transactions, Trans1} = Mess1#'Message'.messageBody,
287    Trans2 = encode_transactions(Codec, Ver, EC, Trans1),
288    Mess2  = Mess1#'Message'{messageBody = {transactions, Trans2}},
289    M2     = M1#'MegacoMessage'{mess = Mess2},
290    encode_message(Codec, Ver, EC, M2).
291
292encode_transactions(Codec, Ver, EC, Trans) when is_list(Trans) ->
293    d("encode_transactions -> entry"),
294    [encode_transaction(Codec, Ver, EC, T) || T <- Trans].
295
296encode_transaction(Codec, Ver, EC, T) ->
297    d("encode_transaction -> entry"),
298    case (catch Codec:encode_transaction(EC, Ver, T)) of
299	{ok, EncodecTransactions} ->
300	    EncodecTransactions;
301	Error ->
302	    throw({error, {transaction_encode_failed, Error, T}})
303    end.
304
305
306%% *** actions_first_encode_decode ***
307
308actions_first_encode_decode(Codec, DynamicDecode, Ver, EC, M1) ->
309    d("actions_first_encode_decode -> entry"),
310    case (catch actions_first_encode_message(Codec, Ver, EC, M1)) of
311	{ok, Bin} ->
312	    decode_message(Codec, DynamicDecode, Ver, EC, Bin, true);
313	Error ->
314	    Error
315    end.
316
317actions_first_encode_message(Codec, Ver, EC, M1) ->
318    d("actions_first_encode_message -> entry"),
319    Mess1 = M1#'MegacoMessage'.mess,
320    {transactions, Trans1} = Mess1#'Message'.messageBody,
321    Trans2 = encode_actions(Codec, Ver, EC, Trans1),
322    Mess2  = Mess1#'Message'{messageBody = {transactions, Trans2}},
323    M2     = M1#'MegacoMessage'{mess = Mess2},
324    encode_message(Codec, Ver, EC, M2).
325
326encode_actions(Codec, Ver, EC, Trans) when is_list(Trans) ->
327    d("encode_actions -> entry"),
328    [encode_actions1(Codec, Ver, EC, T) || T <- Trans].
329
330encode_actions1(Codec, Ver, EC, {transactionRequest, TR1}) ->
331    d("encode_actions1 -> entry"),
332    #'TransactionRequest'{actions = ARs} = TR1,
333    case (catch encode_action_requests(Codec, Ver, EC, ARs)) of
334	{ok, EncodedARs} ->
335	    TR2 = TR1#'TransactionRequest'{actions = EncodedARs},
336	    {transactionRequest, TR2};
337	Error ->
338	    throw({error, {actions_encode_failed, Error, TR1}})
339    end.
340
341encode_action_requests(Codec, Ver, EC, ARs) ->
342    d("encode_action_requests -> entry"),
343    Codec:encode_action_requests(EC, Ver, ARs).
344
345
346%% *** action_first_encode_decode ***
347
348action_first_encode_decode(Codec, DynamicDecode, Ver, EC, M1) ->
349    d("action_first_encode_decode -> entry"),
350    case (catch action_first_encode_message(Codec, Ver, EC, M1)) of
351	{ok, Bin} ->
352	    decode_message(Codec, DynamicDecode, Ver, EC, Bin, true);
353	Error ->
354	    Error
355    end.
356
357action_first_encode_message(Codec, Ver, EC, M1) ->
358    d("action_first_encode_message -> entry"),
359    Mess1 = M1#'MegacoMessage'.mess,
360    {transactions, Trans1} = Mess1#'Message'.messageBody,
361    Trans2 = encode_action(Codec, Ver, EC, Trans1),
362    Mess2  = Mess1#'Message'{messageBody = {transactions, Trans2}},
363    M2     = M1#'MegacoMessage'{mess = Mess2},
364    encode_message(Codec, Ver, EC, M2).
365
366encode_action(Codec, Ver, EC, Trans) when is_list(Trans) ->
367    d("encode_action -> entry"),
368    [encode_action1(Codec, Ver, EC, T) || T <- Trans].
369
370encode_action1(Codec, Ver, EC, {transactionRequest, TR1}) ->
371    d("encode_action1 -> entry"),
372    #'TransactionRequest'{actions = ARs1} = TR1,
373    ARs2 = [encode_action_request(Codec, Ver, EC, AR) || AR <- ARs1],
374    TR2  = TR1#'TransactionRequest'{actions = ARs2},
375    {transactionRequest, TR2}.
376
377encode_action_request(Codec, Ver, EC, AR) ->
378    d("encode_action_request -> entry"),
379    case (catch Codec:encode_action_request(EC, Ver, AR)) of
380	{ok, Bin} ->
381	    Bin;
382	Error ->
383	    throw({error, {encode_action_request_failed, Error, AR}})
384    end.
385
386
387encode_message(Codec, Ver, EC, M) ->
388    d("encode_message -> entry with"
389      "~n   Codec: ~p"
390      "~n   Ver:   ~p"
391      "~n   EC:    ~p"
392      "~n   M:     ~p", [Codec, Ver, EC, M]),
393%%     case (catch Codec:encode_message(EC, Ver, M)) of
394%% 	{ok, Bin} ->
395%% 	    d("encode_message -> encode - ok: "
396%% 	      "~n~s", [binary_to_list(Bin)]),
397%% 	    {ok, Bin};
398%% 	Error ->
399%% 	    d("encode_message -> encode - failed"),
400%% 	    throw({error, {message_encode_failed, Error, M}})
401%%     end.
402    case (catch timer:tc(Codec, encode_message, [EC, Ver, M])) of
403	{Time, {ok, Bin}} ->
404	    d("encode_message -> encode - ok after ~p: "
405	      "~n~s", [Time, binary_to_list(Bin)]),
406	    {ok, Bin};
407	{_Time, Error} ->
408	    d("encode_message -> encode - failed"),
409	    throw({error, {message_encode_failed, Error, M}})
410    end.
411
412decode_message(Codec, Dynamic, Ver, EC, M) ->
413    decode_message(Codec, Dynamic, Ver, EC, M, false).
414
415decode_message(Codec, true, _Ver, EC, M, _Timed) ->
416    d("decode_message -> entry - when using dynamic"),
417    Codec:decode_message(EC, dynamic, M);
418decode_message(Codec, _, Ver, EC, M, false) ->
419    d("decode_message -> entry with"
420      "~n   Codec: ~p"
421      "~n   Ver:   ~p"
422      "~n   EC:    ~p", [Codec, Ver, EC]),
423    Codec:decode_message(EC, Ver, M);
424decode_message(Codec, _, Ver, EC, M, true) ->
425    d("decode_message -> entry with"
426      "~n   Codec: ~p"
427      "~n   Ver:   ~p"
428      "~n   EC:    ~p", [Codec, Ver, EC]),
429    {Time, Result} = timer:tc(Codec, decode_message, [EC, Ver, M]),
430    io:format("~-8w", [Time]),
431    Result.
432
433
434%% =======================================================================
435
436%% ------------------------------------------------------------------
437%% Create an instruction record
438%% ------------------------------------------------------------------
439
440expect_instruction(Desc, Cmd, Verify)
441  when is_list(Desc) andalso is_function(Cmd) andalso is_function(Verify) ->
442    #expect_instruction{description = Desc,
443			command     = Cmd,
444			verify      = Verify}.
445
446
447%% ------------------------------------------------------------------
448%% Function:    expect_encode
449%% Parameters:  Msg -> MegacoMessage
450%%              Encode -> function/1
451%%              Check -> function/1
452%% Description: This function simply encodes, with the Encode fun,
453%%              and expects this to fail. The failure reason is
454%%              checked with the Check fun.
455%% ------------------------------------------------------------------
456
457expect_encode(InitialData, Encode, Check)
458  when is_function(Encode) andalso is_function(Check) ->
459    Instructions =
460	[
461	 %% Initial encode
462	 expect_instruction(
463	   "Encode (initial) message",
464	   fun(Msg) when is_record(Msg, 'MegacoMessage') ->
465		   (catch Encode(Msg));
466	      (Bad) ->
467		   {error, {invalid_data, Bad}}
468	   end,
469	   fun({error, Reason}, _) ->
470		   io:format("check error reason ", []),
471		   case (catch Check(Reason)) of
472		       ok ->
473			   {ok, done};
474		       Error ->
475			   Error
476		   end;
477	      ({ok, Bin}, Msg) when is_binary(Bin) ->
478		   M = binary_to_list(Bin),
479		   {error, {unexpected_encode_success, {M, Msg}}};
480	      (Crap, _) ->
481		   {error, {unexpected_encode_result, Crap}}
482	   end)
483	],
484    expect_exec(Instructions, InitialData).
485
486
487%% ------------------------------------------------------------------
488%% Function:    expect_encode_only
489%% Parameters:  InitialData -> list() | binary()
490%%              Encode -> function/1
491%%              Check -> function/1
492%% Description: This function simply encodes, with the Encode fun,
493%%              and expects it to succeed, which is checked by
494%%              calling the Check fun with the resulting message.
495%% ------------------------------------------------------------------
496
497expect_encode_only(InitialData, Encode, Check)
498  when is_function(Encode) andalso is_function(Check) ->
499    Instructions =
500	[
501	 %% Initial encode
502	 expect_instruction(
503	   "Encode (initial) message",
504	   fun(Msg) when is_record(Msg, 'MegacoMessage') ->
505		   (catch Encode(Msg));
506	      (Bad) ->
507		   {error, {invalid_data, Bad}}
508	   end,
509	   fun({ok, Bin}, _Msg) when is_binary(Bin) ->
510		   case (catch Check(Bin)) of
511		       ok ->
512			   {ok, done};
513		       Error ->
514			   Error
515		   end;
516	      (Crap, _) ->
517		   {error, {unexpected_encode_result, Crap}}
518	   end)
519	],
520    expect_exec(Instructions, InitialData).
521
522
523%% ------------------------------------------------------------------
524%% Function:    expect_encode_decode
525%% Parameters:  InitialData -> MegacoMessage
526%%              Encode -> function/1
527%%              Decode -> function/1
528%%              Check -> function/2
529%% Description: This function simply encodes, with the Encode fun, and
530%%              then decodes, with the Decode fun, the megaco message.
531%%              The resulting message should be identical, but if it
532%%              is not, the messages are checked, with the Check fun.
533%% ------------------------------------------------------------------
534
535expect_encode_decode(InitialData, Encode, Decode, Check)
536  when is_function(Encode) andalso
537       is_function(Decode) andalso
538       is_function(Check) ->
539    Instructions =
540	[
541	 %% Initial encode
542	 expect_instruction(
543	   "Encode (initial) message",
544	   fun(M) when is_record(M, 'MegacoMessage') ->
545		   (catch Encode(M));
546	      (Bad) ->
547		   {error, {invalid_data, Bad}}
548	   end,
549	   fun({ok, Bin}, M) when is_binary(Bin) ->
550		   {ok, {Bin, M}};
551	      ({error, Reason}, _) ->
552		   {error, {unexpected_encode_failure, Reason}};
553	      (Crap, _) ->
554		   {error, {unexpected_encode_result, Crap}}
555	   end),
556
557	 %% Decode the (encoded) message
558	 expect_instruction(
559	   "Decode message",
560	   fun({Bin, _}) when is_binary(Bin) ->
561		   (catch Decode(Bin));
562	      (Bad) ->
563		   {error, {invalid_data, Bad}}
564	   end,
565	   fun({ok, Msg1}, {_Bin, Msg1})
566	      when is_record(Msg1, 'MegacoMessage') ->
567		   io:format("messages identical - done ", []),
568		   {ok, done};
569	      ({ok, Msg2}, {_Bin, Msg1}) ->
570		   io:format("messages not identical - check - ", []),
571		   case (catch Check(Msg1, Msg2)) of
572		       ok ->
573			   io:format("equal ", []),
574			   {ok, done};
575		       Error ->
576			   io:format("not equal ", []),
577			   io:format("~nError: ~p~n", [Error]),
578			   Error
579		   end;
580	      (Crap, _) ->
581		   {error, {unexpected_decode_result, Crap}}
582	   end)
583	],
584    expect_exec(Instructions, InitialData).
585
586
587%% ------------------------------------------------------------------
588%% Function:    expect_encode_decode_only
589%% Parameters:  InitialData -> MegacoMessage
590%%              Encode -> function/1
591%%              Decode -> function/1
592%%              Check -> function/2
593%% Description: This function simply encodes, with the Encode fun,
594%%              and then decodes, with the Decode fun, the megaco
595%%              message and expects it to succeed. The resulting
596%%              message is checked by calling the Check fun with the
597%%              resulting message.
598%% ------------------------------------------------------------------
599
600expect_encode_decode_only(InitialData, Encode, Decode, Check)
601  when is_function(Encode) andalso
602       is_function(Decode) andalso
603       is_function(Check) ->
604    Instructions =
605	[
606	 %% Initial encode
607	 expect_instruction(
608	   "Encode (initial) message",
609	   fun(M) when is_record(M, 'MegacoMessage') ->
610		   (catch Encode(M));
611	      (Bad) ->
612		   {error, {invalid_data, Bad}}
613	   end,
614	   fun({ok, Bin}, M) when is_binary(Bin) ->
615		   {ok, {Bin, M}};
616	      ({error, Reason}, _) ->
617		   {error, {unexpected_encode_failure, Reason}};
618	      (Crap, _) ->
619		   {error, {unexpected_encode_result, Crap}}
620	   end),
621
622	 %% Decode the (encoded) message
623	 expect_instruction(
624	   "Decode message",
625	   fun({Bin, _}) when is_binary(Bin) ->
626		   (catch Decode(Bin));
627	      (Bad) ->
628		   {error, {invalid_data, Bad}}
629	   end,
630	   fun({ok, Msg}, _B) when is_record(Msg, 'MegacoMessage') ->
631		   io:format("decoded - now check ", []),
632		   case (catch Check(Msg)) of
633		       ok ->
634			   {ok, done};
635		       Error ->
636			   Error
637		   end;
638	      ({error, R}, _) ->
639		   {Line, Mod, Reason} =
640		       case lists:keysearch(reason, 1, R) of
641			   {value, {reason, {L, M, Raw}}}
642			   when is_list(Raw) ->
643			       {L, M, lists:flatten(Raw)};
644			   {value, {reason, {L, M, Raw}}} ->
645			       {L, M, Raw};
646			   _ ->
647			       {-1, undefined, R}
648		       end,
649		   Tokens =
650		       case lists:keysearch(token, 1, R) of
651			   {value, {token, T}} ->
652			       T;
653			   _ ->
654			       undefined
655		       end,
656		   {error, {unexpected_decode_failure,
657			    {Mod, Line, Reason, Tokens}}};
658	      (Crap, _) ->
659		   {error, {unexpected_decode_result, Crap}}
660	   end)
661	],
662    expect_exec(Instructions, InitialData).
663
664
665%% ------------------------------------------------------------------
666%% Function:    expect_decode
667%% Parameters:  InitialData -> list() | binary()
668%%              Decode -> function/1
669%%              Check -> function/1
670%% Description: This function simply decodes, with the Decode fun,
671%%              and expects this to fail. The failure reason is
672%%              checked with the Check fun.
673%% ------------------------------------------------------------------
674
675expect_decode(InitialData, Decode, Check)
676  when is_list(InitialData) ->
677    expect_decode(list_to_binary(InitialData), Decode, Check);
678expect_decode(InitialData, Decode, Check)
679  when is_function(Decode) andalso is_function(Check) ->
680    Instructions =
681	[
682	 %% Initial decode
683	 expect_instruction(
684	   "Decode (initial) message",
685	   fun(Bin) when is_binary(Bin) ->
686		   (catch Decode(Bin));
687	      (Bad) ->
688		   {error, {invalid_data, Bad}}
689	   end,
690	   fun({error, Reason}, _) ->
691		   io:format("check error reason - ", []),
692		   case (catch Check(Reason)) of
693		       ok ->
694			   {ok, done};
695		       Error ->
696			   Error
697		   end;
698	      ({ok, Msg}, Bin) ->
699		   io:format("unexpected decode success - ", []),
700		   M = binary_to_list(Bin),
701		   {error, {unexpected_decode_success, {Msg, M}}};
702	      (Crap, _) ->
703		   {error, {unexpected_decode_result, Crap}}
704	   end)
705	],
706    expect_exec(Instructions, InitialData).
707
708
709%% ------------------------------------------------------------------
710%% Function:    expect_decode_only
711%% Parameters:  InitialData -> list() | binary()
712%%              Decode -> function/1
713%%              Check -> function/2
714%% Description: This function simply decodes, with the Decode fun,
715%%              and expects it to succeed, which is checked by
716%%              calling the Check fun with the resulting message.
717%% ------------------------------------------------------------------
718
719expect_decode_only(InitialData, Decode, Check)
720  when is_list(InitialData) ->
721    expect_decode_only(list_to_binary(InitialData), Decode, Check);
722expect_decode_only(InitialData, Decode, Check)
723  when is_function(Decode) andalso is_function(Check) ->
724    Instructions =
725	[
726	 %% Initial decode
727	 expect_instruction(
728	   "Decode (initial) message",
729	   fun(B) when is_binary(B) ->
730		   (catch Decode(B));
731	      (Bad) ->
732		   {error, {invalid_data, Bad}}
733	   end,
734	   fun({ok, Msg}, _B) when is_record(Msg, 'MegacoMessage') ->
735		   case (catch Check(Msg)) of
736		       ok ->
737			   {ok, done};
738		       Error ->
739			   Error
740		   end;
741	      ({error, R}, _) ->
742		   {Line, Mod, Reason} =
743		       case lists:keysearch(reason, 1, R) of
744			   {value, {reason, {L, M, Raw}}}
745			   when is_list(Raw) ->
746			       {L, M, lists:flatten(Raw)};
747			   {value, {reason, {L, M, Raw}}} ->
748			       {L, M, Raw};
749			   _ ->
750			       {-1, undefined, R}
751		       end,
752		   Tokens =
753		       case lists:keysearch(token, 1, R) of
754			   {value, {token, T}} ->
755			       T;
756			   _ ->
757			       undefined
758		       end,
759		   {error, {unexpected_decode_failure,
760			    {Mod, Line, Reason, Tokens}}};
761	      (Crap, _) ->
762		   {error, {unexpected_decode_result, Crap}}
763	   end)
764	],
765    expect_exec(Instructions, InitialData).
766
767
768%% ------------------------------------------------------------------
769%% Function:    expect_decode_encode
770%% Parameters:  InitialData -> list() | binary()
771%%              Decode -> function/1
772%%              Encode -> function/1
773%%              Check -> function/2
774%% Description: This function simply decodes, with the Decode fun,
775%%              and then encodes, with the Encode fun, the megaco
776%%              message. The resulting binary message should be
777%%              identical, but if it is not, the messages are
778%%              decoded again and then if necessary checked, with
779%%              the Check fun.
780%% ------------------------------------------------------------------
781
782expect_decode_encode(InitialData, Decode, Encode, Check)
783  when is_list(InitialData) ->
784    expect_decode_encode(list_to_binary(InitialData), Decode, Encode, Check);
785expect_decode_encode(InitialData, Decode, Encode, Check)
786  when is_function(Decode) andalso
787       is_function(Encode) andalso
788       is_function(Check) ->
789    Instructions =
790	[
791	 %% Initial decode
792	 expect_instruction(
793	   "Decode (initial) message",
794	   fun(B) when is_binary(B) ->
795		   (catch Decode(B));
796	      (Bad) ->
797		   {error, {invalid_data, Bad}}
798	   end,
799	   fun({ok, Msg}, B) when is_record(Msg, 'MegacoMessage') ->
800		   {ok, {Msg, B}};
801	      ({error, R}, _) ->
802		   {Line, Mod, Reason} =
803		       case lists:keysearch(reason, 1, R) of
804			   {value, {reason, {L, M, Raw}}}
805			   when is_list(Raw) ->
806			       {L, M, lists:flatten(Raw)};
807			   {value, {reason, {L, M, Raw}}} ->
808			       {L, M, Raw};
809			   _ ->
810			       {-1, undefined, R}
811		       end,
812		   Tokens =
813		       case lists:keysearch(token, 1, R) of
814			   {value, {token, T}} ->
815			       T;
816			   _ ->
817			       undefined
818		       end,
819		   {error, {unexpected_decode_failure,
820			    {Mod, Line, Reason, Tokens}}};
821	      (Crap, _) ->
822		   {error, {unexpected_decode_result, Crap}}
823	   end),
824
825
826	 %% Encode the (decoded) message
827	 expect_instruction(
828	   "Encode message",
829	   fun({Msg, _Bin}) when is_record(Msg, 'MegacoMessage') ->
830		   (catch Encode(Msg));
831	      (Bad) ->
832		   {error, {invalid_data, Bad}}
833	   end,
834	   fun({ok, B}, {_, B}) ->
835		   io:format("binaries equal - done ", []),
836		   {ok, done};
837	      ({ok, B}, {Msg, _}) ->
838		   {ok, {Msg, B}};
839	      ({error, Reason}, _) ->
840		   {error, {unexpected_encode_failure, Reason}};
841	      (Crap, _) ->
842		   {error, {unexpected_encode_result, Crap}}
843	   end),
844
845
846	 %% Fallback instruction in case encode produced
847	 %% a binary not equal to the initial
848	 expect_instruction(
849	   "Decode message (if binaries not equal)",
850	   fun(done) ->
851		   done;
852	      ({_Msg, B}) when is_binary(B) ->
853		   (catch Decode(B));
854	      (Bad) ->
855		   {error, {invalid_data, Bad}}
856	   end,
857	   fun({ok, Msg}, {Msg, _Bin}) when is_record(Msg, 'MegacoMessage') ->
858		   io:format("messages identical - done ", []),
859		   {ok, done};
860	       (done, _) ->
861		   io:format("done ", []),
862		   {ok, done};
863	       ({ok, Msg2}, {Msg1, _}) ->
864		   io:format("messages not identical - check - ", []),
865		   case (catch Check(Msg1, Msg2)) of
866		       ok ->
867			   io:format("equal ", []),
868			   {ok, done};
869		       Error ->
870			   io:format("not equal ", []),
871			   Error
872		   end;
873	       ({error, Reason}, _) ->
874		      {error, {unexpected_decode_failure, Reason}};
875	       (Crap, _) ->
876		      {error, {unexpected_decode_result, Crap}}
877	      end)
878	],
879    expect_exec(Instructions, InitialData).
880
881
882%% ------------------------------------------------------------------
883%% Function:    expect_decode_encode_only
884%% Parameters:  InitialData -> list() | binary()
885%%              Decode -> function/1
886%%              Encode -> function/1
887%%              Check -> function/2
888%% Description: This function simply decodes, with the Decode fun,
889%%              and then encodes, with the Encode fun, the megaco
890%%              message. The resulting binary message is then checked
891%%              with the Check fun.
892%% ------------------------------------------------------------------
893
894expect_decode_encode_only(InitialData, Decode, Encode, Check)
895  when is_list(InitialData) ->
896    expect_decode_encode_only(list_to_binary(InitialData),
897			      Decode, Encode, Check);
898expect_decode_encode_only(InitialData, Decode, Encode, Check)
899  when is_function(Decode) andalso
900       is_function(Encode) andalso
901       is_function(Check) ->
902    Instructions =
903	[
904	 %% Initial decode
905	 expect_instruction(
906	   "Decode (initial) message",
907	   fun(B) when is_binary(B) ->
908		   (catch Decode(B));
909	      (Bad) ->
910		   {error, {invalid_data, Bad}}
911	   end,
912	   fun({ok, Msg}, B) when is_record(Msg, 'MegacoMessage') ->
913		   {ok, {Msg, B}};
914	      ({error, R}, _) ->
915		   {Line, Mod, Reason} =
916		       case lists:keysearch(reason, 1, R) of
917			   {value, {reason, {L, M, Raw}}}
918			   when is_list(Raw) ->
919			       {L, M, lists:flatten(Raw)};
920			   {value, {reason, {L, M, Raw}}} ->
921			       {L, M, Raw};
922			   _ ->
923			       {-1, undefined, R}
924		       end,
925		   Tokens =
926		       case lists:keysearch(token, 1, R) of
927			   {value, {token, T}} ->
928			       T;
929			   _ ->
930			       undefined
931		       end,
932		   {error, {unexpected_decode_failure,
933			    {Mod, Line, Reason, Tokens}}};
934	      (Crap, _) ->
935		   {error, {unexpected_decode_result, Crap}}
936	   end),
937
938
939	 %% Encode the (decoded) message
940	 expect_instruction(
941	   "Encode message",
942	   fun({Msg, _Bin}) when is_record(Msg, 'MegacoMessage') ->
943		   (catch Encode(Msg));
944	      (Bad) ->
945		   {error, {invalid_data, Bad}}
946	   end,
947	   fun({ok, B2}, {_, B1}) ->
948		   io:format("encode ok - check bins - ", []),
949		   case (catch Check(B1, B2)) of
950		       ok ->
951			   {ok, done};
952		       Crap ->
953			   {error, {unexpected_encode_check_result, Crap}}
954		   end;
955	      ({error, Reason}, _) ->
956		   {error, {unexpected_encode_failure, Reason}};
957	      (Crap, _) ->
958		   {error, {unexpected_encode_result, Crap}}
959	   end)
960	],
961    expect_exec(Instructions, InitialData).
962
963
964
965%% ------------------------------------------------------------------
966%% Function:    expect_exec
967%% Parameters:  Instructions -> [instruction()]
968%%              InitialData -> term()
969%% Description: This function is the engine in the codec test
970%%              cases. It executes each instruction in turn.
971%% ------------------------------------------------------------------
972
973expect_exec(Instructions, InitialData) ->
974    expect_exec(Instructions, InitialData, 1).
975
976expect_exec([], _, _) ->
977    io:format("~n", []),
978    ok;
979expect_exec([#expect_instruction{description = Desc,
980				 command     = Cmd,
981				 verify      = Verify}|T], Data, Num) ->
982    io:format("~n   Exec command ~w: ~s => ", [Num, Desc]),
983    case Verify((catch Cmd(Data)), Data) of
984	{ok, NewData} ->
985	    io:format("ok", []),
986	    expect_exec(T, NewData, Num+1);
987	{error, Reason} ->
988	    io:format("error", []),
989	    {error, {Num, Desc, Reason}}
990    end.
991
992%% =======================================================================
993
994skip({What, Why}) when is_atom(What) andalso is_list(Why) ->
995    Reason = lists:flatten(io_lib:format("~p: ~s", [What, Why])),
996    ?SKIP(Reason);
997skip({What, Why}) ->
998    Reason = lists:flatten(io_lib:format("~p: ~p", [What, Why])),
999    ?SKIP(Reason);
1000skip(Reason) when is_list(Reason) ->
1001    ?SKIP(Reason);
1002skip(Reason1) ->
1003    Reason2 = lists:flatten(io_lib:format("~p", [Reason1])),
1004    ?SKIP(Reason2).
1005
1006
1007%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1008
1009
1010%% ------------------------------------------------------------------
1011%% Internal functions
1012%% ------------------------------------------------------------------
1013
1014
1015d(F) ->
1016    d(F, []).
1017
1018d(F, A) ->
1019    d(get(dbg), F, A).
1020
1021d(true, F, A) ->
1022    io:format("DBG:~w:" ++ F ++ "~n", [?MODULE|A]);
1023d(_, _, _) ->
1024    ok.
1025
1026