1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1999-2016. 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-module(queue_SUITE).
21-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
22	 init_per_testcase/2, end_per_testcase/2,
23	 init_per_group/2,end_per_group/2]).
24
25-export([do/1, to_list/1, io_test/1, op_test/1, error/1, oops/1]).
26
27
28-include_lib("common_test/include/ct.hrl").
29
30init_per_testcase(_Case, Config) ->
31    Config.
32
33end_per_testcase(_Case, _Config) ->
34    ok.
35
36suite() ->
37    [{ct_hooks,[ts_install_cth]},
38     {timetrap,{minutes,1}}].
39
40all() ->
41    [do, to_list, io_test, op_test, error, oops].
42
43groups() ->
44    [].
45
46init_per_suite(Config) ->
47    Config.
48
49end_per_suite(_Config) ->
50    ok.
51
52init_per_group(_GroupName, Config) ->
53    Config.
54
55end_per_group(_GroupName, Config) ->
56    Config.
57
58
59do(Config) when is_list(Config) ->
60    L = [{in, 1},
61	 {in, 2},
62	 {out, {value, 1}},
63	 {in, 3},
64	 {out, {value, 2}},
65	 {out, {value, 3}},
66	 {out, empty}
67	],
68
69    E = queue:new(),
70    [] = queue:to_list(E),
71    Q = do_queue(E, L),
72    true = queue:is_empty(Q),
73    0 = queue:len(Q),
74    ok.
75
76%% OTP-2701
77to_list(Config) when is_list(Config) ->
78    E = queue:new(),
79    Q = do_queue(E, [{in, 1},
80		     {in, 2},
81		     {in, 3},
82		     {out, {value, 1}},
83		     {in, 4},
84		     {in, 5}]),
85    true = queue:is_queue(Q),
86    4 = queue:len(Q),
87    case queue:to_list(Q) of
88	[2,3,4,5] ->
89	    ok;
90	Other1 ->
91	    ct:fail(Other1)
92    end,
93    ok.
94
95do_queue(Q, []) ->
96    Q;
97do_queue(Q, [E | Rest]) ->
98    do_queue(do_queue_1(E, Q), Rest).
99
100do_queue_1({in, E}, Q) ->
101    queue:in(E, Q);
102do_queue_1({out, E}, Q) ->
103    case queue:out(Q) of
104	{E, Q1} ->
105	    Q1;
106	Other ->
107	    ct:fail({"out failed", E, Q, Other})
108    end.
109
110
111%% Test input and output.
112io_test(Config) when is_list(Config) ->
113    E = queue:new(),
114    do_io_test(E),
115    ok.
116
117do_io_test(E) ->
118    [4,3,5] =
119	io([snoc,snoc,head,head,head,cons,cons,snoc], E, 1),
120    [5,3,4] =
121	io([cons,cons,daeh,daeh,daeh,snoc,snoc,cons], E, 1),
122    [4,3,5] =
123	io([in,in,out,out,out,in_r,in_r,in], E, 1),
124    [5,3,4] =
125	io([in_r,in_r,out_r,out_r,out_r,in,in,in_r], E, 1),
126    %%
127    [] =
128	io([snoc,snoc,head,snoc,snoc,head,head,snoc,head,head], E, 1),
129    [] =
130	io([cons,cons,daeh,cons,cons,daeh,daeh,cons,daeh,daeh], E, 1),
131    [] =
132	io([in,in,out,in,in,out,out,in,out,out], E, 1),
133    [] =
134	io([in_r,in_r,out_r,in_r,in_r,out_r,out_r,in_r,out_r,out_r],
135	   E, 1),
136    %%
137    [5,6] =
138	io([snoc,snoc,snoc,head,head,snoc,snoc,snoc,head,head], E, 1),
139    [6,5] =
140	io([cons,cons,cons,daeh,daeh,cons,cons,cons,daeh,daeh], E, 1),
141    [5,6] =
142	io([in,in,in,out,out,in,in,in,out,out], E, 1),
143    [6,5] =
144	io([in_r,in_r,in_r,out_r,out_r,in_r,in_r,in_r,out_r,out_r],
145	   E, 1),
146    %%
147    [5] =
148	io([snoc,head,head,snoc,head,snoc,head,snoc,head,snoc], E, 1),
149    [5] =
150	io([cons,daeh,daeh,cons,daeh,cons,daeh,cons,daeh,cons], E, 1),
151    [5] =
152	io([in,out,out,in,out,in,out,in,out,in], E, 1),
153    [5] =
154	io([in_r,out_r,out_r,in_r,out_r,in_r,out_r,in_r,out_r,in_r],
155	   E, 1),
156    %%
157    [] =
158	io([snoc,head,snoc,snoc,head,head,snoc,snoc,snoc,head,head,head],
159	   E, 1),
160    [] =
161	io([cons,daeh,cons,cons,daeh,daeh,cons,cons,cons,daeh,daeh,daeh],
162	   E, 1),
163    [] =
164	io([in,out,in,in,out,out,in,in,in,out,out,out],
165	   E, 1),
166    [] =
167	io([in_r,out_r,in_r,in_r,out_r,out_r,in_r,in_r,in_r,out_r,out_r,out_r],
168	   E, 1),
169    %%
170    [3] =	io([cons,cons,cons,snoc,daeh,daeh,daeh], E, 1),
171    [3] =	io([snoc,snoc,snoc,cons,head,head,head], E, 1),
172    [3] =	io([in,in,in,in_r,out,out,out], E, 1),
173    [3] =	io([in_r,in_r,in_r,in,out_r,out_r,out_r], E, 1),
174    %%
175    Q2 = queue:join(queue:cons(1, E),queue:cons(2, E)),
176    Q1 = queue:reverse(Q2),
177    [1] = io([head],  Q1, 3),
178    [1] = io([out],   Q1, 3),
179    [1] = io([daeh],  Q2, 3),
180    [1] = io([out_r], Q2, 3),
181    %%
182    [2] =
183	io([in,peek,peek_r,drop,in_r,peek,peek_r,in,peek,peek_r,drop_r], E, 1),
184    %% Malformed queues UGLY-GUTS-ALL-OVER-THE-PLACE
185    [2,1] = io([peek], {[1,2],[]}, 1),
186    [1,2] = io([peek_r], {[],[1,2]}, 1),
187    %%
188    ok.
189
190%% Perform a list of operations to a queue.
191%% Keep a reference queue on the side; just a list.
192%% Compare the read values between the queues.
193%% Return the resulting queue as a list.
194%% Inserted values are increments of the previously inserted.
195io(Ops, Q, X) ->
196    io(Ops, Q, queue:to_list(Q), X).
197
198io([head | Tail], Q, [], X) ->
199    true = queue:is_empty(Q),
200    {'EXIT',{empty,_}} = (catch {ok,queue:head(Q)}),
201    {'EXIT',{empty,_}} = (catch {ok,queue:tail(Q)}),
202    io(Tail, Q, [], X);
203io([head | Tail], Q, [H | T], X) ->
204    H = queue:head(Q),
205    false = queue:is_empty(Q),
206    io(Tail, queue:tail(Q), T, X);
207io([daeh | Tail], Q, [], X) ->
208    true = queue:is_empty(Q),
209    {'EXIT',{empty,_}} = (catch {ok,queue:daeh(Q)}),
210    {'EXIT',{empty,_}} = (catch {ok,queue:liat(Q)}),
211    {'EXIT',{empty,_}} = (catch {ok,queue:lait(Q)}),
212    io(Tail, Q, [], X);
213io([daeh | Tail], Q, QQ, X) ->
214    H = queue:daeh(Q),
215    false = queue:is_empty(Q),
216    [H | T] = lists:reverse(QQ),
217    io(Tail, queue:liat(Q), lists:reverse(T), X);
218io([out | Tail], Q, [], X) ->
219    {empty, Q1} = queue:out(Q),
220    io(Tail, Q1, [], X);
221io([out | Tail], Q, [H | T], X) ->
222    {{value,H}, Q1} = queue:out(Q),
223    io(Tail, Q1, T, X);
224io([out_r | Tail], Q, [], X) ->
225    {empty, Q1} = queue:out_r(Q),
226    io(Tail, Q1, [], X);
227io([out_r | Tail], Q, QQ, X) ->
228    {{value,H}, Q1} = queue:out_r(Q),
229    [H | T] = lists:reverse(QQ),
230    io(Tail, Q1, lists:reverse(T), X);
231io([cons | Tail], Q, QQ, X) ->
232    io(Tail, queue:cons(X,Q), [X|QQ], X+1);
233io([snoc | Tail], Q, QQ, X) ->
234    io(Tail, queue:snoc(Q,X), QQ++[X], X+1);
235io([in_r | Tail], Q, QQ, X) ->
236    io(Tail, queue:in_r(X,Q), [X|QQ], X+1);
237io([in | Tail], Q, QQ, X) ->
238    io(Tail, queue:in(X,Q), QQ++[X], X+1);
239io([peek | Tail], Q, [], X) ->
240    empty = queue:peek(Q),
241    io(Tail, Q, [], X);
242io([peek | Tail], Q, [H|_]=Q0, X) ->
243    {value,H} = queue:peek(Q),
244    io(Tail, Q, Q0, X);
245io([peek_r | Tail], Q, [], X) ->
246    empty = queue:peek_r(Q),
247    io(Tail, Q, [], X);
248io([peek_r | Tail], Q, Q0, X) ->
249    E = lists:last(Q0),
250    {value,E} = queue:peek_r(Q),
251    io(Tail, Q, Q0, X);
252io([drop | Tail], Q, [], X) ->
253    try queue:drop(Q) of
254	V ->
255	    ct:fail({?MODULE,?LINE,V})
256    catch
257	error:empty ->
258	    io(Tail, Q, [], X)
259    end;
260io([drop | Tail], Q, [_ | T], X) ->
261    Q1 = queue:drop(Q),
262    io(Tail, Q1, T, X);
263io([drop_r | Tail], Q, [], X) ->
264    try queue:drop_r(Q) of
265	V ->
266	    ct:fail({?MODULE,?LINE,V})
267    catch
268	error:empty ->
269	    io(Tail, Q, [], X)
270    end;
271io([drop_r | Tail], Q, L, X) ->
272    io:format("~p~n", [{drop_r,Tail,Q,L,X}]),
273    Q1 = queue:drop_r(Q),
274    [_ | T] = lists:reverse(L),
275    io:format("~p~n", [{drop_r,Q1,T}]),
276    io(Tail, Q1, lists:reverse(T), X);
277io([], Q, QQ, _X) ->
278    QQ = queue:to_list(Q),
279    Length = length(QQ),
280    Length = queue:len(Q),
281    QQ.
282
283
284%% Test operations on whole queues.
285op_test(Config) when is_list(Config) ->
286    do_op_test(fun id/1),
287    ok.
288
289do_op_test(F) ->
290    Len = 50,
291    Len2 = 2*Len,
292    L1 = lists:seq(1, Len),
293    L1r = lists:reverse(L1),
294    L2 = lists:seq(Len+1, Len2),
295    L2r = lists:reverse(L2),
296    L3 = L1++L2,
297    L3r = L2r++L1r,
298    Q0 = F(queue:new()),
299    [] = queue:to_list(Q0),
300    Q0 = F(queue:from_list([])),
301    Q1 = F(queue:from_list(L1)),
302    Q2 = F(queue:from_list(L2)),
303    Q3 = F(queue:from_list(L3)),
304    Len = queue:len(Q1),
305    Len = queue:len(Q2),
306    Len2 = queue:len(Q3),
307    L1 = queue:to_list(Q1),
308    L2 = queue:to_list(Q2),
309    L3 = queue:to_list(Q3),
310    Q3b = queue:join(Q0, queue:join(queue:join(Q1, Q2), Q0)),
311    L3 = queue:to_list(Q3b),
312    {Q0, Q3New1} = queue:split(0, Q3),
313    L3 = queue:to_list(Q3New1),
314    {Q3New2, Q0} = queue:split(Len2, Q3),
315    L3 = queue:to_list(Q3New2),
316    {Q1a, Q2a} = queue:split(Len, Q3),
317    L1 = queue:to_list(Q1a),
318    L2 = queue:to_list(Q2a),
319    {Q3c, Q3d} = queue:split(2, Q3),
320    L3 = queue:to_list(Q3c) ++ queue:to_list(Q3d),
321    {Q1b, Q2b} = queue:split(Len, Q3b),
322    L1 = queue:to_list(Q1b),
323    L2 = queue:to_list(Q2b),
324    Len = queue:len(Q1b),
325    Len = queue:len(Q2b),
326    Len2 = queue:len(Q3b),
327    Q1r = queue:reverse(Q1),
328    Q2r = queue:reverse(Q2),
329    Q1ar = queue:reverse(Q1a),
330    Q2ar = queue:reverse(Q2a),
331    Q1br = queue:reverse(Q1b),
332    Q2br = queue:reverse(Q2b),
333    Q3br = queue:reverse(Q3b),
334    L1r = queue:to_list(Q1r),
335    L1r = queue:to_list(Q1ar),
336    L1r = queue:to_list(Q1br),
337    L2r = queue:to_list(Q2r),
338    L2r = queue:to_list(Q2ar),
339    L2r = queue:to_list(Q2br),
340    L3r = queue:to_list(Q3br),
341    Len = queue:len(Q1br),
342    Len = queue:len(Q2br),
343    Len2 = queue:len(Q3br),
344    false = queue:member([], Q0),
345    false = queue:member(0, Q0),
346    false = queue:member(0, Q1),
347    false = queue:member([], Q1),
348    true = queue:member(1, Q1),
349    false = queue:member(1.0, Q1),
350    true = queue:member(Len, Q1),
351    %%
352    %% Additional coverage.
353    {MyL1r,MyL2r} = lists:split(Len-2, L1r),
354    MyQ0r = queue:reverse(F(queue:from_list(L1))),
355    {MyQ1r,MyQ2r} = queue:split(Len-2, MyQ0r),
356    MyL1r = queue:to_list(MyQ1r),
357    MyL2r = queue:to_list(MyQ2r),
358    MyQ3r = queue:filter(
359	      fun (X) when X rem 4 >= 2 -> false;
360		  (X) when X rem 8 == 0 -> [float(X),{X}];
361		  (X) when X rem 2 >= 1 -> [{X}];
362		  (_)                   -> true
363	      end, MyQ1r),
364    MyL3r = lists:flatten(
365	      [if X rem 8 == 0 -> [float(X),{X}];
366		  X rem 2 >= 1 -> {X};
367		  true         -> X
368	       end || X <- MyL1r,
369		      X rem 4 < 2]),
370    MyL3r = queue:to_list(MyQ3r),
371    MyQ4 = F(queue:from_list([11,22,33,44])),
372    [11,22] = queue:to_list(queue:filter(fun(X) when X < 27 -> true;
373					    (_) -> [] end, MyQ4)),
374    [33,44] = queue:to_list(queue:filter(fun(X) when X < 27 -> false;
375					    (X) -> [X] end, MyQ4)),
376    %%
377    ok.
378
379%% Test queue errors.
380error(Config) when is_list(Config) ->
381    do_error(fun id/1, illegal_queue),
382    do_error(fun id/1, {[],illegal_queue}),
383    do_error(fun id/1, {illegal_queue,[17]}),
384    ok.
385
386trycatch(F, Args) ->
387    trycatch(queue, F, Args).
388
389trycatch(M, F, Args) ->
390    try apply(M, F, Args) of
391	V -> {value,V}
392    catch
393	C:R -> {C,R}
394    end.
395
396do_error(F, IQ) ->
397    io:format("Illegal Queue: ~p~n", [IQ]),
398    %%
399    {error,badarg} = trycatch(in, [1, IQ]),
400    {error,badarg} = trycatch(out, [IQ]),
401    {error,badarg} = trycatch(in_r ,[1, IQ]),
402    {error,badarg} = trycatch(out_r ,[IQ]),
403    {error,badarg} = trycatch(to_list ,[IQ]),
404    %%
405    {error,badarg} = trycatch(from_list, [no_list]),
406    {error,badarg} = trycatch(is_empty, [IQ]),
407    {error,badarg} = trycatch(len, [IQ]),
408    %%
409    {error,badarg} = trycatch(cons, [1, IQ]),
410    {error,badarg} = trycatch(head, [IQ]),
411    {error,badarg} = trycatch(tail, [IQ]),
412    %%
413    {error,badarg} = trycatch(snoc, [IQ, 1]),
414    {error,badarg} = trycatch(last, [IQ]),
415    {error,badarg} = trycatch(daeh, [IQ]),
416    {error,badarg} = trycatch(liat, [IQ]),
417    {error,badarg} = trycatch(lait, [IQ]),
418    {error,badarg} = trycatch(init, [IQ]),
419    %%
420    {error,badarg} = trycatch(reverse, [IQ]),
421    {error,badarg} = trycatch(join, [F(queue:new()), IQ]),
422    {error,badarg} = trycatch(join, [IQ, F(queue:new())]),
423    {error,badarg} = trycatch(split, [17, IQ]),
424    {error,badarg} = trycatch(head, [IQ]),
425    %%
426    Q0 = F(queue:new()),
427    {error,badarg} = trycatch(split, [1, Q0]),
428    {error,badarg} = trycatch(split, [2, queue:snoc(Q0, 1)]),
429    %%
430    {value,false}  = trycatch(is_queue, [IQ]),
431    {error,badarg} = trycatch(get, [IQ]),
432    {error,badarg} = trycatch(peek, [IQ]),
433    {error,badarg} = trycatch(peek_r, [IQ]),
434    {error,badarg} = trycatch(filter, [fun id/1, IQ]),
435    {error,badarg} = trycatch(filter, [no_fun, Q0]),
436    %%
437    {error,badarg} = trycatch(member, [1, IQ]),
438    ok.
439
440id(X) ->
441    X.
442
443%% Test queue errors.
444oops(Config) when is_list(Config) ->
445    N = 3142,
446    Optab = optab(),
447    Seed0 = rand:seed(exsplus, {1,2,4}),
448    {Is,Seed} = random_list(N, tuple_size(Optab), Seed0, []),
449    io:format("~p ", [Is]),
450    QA = queue:new(),
451    QB = {[]},
452    emul([QA], [QB], Seed, [element(I, Optab) || I <- Is]).
453
454optab() ->
455    {{new,[],        q,     fun ()     -> {[]} end},
456     {is_queue,[q],  v,     fun (_)    -> true end},
457     {is_empty,[q],  v,     fun (Q) ->
458				    case Q of
459					{[]} -> true;
460					_    -> false
461				    end end},
462     {len,[q],       v,     fun ({L})   -> length(L) end},
463     {to_list,[q],   v,     fun ({L})   -> L end},
464     {from_list,[l], q,     fun (L)     -> {L} end},
465     {in,[t,q],      q,     fun (X,{L}) -> {L++[X]} end},
466     {in_r,[t,q],    q,     fun (X,{L}) -> {[X|L]} end},
467     {out,[q],       {v,q}, fun ({L}=Q) ->
468				    case L of
469					[]    -> {empty,Q};
470					[X|T] -> {{value,X},{T}}
471				    end
472			    end},
473     {out_r,[q],     {v,q}, fun ({L}=Q) ->
474				    case L of
475					[]    -> {empty,Q};
476					_ ->
477					    [X|R] = lists:reverse(L),
478					    T = lists:reverse(R),
479					    {{value,X},{T}}
480				    end
481			    end},
482     {get,[q],       v,     fun ({[]})    -> erlang:error(empty);
483				({[H|_]}) -> H
484			    end},
485     {get_r,[q],     v,     fun ({[]})    -> erlang:error(empty);
486				({L})     -> lists:last(L)
487			    end},
488     {peek,[q],      v,     fun ({[]})    -> empty;
489				({[H|_]}) -> {value,H}
490			    end},
491     {peek_r,[q],    v,     fun ({[]})    -> empty;
492				({L})     -> {value,lists:last(L)}
493			    end},
494     {drop,[q],      q,     fun ({[]})    -> erlang:error(empty);
495				({[_|T]}) -> {T}
496			    end},
497     {drop_r,[q],    q,     fun ({[]})    -> erlang:error(empty);
498				({L})     -> [_|R] = lists:reverse(L),
499					     {lists:reverse(R)}
500			    end},
501     {reverse,[q],   q,     fun ({L})     -> {lists:reverse(L)} end},
502     {join,[q,q],    q,     fun ({L1}, {L2}) -> {L1++L2} end},
503     {split,[n,q],   {q,q}, fun (N, {L})  -> {L1,L2} = lists:split(N, L),
504					     {{L1},{L2}} end},
505     {member,[t,q],  v,     fun (X, {L})  -> lists:member(X, L) end}
506    }.
507
508emul(_, _, _, []) ->
509    ok;
510emul(QsA0, QsB0, Seed0, [{Op,Ts,S,Fun}|Ops]) ->
511    {AsA,Seed} = args(Ts, QsA0, Seed0, []),
512    {AsB,Seed} = args(Ts, QsB0, Seed0, []),
513    io:format("~n% ~w % ~p ", [Op,AsA]),
514    io:format("% ~p :", [AsB]),
515    XX = call({queue,Op}, AsA),
516    YY = call(Fun, AsB),
517    case {XX,YY} of
518	{{value,X},{value,Y}} ->
519	    {[Qa|_]=QsA,[{Lb}|_]=QsB} = chk(QsA0, QsB0, S, X, Y),
520	    case queue:to_list(Qa) of
521		Lb ->
522		    io:format("|~p| ", [Lb]),
523		    emul(QsA, QsB, Seed, Ops);
524		La ->
525		    throw({to_list,[XX,YY,Op,AsA,AsB,La,Lb]})
526	    end;
527	{Exception,Exception} ->
528	    io:format("!~p! ", [Exception]),
529	    emul(QsA0, QsB0, Seed, Ops);
530	_ ->
531	    throw({diff,[XX,YY,Op,AsA,AsB]})
532    end.
533
534args([], _, Seed, R) ->
535    {lists:reverse(R),Seed};
536args([q|Ts], [Q|Qs]=Qss, Seed, R) ->
537    args(Ts, if Qs =:= [] -> Qss; true -> Qs end, Seed, [Q|R]);
538args([l|Ts], Qs, Seed0, R) ->
539    {N,Seed1} = rand:uniform_s(17, Seed0),
540    {L,Seed} = random_list(N, 4711, Seed1, []),
541    args(Ts, Qs, Seed, [L|R]);
542args([t|Ts], Qs, Seed0, R) ->
543    {T,Seed} = rand:uniform_s(4711, Seed0),
544    args(Ts, Qs, Seed, [T|R]);
545args([n|Ts], Qs, Seed0, R) ->
546    {N,Seed} = rand:uniform_s(17, Seed0),
547    args(Ts, Qs, Seed, [N|R]).
548
549random_list(0, _, Seed, R) ->
550    {R,Seed};
551random_list(N, M, Seed0, R) ->
552    {X,Seed} = rand:uniform_s(M, Seed0),
553    random_list(N-1, M, Seed, [X|R]).
554
555call(Func, As) ->
556    try case Func of
557	    {M,F} -> apply(M, F, As);
558	    _     -> apply(Func, As)
559	end of
560	V ->
561	    {value,V}
562    catch
563	Class:Reason ->
564	    {Class,Reason}
565    end.
566
567chk(QsA, QsB, v, X, X) ->
568    io:format("<~p> ", [X]),
569    {QsA,QsB};
570chk(_, _, v, X, Y) ->
571    throw({diff,v,[X,Y]});
572chk(QsA, QsB, q, Qa, {Lb}=Qb) ->
573    case queue:to_list(Qa) of
574	Lb ->
575	    io:format("|~p| ", [Lb]),
576	    {[Qa|QsA],[Qb|QsB]};
577	La ->
578	    throw({diff,q,[Qa,La,Lb]})
579    end;
580chk(QsA, QsB, T, X, Y)
581  when tuple_size(T) =:= tuple_size(X), tuple_size(T) =:= tuple_size(Y) ->
582    io:format("{"),
583    try
584	chk_tuple(QsA, QsB, T, X, Y, 1)
585    after
586	io:format("}")
587    end;
588chk(_, _, T, X, Y)
589  when is_tuple(T), is_tuple(X), is_tuple(Y) ->
590    throw({diff,T,[X,Y]}).
591
592chk_tuple(QsA, QsB, T, _, _, N) when N > tuple_size(T) ->
593    {QsA,QsB};
594chk_tuple(QsA0, QsB0, T, X, Y, N) ->
595    {QsA,QsB} = chk(QsA0, QsB0, element(N, T), element(N, X), element(N, Y)),
596    chk_tuple(QsA, QsB, T, X, Y, N+1).
597