1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2001-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(file_sorter_SUITE).
21
22%%-define(debug, true).
23
24-ifdef(debug).
25-define(format(S, A), io:format(S, A)).
26-define(line, put(line, ?LINE), ).
27-define(config(X,Y), foo).
28-define(t,test_server).
29-define(privdir(_), "./file_sorter_SUITE_priv").
30-else.
31-include_lib("common_test/include/ct.hrl").
32-define(format(S, A), ok).
33-define(privdir(Conf), proplists:get_value(priv_dir, Conf)).
34-endif.
35
36-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
37	 init_per_group/2,end_per_group/2, basic/1, badarg/1,
38	 term_sort/1, term_keysort/1,
39	 binary_term_sort/1, binary_term_keysort/1,
40	 binary_sort/1,
41	 term_merge/1, term_keymerge/1,
42	 binary_term_merge/1, binary_term_keymerge/1,
43	 binary_merge/1,
44	 term_check/1, term_keycheck/1,
45	 binary_term_check/1, binary_term_keycheck/1,
46	 binary_check/1,
47	 inout/1, misc/1, many/1]).
48
49-export([init_per_testcase/2, end_per_testcase/2]).
50
51init_per_testcase(_Case, Config) ->
52    Config.
53
54end_per_testcase(_Case, _Config) ->
55    ok.
56
57suite() ->
58    [{ct_hooks,[ts_install_cth]},
59     {timetrap,{minutes,2}}].
60
61all() ->
62    [basic, badarg, term_sort, term_keysort,
63     binary_term_sort, binary_term_keysort, binary_sort,
64     term_merge, term_keymerge, binary_term_merge,
65     binary_term_keymerge, binary_merge, term_check,
66     binary_term_keycheck, binary_term_check,
67     binary_term_keycheck, binary_check, inout, misc, many].
68
69groups() ->
70    [].
71
72init_per_suite(Config) ->
73    Config.
74
75end_per_suite(_Config) ->
76    ok.
77
78init_per_group(_GroupName, Config) ->
79    Config.
80
81end_per_group(_GroupName, Config) ->
82    Config.
83
84
85%% Basic test case.
86basic(Config) when is_list(Config) ->
87    Fmt = binary,
88    Arg = {format,Fmt},
89    Foo = outfile("foo", Config),
90    P0 = pps(),
91
92    F1s = [F1] = to_files([[]], Fmt, Config),
93    ok = file_sorter:sort(F1),
94    [] = from_files(F1, Fmt),
95    ok = file_sorter:keysort(17, F1),
96    [] = from_files(F1, Fmt),
97    ok = file_sorter:merge(F1s, Foo),
98    [] = from_files(Foo, Fmt),
99    delete_files(Foo),
100    ok = file_sorter:keymerge(17, F1s, Foo),
101    [] = from_files(Foo, Fmt),
102    delete_files([Foo | F1s]),
103
104    [F2] = to_files([[foo,bar]], Fmt, Config),
105    ok = file_sorter:sort([F2], F2, Arg),
106    [bar,foo] = from_files(F2, Fmt),
107    delete_files(F2),
108
109    Fs1 = to_files([[foo],[bar]], Fmt, Config),
110    ok = file_sorter:sort(Fs1, Foo, Arg),
111    [bar,foo] = from_files(Foo, Fmt),
112    delete_files(Foo),
113    ok = file_sorter:merge(Fs1, Foo, Arg),
114    [bar,foo] = from_files(Foo, Fmt),
115    delete_files([Foo | Fs1]),
116
117    Fmt2 = binary_term,
118    Arg2 = {format, Fmt2},
119    [F3] = to_files([[{foo,1},{bar,2}]], Fmt2, Config),
120    ok = file_sorter:keysort([2], [F3], F3, Arg2),
121    [{foo,1},{bar,2}] = from_files(F3, Fmt2),
122    delete_files(F3),
123
124    Fs2 = to_files([[{foo,1}],[{bar,2}]], Fmt2, Config),
125    ok = file_sorter:keysort(1, Fs2, Foo, Arg2),
126    [{bar,2},{foo,1}] = from_files(Foo, Fmt2),
127    delete_files(Foo),
128    ok = file_sorter:keymerge(1, Fs2, Foo, Arg2),
129    [{bar,2},{foo,1}] = from_files(Foo, Fmt2),
130    delete_files([Foo | Fs2]),
131
132    true = P0 =:= pps(),
133
134    ok.
135
136%% Call functions with bad arguments.
137badarg(Config) when is_list(Config) ->
138    PrivDir = ?privdir(Config),
139    BadFile = filename:join(PrivDir, "not_a_file"),
140    ABadFile = filename:absname(BadFile),
141    file:delete(BadFile),
142    {error,{file_error,ABadFile,enoent}} =
143	file_sorter:sort(BadFile),
144    {'EXIT', {{badarg, {flipp}}, _}} =
145	(catch file_sorter:sort({flipp})),
146    {error,{file_error,ABadFile,enoent}} =
147	file_sorter:keysort(1, BadFile),
148    {'EXIT', {{badarg, {flipp}}, _}} =
149	(catch file_sorter:keysort(1, {flipp})),
150
151    {'EXIT', {{badarg, {flipp}}, _}} =
152	(catch file_sorter:merge([{flipp}],foo)),
153    {error,{file_error,ABadFile,enoent}} =
154	file_sorter:keymerge(1,[BadFile],foo),
155    {'EXIT', {{badarg, {flipp}}, _}} =
156	(catch file_sorter:keymerge(1,[{flipp}],foo)),
157    {'EXIT', {{badarg, _}, _}} =
158	(catch file_sorter:merge(fun(X) -> X end, foo)),
159    {'EXIT', {{badarg, _}, _}} =
160	(catch file_sorter:keymerge(1, fun(X) -> X end, foo)),
161
162    {error,{file_error,ABadFile,enoent}} =
163	file_sorter:check(BadFile),
164    {'EXIT', {{badarg, {flipp}}, _}} =
165	(catch file_sorter:check({flipp})),
166    {error,{file_error,ABadFile,enoent}} =
167	file_sorter:keycheck(1, BadFile),
168    {'EXIT', {{badarg, {flipp}}, _}} =
169	(catch file_sorter:keycheck(1, {flipp})),
170    {'EXIT', {{badarg, {flipp}}, _}} =
171	(catch file_sorter:check([{flipp}],foo)),
172    {'EXIT', {{badarg, {flipp}}, _}} =
173	(catch file_sorter:keycheck(1,[{flipp}],foo)),
174    {'EXIT', {{badarg, _}, _}} =
175	(catch file_sorter:check(fun(X) -> X end, foo)),
176    {'EXIT', {{badarg, _}, _}} =
177	(catch file_sorter:keycheck(1, fun(X) -> X end, foo)),
178
179    Fs1 = to_files([[1,2,3]], binary_term, Config),
180    {'EXIT', {{badarg, flipp}, _}} =
181	(catch file_sorter:check(Fs1 ++ flipp, [])),
182    [F1] = Fs1,
183    {error,{file_error,_,_}} =
184        file_sorter:sort(Fs1, foo, [{tmpdir,F1},{size,0}]),
185    delete_files(Fs1),
186    Fs2 = to_files([[1,2,3]], binary_term, Config),
187    {error,{file_error,_,enoent}} =
188	file_sorter:sort(Fs2, foo, [{tmpdir,filename:absname(BadFile)},
189                                    {size,0}]),
190    delete_files(Fs2),
191
192    {'EXIT', {{badarg, bad}, _}} =
193	(catch file_sorter:check([], [{format,term} | bad])),
194    {'EXIT', {{badarg, [{flipp}]}, _}} =
195	(catch file_sorter:check([{flipp}])),
196    {'EXIT', {{badarg, {flipp}}, _}} =
197	(catch file_sorter:keycheck(1, {flipp})),
198    {'EXIT', {{badarg, [{flipp}]}, _}} =
199	(catch file_sorter:keycheck(2, [{flipp}])),
200    {error,{file_error,_,eisdir}} = file_sorter:keycheck(1, []),
201    {'EXIT', {{badarg, kp}, _}} = (catch file_sorter:keycheck(kp, [])),
202    {'EXIT', {{badarg, kp}, _}} =
203	(catch file_sorter:keycheck([1, kp], [])),
204    {'EXIT', {{badarg, kp}, _}} =
205	(catch file_sorter:keycheck([1 | kp], [])),
206    {'EXIT', {{badarg, []}, _}} = (catch file_sorter:keycheck([], [])),
207    {'EXIT', {{badarg, {format, foo}}, _}} =
208	(catch file_sorter:check([], {format,foo})),
209    {'EXIT', {{badarg, not_an_option}, _}} =
210	(catch file_sorter:keycheck(7, [], [not_an_option])),
211    {'EXIT', {{badarg, format}, _}} =
212	(catch file_sorter:keycheck(1, [], [{format, binary}])),
213    {'EXIT', {{badarg, order}, _}} =
214	(catch file_sorter:keycheck(1, [], [{order, fun compare/2}])),
215
216    do_badarg(fun(I, O) -> file_sorter:sort(I, O) end,
217	      fun(Kp, I, O) -> file_sorter:keysort(Kp, I, O) end,
218	      BadFile),
219    do_badarg_opt(fun(I, O, X) -> file_sorter:sort(I, O, X) end,
220		  fun(Kp, I, O, X) -> file_sorter:keysort(Kp, I, O, X)
221		  end),
222    do_badarg(fun(I, O) -> file_sorter:merge(I, O) end,
223	      fun(Kp, I, O) -> file_sorter:keymerge(Kp, I, O) end,
224	      BadFile),
225    do_badarg_opt(fun(I, O, X) -> file_sorter:merge(I, O, X) end,
226		  fun(Kp, I, O, X) -> file_sorter:keymerge(Kp, I, O, X)
227		  end).
228
229do_badarg(F, KF, BadFile) ->
230    [Char | _] = BadFile,
231    AFlipp = filename:absname(flipp),
232    {error,{file_error,AFlipp,enoent}} = F([flipp | flopp], foo),
233    {'EXIT', {{badarg, {foo,bar}}, _}} = (catch F([], {foo,bar})),
234    {'EXIT', {{badarg, Char}, _}} = (catch F(BadFile, [])),
235    {'EXIT', {{badarg, {flipp}}, _}} = (catch F({flipp}, [])),
236
237    {'EXIT', {{badarg, Char}, _}} = (catch KF(1, BadFile, [])),
238    {'EXIT', {{badarg, {flipp}}, _}} = (catch KF(1, {flipp}, [])),
239    {error,{file_error,AFlipp,enoent}} =
240	KF(2, [flipp | flopp], foo),
241    {'EXIT', {{badarg, {foo,bar}}, _}} = (catch KF(1, [], {foo,bar})),
242    {'EXIT', {{badarg, kp}, _}} = (catch KF(kp, [], foo)),
243    {'EXIT', {{badarg, kp}, _}} = (catch KF([1, kp], [], foo)),
244    {'EXIT', {{badarg, kp}, _}} = (catch KF([1 | kp], [], foo)),
245    {'EXIT', {{badarg, []}, _}} = (catch KF([], [], foo)),
246    ok.
247
248do_badarg_opt(F, KF) ->
249    AFlipp = filename:absname(flipp),
250    {error,{file_error,AFlipp,enoent}} =
251	F([flipp | flopp], foo, []),
252    {'EXIT', {{badarg, {flipp}}, _}} = (catch F([{flipp}], foo, [])),
253    {'EXIT', {{badarg, {out,put}}, _}} = (catch F([], {out,put}, [])),
254    {'EXIT', {{badarg, not_an_option}, _}} =
255	(catch F([], foo, [not_an_option])),
256    {'EXIT', {{badarg, {format, foo}}, _}} =
257	(catch F([], foo, {format,foo})),
258    {'EXIT', {{badarg, {size,foo}}, _}} = (catch F([], foo, {size,foo})),
259
260    {'EXIT', {{badarg, {size, -1}}, _}} = (catch F([], foo, {size,-1})),
261    {'EXIT', {{badarg, {no_files, foo}}, _}} =
262	(catch F([], foo, {no_files,foo})),
263    {'EXIT', {{badarg, {no_files, 1}}, _}} =
264	(catch F([], foo, {no_files,1})),
265    {'EXIT', {{badarg, 1}, _}} = (catch F([], foo, {tmpdir,1})),
266    {'EXIT', {{badarg, {order,1}}, _}} = (catch F([], foo, {order,1})),
267    {'EXIT', {{badarg, {compressed, flopp}}, _}} =
268	(catch F([], foo, {compressed,flopp})),
269    {'EXIT', {{badarg, {unique,flopp}}, _}} =
270	(catch F([], foo, {unique,flopp})),
271    {'EXIT', {{badarg, {header,foo}}, _}} =
272	(catch F([], foo, {header,foo})),
273    {'EXIT', {{badarg, {header, 0}}, _}} =
274	(catch F([], foo, {header,0})),
275    {'EXIT', {{badarg, {header, 1 bsl 35}}, _}} =
276	(catch F([], foo, {header,1 bsl 35})),
277    {'EXIT', {{badarg, header}, _}} =
278	(catch F([], foo, [{header,1},{format,term}])),
279
280    {'EXIT', {{badarg, not_an_option}, _}} =
281	(catch KF(7, [], foo, [not_an_option])),
282    {'EXIT', {{badarg,format}, _}} =
283	(catch KF(1, [], foo, [{format, binary}])),
284    {'EXIT', {{badarg, order}, _}} =
285	(catch KF(1, [], foo, [{order, fun compare/2}])),
286    {'EXIT', {{badarg, {flipp}}, _}} =
287	(catch KF(2, [{flipp}], foo,[])),
288    {error,{file_error,AFlipp,enoent}} =
289	KF(2, [flipp | flopp], foo,[]),
290    {'EXIT', {{badarg, {out, put}}, _}} =
291	(catch KF(1, [], {out,put}, [])),
292    {'EXIT', {{badarg, kp}, _}} = (catch KF(kp, [], foo, [])),
293    {'EXIT', {{badarg, kp}, _}} = (catch KF([1, kp], [], foo, [])),
294    {'EXIT', {{badarg, kp}, _}} = (catch KF([1 | kp], [], foo, [])),
295    ok.
296
297%% Sort terms on files.
298term_sort(Config) when is_list(Config) ->
299    sort(term, [{compressed,false}], Config),
300    sort(term, [{order, fun compare/2}], Config),
301    sort(term, [{order, ascending}, {compressed,true}], Config),
302    sort(term, [{order, descending}], Config),
303    ok.
304
305%% Keysort terms on files.
306term_keysort(Config) when is_list(Config) ->
307    keysort(term, [{tmpdir, ""}], Config),
308    keysort(term, [{order,descending}], Config),
309    ok.
310
311%% Sort binary terms on files.
312binary_term_sort(Config) when is_list(Config) ->
313    PrivDir = ?privdir(Config),
314    sort({2, binary_term}, [], Config),
315    sort(binary_term, [{tmpdir, list_to_atom(PrivDir)}], Config),
316    sort(binary_term, [{tmpdir,PrivDir}], Config),
317    sort({3,binary_term}, [{order, fun compare/2}], Config),
318    sort(binary_term, [{order, fun compare/2}], Config),
319    sort(binary_term, [{order,descending}], Config),
320    ok.
321
322%% Keysort binary terms on files.
323binary_term_keysort(Config) when is_list(Config) ->
324    keysort({3, binary_term}, [], Config),
325    keysort(binary_term, [], Config),
326    keysort(binary_term, [{order,descending}], Config),
327    ok.
328
329%% Sort binaries on files.
330binary_sort(Config) when is_list(Config) ->
331    PrivDir = ?privdir(Config),
332    sort({2, binary}, [], Config),
333    sort(binary, [{tmpdir, list_to_atom(PrivDir)}], Config),
334    sort(binary, [{tmpdir,PrivDir}], Config),
335    sort({3,binary}, [{order, fun compare/2}], Config),
336    sort(binary, [{order, fun compare/2}], Config),
337    sort(binary, [{order,descending}], Config),
338    ok.
339
340%% Merge terms on files.
341term_merge(Config) when is_list(Config) ->
342    merge(term, [{order, fun compare/2}], Config),
343    merge(term, [{order, ascending}, {compressed,true}], Config),
344    merge(term, [{order, descending}, {compressed,false}], Config),
345    ok.
346
347%% Keymerge terms on files.
348term_keymerge(Config) when is_list(Config) ->
349    keymerge(term, [], Config),
350    keymerge(term, [{order, descending}], Config),
351    funmerge(term, [], Config),
352    ok.
353
354%% Merge binary terms on files.
355binary_term_merge(Config) when is_list(Config) ->
356    merge(binary_term, [], Config),
357    merge({7, binary_term}, [], Config),
358    merge({3, binary_term}, [{order, fun compare/2}], Config),
359    ok.
360
361%% Keymerge binary terms on files.
362binary_term_keymerge(Config) when is_list(Config) ->
363    keymerge({3, binary_term}, [], Config),
364    keymerge(binary_term, [], Config),
365    funmerge({3, binary_term}, [], Config),
366    funmerge(binary_term, [], Config),
367    ok.
368
369%% Merge binaries on files.
370binary_merge(Config) when is_list(Config) ->
371    merge(binary, [], Config),
372    merge({7, binary}, [], Config),
373    merge({3, binary}, [{order, fun compare/2}], Config),
374    ok.
375
376%% Check terms on files.
377term_check(Config) when is_list(Config) ->
378    check(term, Config),
379    ok.
380
381%% Check binary terms on files.
382binary_term_check(Config) when is_list(Config) ->
383    check(binary_term, Config),
384    ok.
385
386%% Keycheck terms on files.
387term_keycheck(Config) when is_list(Config) ->
388    keycheck(term, Config),
389    ok.
390
391%% Keycheck binary terms on files.
392binary_term_keycheck(Config) when is_list(Config) ->
393    keycheck(binary_term, Config),
394    ok.
395
396%% Check binary terms on files.
397binary_check(Config) when is_list(Config) ->
398    check(binary, Config),
399    ok.
400
401%% Funs as input or output.
402inout(Config) when is_list(Config) ->
403    BTF = {format, binary_term},
404    Foo = outfile("foo", Config),
405
406    %% Input is fun.
407    End = fun(read) -> end_of_input end,
408
409    IF1 = fun(read) -> {[1,7,5], End} end,
410    ok = file_sorter:sort(IF1, Foo, [{format, term}]),
411    %% 'close' is called, but the return value is caught and ignored.
412    IF2 = fun(read) -> {[1,2,3], fun(close) -> throw(ignored) end} end,
413    {error, bad_object} = file_sorter:sort(IF2, Foo, BTF),
414
415    IF3 = fun(no_match) -> foo end,
416    {'EXIT', {function_clause, _}} =
417	(catch file_sorter:sort(IF3, Foo)),
418    IF4 = fun(read) -> throw(my_message) end,
419    my_message = (catch file_sorter:sort(IF4, Foo)),
420    IF5 = fun(read) -> {error, my_error} end,
421    {error, my_error} = file_sorter:sort(IF5, Foo),
422
423    %% Output is fun.
424    {error, bad_object} =
425	file_sorter:sort(IF2, fun(close) -> ignored end, BTF),
426    Args = [{format, term}],
427    {error, bad_object} =
428	file_sorter:keysort(1, IF2, fun(close) -> ignored end, Args),
429    OF1 = fun(close) -> fine; (L) when is_list(L) -> fun(close) -> nice end end,
430    nice = file_sorter:sort(IF1, OF1, Args),
431    OF2 = fun(_) -> my_return end,
432    my_return = file_sorter:sort(IF1, OF2, Args),
433    OF3 = fun(_) -> throw(my_message) end,
434    my_message = (catch file_sorter:sort(IF1, OF3, Args)),
435    OF4 = fun(no_match) -> foo end,
436    {'EXIT', {function_clause, _}} =
437	(catch file_sorter:sort(IF1, OF4, Args)),
438
439    P0 = pps(),
440    Fs1 = to_files([[3,1,2,5,4], [8,3,10]], term, Config),
441    error = file_sorter:sort(Fs1, fun(_) -> error end, Args),
442    delete_files(Fs1),
443
444    true = P0 =:= pps(),
445
446    %% Passing a value from the input functions to the output functions.
447    IFV1 = fun(read) -> {end_of_input, 17} end,
448    OFV1 = fun({value, Value}) -> ofv(Value, []) end,
449    {17, []} = file_sorter:sort(IFV1, OFV1, Args),
450
451    %% Output is not a fun. The value returned by input funs is ignored.
452    %% OTP-5009.
453    ok = file_sorter:sort(IFV1, Foo, [{format,term}]),
454    [] = from_files(Foo, term),
455    delete_files(Foo),
456
457    ok.
458
459ofv(Value, A) ->
460    fun(close) ->
461	    {Value, lists:append(lists:reverse(A))};
462       (L) when is_list(L) ->
463	    ofv(Value, [L | A])
464    end.
465
466%% Many temporary files.
467many(Config) when is_list(Config) ->
468    Foo = outfile("foo", Config),
469    PrivDir = ?privdir(Config),
470    P0 = pps(),
471
472    Args = [{format, term}],
473    L1 = lists:map(fun(I) -> {one, two, three, I} end, lists:seq(1,1000)),
474    L2 = lists:map(fun(I) -> {four, five, six, I} end, lists:seq(1,1000)),
475    Fs2 = to_files([L1, L2], term, Config),
476    ok = file_sorter:sort(Fs2, Foo, [{size,1000} | Args]),
477    R = lists:sort(L1++L2),
478    R = from_files(Foo, term),
479    2000 = length(R),
480    ok = file_sorter:sort(Fs2, Foo, [{no_files,4},{size,1000} | Args]),
481    R = from_files(Foo, term),
482    ok =
483	file_sorter:sort(Fs2, Foo,
484			 [{no_files,4},{size,1000},{order,descending} | Args]),
485    true = lists:reverse(R) =:= from_files(Foo, term),
486    ok =
487	file_sorter:sort(Fs2, Foo,
488			 [{no_files,4},{size,1000},
489			  {order,fun compare/2} | Args]),
490    R = from_files(Foo, term),
491    ok = file_sorter:keysort(4, Fs2, Foo,
492			     [{no_files,4},{size,1000} | Args]),
493    RK = lists:keysort(4, L1++L2),
494    RK = from_files(Foo, term),
495    delete_files(Foo),
496    ok =
497	file_sorter:keysort(4, Fs2, Foo,
498			    [{no_files,4},{size,1000},{order,descending} | Args]),
499    true = lists:reverse(RK) =:= from_files(Foo, term),
500    delete_files(Foo),
501    ok = file_sorter:keysort(4, Fs2, Foo,
502			     [{size,500},{order,descending} | Args]),
503    true = lists:reverse(RK) =:= from_files(Foo, term),
504    delete_files(Foo),
505    error = file_sorter:sort(Fs2, fun(_) -> error end,
506			     [{tmpdir, PrivDir}, {no_files,3},
507			      {size,10000} | Args]),
508
509    TmpDir = filename:join(PrivDir, "tmpdir"),
510    file:del_dir(TmpDir),
511    ok = file:make_dir(TmpDir),
512    case os:type() of
513	{unix, _} ->
514	    ok = file:change_mode(TmpDir, 8#0000),
515	    {error, {file_error, _,_}} =
516		file_sorter:sort(Fs2, fun(_M) -> foo end,
517				 [{no_files,3},{size,10000},
518				  {tmpdir,TmpDir} | Args]);
519	_ ->
520	    true
521    end,
522    ok = file:del_dir(TmpDir),
523    delete_files(Fs2),
524    true = P0 =:= pps(),
525    ok.
526
527%% Some other tests.
528misc(Config) when is_list(Config) ->
529    BTF = {format, binary_term},
530    Foo = outfile("foo", Config),
531    FFoo = filename:absname(Foo),
532    P0 = pps(),
533
534    [File] = Fs1 = to_files([[1,3,2]], term, Config),
535    ok = file:write_file(Foo,<<>>),
536    case os:type() of
537	{unix, _} ->
538	    ok = file:change_mode(Foo, 8#0000),
539	    {error,{file_error,FFoo,eacces}} =
540		file_sorter:sort(Fs1, Foo, {format,term});
541	_ ->
542	    true
543    end,
544    file:delete(Foo),
545    NoBytes = 16, % RAM memory will never get this big, or?
546    ALot = (1 bsl (NoBytes*8)) - 1,
547    ok = file:write_file(File, <<ALot:NoBytes/unit:8,"foobar">>),
548    FFile = filename:absname(File),
549    {error, {bad_object,FFile}} =
550        file_sorter:sort(Fs1, Foo, [BTF, {header, 20}]),
551    ok = file:write_file(File, <<30:32,"foobar">>),
552    {error, {premature_eof, FFile}} = file_sorter:sort(Fs1, Foo, BTF),
553    ok = file:write_file(File, <<6:32,"foobar">>),
554    {error, {bad_object,FFile}} = file_sorter:sort(Fs1, Foo, BTF),
555    case os:type() of
556	{unix, _} ->
557	    ok = file:change_mode(File, 8#0000),
558	    {error, {file_error,FFile,eacces}} =
559		file_sorter:sort(Fs1, Foo),
560	    {error, {file_error,FFile,eacces}} =
561		file_sorter:sort(Fs1, Foo, {format, binary_term});
562	_ ->
563	    true
564    end,
565    delete_files(Fs1),
566    true = P0 =:= pps(),
567
568    %% bigger than chunksize
569    E1 = <<32000:32, 10:256000>>,
570    E2 = <<32000:32, 5:256000>>,
571    E3 = <<32000:32, 8:256000>>,
572    ok = file:write_file(Foo, [E1, E2, E3]),
573    ok = file_sorter:sort([Foo], Foo, [{format,binary},{size,10000}]),
574    ok = file_sorter:sort([Foo], Foo, [{format,fun(X) -> X end},
575				       {size,10000}]),
576    Es = list_to_binary([E2,E3,E1]),
577    {ok, Es} = file:read_file(Foo),
578    delete_files(Foo),
579    true = P0 =:= pps(),
580
581    %% keysort more than one element
582    L = [{c,1,a},{c,2,b},{c,3,c},{b,1,c},{b,2,b},{b,3,a},{a,1,a},{a,2,b},
583         {a,3,c}],
584    Fs2 = to_files([L], binary_term, Config),
585    ok = file_sorter:keysort([2,3], Fs2, Foo, {format, binary_term}),
586    KS2_1 = from_files(Foo, binary_term),
587    KS2_2 = lists:keysort(2,lists:keysort(3, L)),
588    KS2_1 = KS2_2,
589    ok = file_sorter:keysort([2,3], Fs2, Foo,
590			     [{format, binary_term},{size,5}]),
591    KS2_3 = from_files(Foo, binary_term),
592    KS2_3 = KS2_2,
593    ok = file_sorter:keysort([2,3,1], Fs2, Foo, {format, binary_term}),
594    KS3_1 = from_files(Foo, binary_term),
595    KS3_2 = lists:keysort(2, lists:keysort(3,lists:keysort(1, L))),
596    KS3_1 = KS3_2,
597    ok = file_sorter:keysort([2,3,1], Fs2, Foo,
598			     [{format, binary_term},{size,5}]),
599    KS3_3 = from_files(Foo, binary_term),
600    KS3_3 = KS3_2,
601    delete_files([Foo | Fs2]),
602    true = P0 =:= pps(),
603
604    %% bigger than chunksize
605    %% Assumes that CHUNKSIZE = 16384. Illustrates that the Last argument
606    %% of merge_files/5 is necessary.
607    EP1 = erlang:make_tuple(2728,foo),
608    EP2 = lists:duplicate(2729,qqq),
609    LL = [EP1, EP2, EP1, EP2, EP1, EP2],
610    Fs3 = to_files([LL], binary, Config),
611    ok = file_sorter:sort(Fs3, Foo, [{format,binary}, {unique,true}]),
612    [EP1,EP2] = from_files(Foo, binary),
613    delete_files(Foo),
614    ok = file_sorter:sort(Fs3, Foo,
615			  [{format,binary_term}, {unique,true},
616			   {size,30000}]),
617    [EP1,EP2] = from_files(Foo, binary_term),
618    delete_files([Foo | Fs3]),
619
620    true = P0 =:= pps(),
621
622    BE1 = <<20000:32, 17:160000>>,
623    BE2 = <<20000:32, 1717:160000>>,
624    ok = file:write_file(Foo, [BE1,BE2,BE1,BE2]),
625    ok = file_sorter:sort([Foo], Foo, [{format,binary},
626				       {size,10000},
627				       {unique,true}]),
628    BEs = list_to_binary([BE1, BE2]),
629    {ok, BEs} = file:read_file(Foo),
630    delete_files(Foo),
631    true = P0 =:= pps(),
632
633    Fs4 = to_files([[7,4,1]], binary_term, Config),
634    {error, {bad_term, _}} = file_sorter:sort(Fs4, Foo, {format, term}),
635    delete_files([Foo | Fs4]),
636    true = P0 =:= pps(),
637
638    ok.
639
640%%%
641%%% Utilities.
642%%%
643
644sort(Fmt, XArgs, Config) ->
645    Args = make_args(Fmt, [{size,5} | XArgs]),
646    TmpArgs = [{tmpdir,?privdir(Config)} | Args],
647    Foo = outfile("foo", Config),
648
649    %% Input is a fun. Output is a fun.
650    [] = file_sorter:sort(input([], 2, Fmt), output([], Fmt), Args),
651    L1 = [3,1,2,5,4],
652    S1 = file_sorter:sort(input(L1, 2, Fmt), output([], Fmt), TmpArgs),
653    S1 = rev(lists:sort(L1), TmpArgs),
654
655    %% Input is a file. Output is a fun.
656    [] = file_sorter:sort([], output([], Fmt), Args),
657    L2 = [3,1,2,5,4],
658    Fs1 = to_files([L2], Fmt, Config),
659    S2 = file_sorter:sort(Fs1, output([], Fmt), TmpArgs),
660    S2 = rev(lists:sort(L2), TmpArgs),
661    delete_files(Fs1),
662
663    %% Input is a file. Output is a file
664    ok = file_sorter:sort([], Foo, Args),
665    [] = from_files(Foo, Fmt),
666    delete_files(Foo),
667    ok = file_sorter:sort([], Foo, [{unique,true} | Args]),
668    [] = from_files(Foo, Fmt),
669    delete_files(Foo),
670    L3 = [3,1,2,5,4,6],
671    Fs2 = to_files([L3], Fmt, Config),
672    ok = file_sorter:sort(Fs2, Foo, Args),
673    true = rev(lists:sort(L3), Args) =:= from_files(Foo, Fmt),
674    delete_files([Foo | Fs2]),
675    L4 = [1,3,4,1,2,5,4,5,6],
676    Fs3 = to_files([L4], Fmt, Config),
677    ok = file_sorter:sort(Fs3, Foo, Args++[{unique,true},
678					   {size,100000}]),
679    true = rev(lists:usort(L4), Args) =:= from_files(Foo, Fmt),
680    delete_files(Foo),
681    ok = file_sorter:sort(Fs3, Foo, Args++[{unique,true}]),
682    true = rev(lists:usort(L4), Args) =:= from_files(Foo, Fmt),
683    delete_files([Foo | Fs3]),
684
685    %% Input is a fun. Output is a file.
686    ok = file_sorter:sort(input([], 2, Fmt), Foo, Args),
687    [] = from_files(Foo, Fmt),
688    delete_files(Foo),
689    L5 = [3,1,2,5,4,7],
690    ok = file_sorter:sort(input(L5, 2, Fmt), Foo, Args),
691    true = rev(lists:sort(L5), Args) =:= from_files(Foo, Fmt),
692    delete_files(Foo),
693
694    %% Removing duplicate keys.
695    KFun = key_compare(2),
696    L6 = [{5,e},{2,b},{3,c},{1,a},{4,d}] ++ [{2,c},{1,b},{4,a}],
697    KUArgs = lists:keydelete(order, 1, Args) ++
698	[{unique, true}, {order, KFun},{size,100000}],
699    ok = file_sorter:sort(input(L6, 2, Fmt), Foo, KUArgs),
700    true = rev(lists:ukeysort(2, L6), KUArgs) =:= from_files(Foo, Fmt),
701    KArgs = lists:keydelete(unique, 1, KUArgs),
702    ok = file_sorter:sort(input(L6, 2, Fmt), Foo, KArgs),
703    true = rev(lists:keysort(2, L6), KArgs) =:= from_files(Foo, Fmt),
704
705    %% Removing duplicate keys. Again.
706    KUArgs2 = lists:keydelete(order, 1, Args) ++
707	[{unique, true}, {order, KFun},{size,5}],
708    ok = file_sorter:sort(input(L6, 2, Fmt), Foo, KUArgs2),
709    true = rev(lists:ukeysort(2, L6), KUArgs2) =:= from_files(Foo, Fmt),
710    KArgs2 = lists:keydelete(unique, 1, KUArgs2),
711    ok = file_sorter:sort(input(L6, 2, Fmt), Foo, KArgs2),
712    true = rev(lists:keysort(2, L6), KArgs2) =:= from_files(Foo, Fmt),
713    delete_files(Foo),
714
715    ok.
716
717keysort(Fmt, XArgs, Config) ->
718    Args = make_args(Fmt, [{size,50}, {no_files, 2} | XArgs]),
719    TmpArgs = Args ++ [{tmpdir,?privdir(Config)}],
720    Foo = outfile("foo", Config),
721
722    %% Input is files. Output is a file.
723    ok = file_sorter:keysort(2, [], Foo, Args),
724    [] = from_files(Foo, Fmt),
725    delete_files(Foo),
726    ok = file_sorter:keysort(2, [], Foo, [{unique,true} | Args]),
727    [] = from_files(Foo, Fmt),
728    delete_files(Foo),
729    L0 = [{a,2},{a,1},{a,2},{a,2},{a,1},{a,2},{a,2},{a,3}],
730    Fs0 = to_files([L0], Fmt, Config),
731    S = rev(lists:ukeysort(1, L0), Args),
732    ok =
733	file_sorter:keysort(1, Fs0, Foo, Args ++ [{unique,true},
734						  {size,100000}]),
735    S = from_files(Foo, Fmt),
736    ok =
737	file_sorter:keysort(1, Fs0, Foo, Args ++ [{unique,true},
738						  {size,5}]),
739    S = from_files(Foo, Fmt),
740    ok = file_sorter:keysort(1, Fs0, Foo, Args ++ [{unique,true}]),
741    S = from_files(Foo, Fmt),
742    delete_files([Foo | Fs0]),
743    L11 = [{a,1,x4},{b,2,x4},{c,3,x4}],
744    L21 = [{a,1,x3},{b,2,x3},{c,3,x3}],
745    L31 = [{a,1,x2},{b,2,x2},{c,3,x2}],
746    L41 = [{a,1,x1},{b,2,x1},{c,3,x1}],
747    All = [L11, L21, L31, L41],
748    AllFlat = lists:append(All),
749    Sorted = rev(lists:keysort(2, AllFlat), Args),
750    Fs1 = to_files(All, Fmt, Config),
751    ok = file_sorter:keysort(2, Fs1, Foo, Args),
752    Sorted = from_files(Foo, Fmt),
753    delete_files(Foo),
754
755    %% Input is files. Output is a fun.
756    [] = file_sorter:keysort(2, [], output([], Fmt), Args),
757    KS1 = file_sorter:keysort(2, Fs1, output([], Fmt), TmpArgs),
758    Sorted = KS1,
759    delete_files(Fs1),
760
761    %% Input is a fun. Output is a file.
762    ok = file_sorter:keysort(2, input([], 2, Fmt), Foo, Args),
763    [] = from_files(Foo, Fmt),
764    delete_files(Foo),
765    ok = file_sorter:keysort(2, input(AllFlat, 4, Fmt), Foo, Args),
766    Sorted = from_files(Foo,  Fmt),
767    delete_files(Foo),
768
769    %% Input is a fun. Output is a fun.
770    [] = file_sorter:keysort(2, input([], 2, Fmt), output([], Fmt),Args),
771    KS2 =
772	file_sorter:keysort(2, input(AllFlat, 4, Fmt), output([], Fmt),
773			    TmpArgs),
774    Sorted = KS2,
775    ok.
776
777merge(Fmt, XArgs, Config) ->
778    Args = make_args(Fmt, [{size,5} | XArgs]),
779    Foo = outfile("foo", Config),
780
781    %% Input is a file. Output is a fun.
782    [] = file_sorter:merge([], output([], Fmt), Args),
783    L2 = [[1,3,5],[2,4,5]],
784    Fs1 = to_files(L2, Fmt, Config),
785    S2 = file_sorter:sort(Fs1, output([], Fmt), Args),
786    S2 = rev(lists:sort(lists:append(L2)), Args),
787    delete_files(Fs1),
788
789    %% Input is a file. Output is a file
790    ok = file_sorter:merge([], Foo, Args),
791    [] = from_files(Foo, Fmt),
792    delete_files(Foo),
793    ok = file_sorter:merge([], Foo, [{unique,true} | Args]),
794    [] = from_files(Foo, Fmt),
795    delete_files(Foo),
796    L31 = [1,2,3],
797    L32 = [2,3,4],
798    L33 = [4,5,6],
799    L3r = [L31, L32, L33],
800    L3 = [rev(L31,Args), rev(L32,Args), rev(L33,Args)],
801    Fs2 = to_files(L3, Fmt, Config),
802    ok = file_sorter:merge(Fs2, Foo, Args),
803    true = rev(lists:merge(L3r), Args) =:= from_files(Foo, Fmt),
804    ok = file_sorter:merge(Fs2, Foo, Args++[{unique,true},
805					    {size,100000}]),
806    true = rev(lists:umerge(L3r), Args) =:= from_files(Foo, Fmt),
807    delete_files(Foo),
808    ok = file_sorter:merge(Fs2, Foo, Args++[{unique,true}]),
809    true = rev(lists:umerge(L3r), Args) =:= from_files(Foo, Fmt),
810    delete_files([Foo | Fs2]),
811
812    ok.
813
814keymerge(Fmt, XArgs, Config) ->
815    Args = make_args(Fmt, [{size,50}, {no_files, 2} | XArgs]),
816    Foo = outfile("foo", Config),
817
818    %% Input is files. Output is a file.
819    ok = file_sorter:keymerge(2, [], Foo, Args),
820    [] = from_files(Foo, Fmt),
821    delete_files(Foo),
822    ok = file_sorter:keymerge(2, [], Foo, [{unique,true} | Args]),
823    [] = from_files(Foo, Fmt),
824    delete_files(Foo),
825    L0 = [rev([{a,1},{a,2}], Args), rev([{a,2},{a,1},{a,3}], Args)],
826    Fs0 = to_files(L0, Fmt, Config),
827    delete_files(Foo),
828    ok = file_sorter:keymerge(1, Fs0, Foo, Args ++ [{unique,false}]),
829    S2 = rev([{a,1},{a,2},{a,2},{a,1},{a,3}], Args),
830    S2 = from_files(Foo, Fmt),
831    delete_files([Foo | Fs0]),
832    L11 = [{a,1,x4},{b,2,x4},{c,3,x4}],
833    L21 = [{a,1,x3},{b,2,x3},{c,3,x3}],
834    L31 = [{a,1,x2},{b,2,x2},{c,3,x2}],
835    L41 = [{a,1,x1},{b,2,x1},{c,3,x1}],
836    All =
837	[rev(L11, Args), rev(L21, Args), rev(L31, Args), rev(L41, Args)],
838    Merged1 = lists:keymerge(2, L11, L21),
839    Merged2 = lists:keymerge(2, L31, L41),
840    Merged = rev(lists:keymerge(2, Merged1, Merged2), Args),
841    Fs1 = to_files(All, Fmt, Config),
842    ok = file_sorter:keymerge(2, Fs1, Foo, Args),
843    Merged = from_files(Foo, Fmt),
844
845    fun() ->
846	    UArgs = [{unique,true} | Args],
847	    UMerged1 = lists:ukeymerge(2, L11, L21),
848	    UMerged2 = lists:ukeymerge(2, L31, L41),
849	    UMerged = rev(lists:ukeymerge(2, UMerged1, UMerged2), Args),
850	    ok = file_sorter:keymerge(2, Fs1, Foo, UArgs),
851	    UMerged = from_files(Foo, Fmt),
852	    UArgs2 = make_args(Fmt, [{unique,true}, {size,50} | XArgs]),
853	    ok = file_sorter:keymerge(2, Fs1, Foo, UArgs2),
854	    UMerged = from_files(Foo, Fmt),
855	    List = rev([{a,1,x4},{b,2,x4},{c,3,x4}], Args),
856	    FsL = to_files([List], Fmt, Config),
857	    ok = file_sorter:keymerge(2, FsL, Foo, UArgs),
858	    List = from_files(Foo, Fmt),
859	    List1 = [{a,1,x4},{b,2,x4},{c,3,x4}],
860	    List2 = [{a,3,x4},{b,4,x4},{c,5,x4}],
861	    FsLL = to_files([rev(List1, Args), rev(List2, Args)], Fmt, Config),
862	    ok = file_sorter:keymerge(2, FsLL, Foo, UArgs),
863	    List1_2 = rev(lists:ukeymerge(2, List1, List2), Args),
864	    List1_2 = from_files(Foo, Fmt),
865	    delete_files(Foo)
866    end(),
867
868    %% Input is files. Output is a fun.
869    Fs3 = to_files(All, Fmt, Config),
870    [] = file_sorter:keysort(2, [], output([], Fmt), Args),
871    KS1 = file_sorter:keymerge(2, Fs3, output([], Fmt), Args),
872    Merged = KS1,
873    delete_files([Foo | Fs3]),
874
875    L2 = [[{a,1}],[{a,2}],[{a,3}],[{a,4}],[{a,5}],[{a,6}],[{a,7}]],
876    Fs2 = to_files(L2, Fmt, Config),
877    M = file_sorter:keymerge(1, Fs2, output([], Fmt), Args),
878    M = rev(lists:append(L2), Args),
879    delete_files(Fs2),
880
881    LL1 = [{d,4},{e,5},{f,6}],
882    LL2 = [{a,1},{b,2},{c,3}],
883    LL3 = [{j,10},{k,11},{l,12}],
884    LL4 = [{g,7},{h,8},{i,9}],
885    LL5 = [{p,16},{q,17},{r,18}],
886    LL6 = [{m,13},{n,14},{o,15}],
887    LLAll = [rev(LL1, Args),rev(LL2, Args),rev(LL3, Args),
888	     rev(LL4, Args),rev(LL5, Args),rev(LL6, Args)],
889    FsLL6 = to_files(LLAll, Fmt, Config),
890    LL = rev(lists:sort(lists:append(LLAll)), Args),
891    ok = file_sorter:keymerge(1, FsLL6, Foo, Args),
892    LL = from_files(Foo, Fmt),
893    ok = file_sorter:keymerge(1, FsLL6, Foo, [{unique,true} | Args]),
894    LL = from_files(Foo, Fmt),
895    delete_files([Foo | FsLL6]),
896
897    ok.
898
899funmerge(Fmt, XArgs, Config) ->
900    KComp = key_compare(2),
901    Args = make_args(Fmt, [{order,KComp},{size,5}, {no_files, 5} | XArgs]),
902    UArgs = [{unique,true} | Args],
903    Foo = outfile(foo, Config),
904
905    EFs = to_files([[]], Fmt, Config),
906    ok = file_sorter:merge(EFs, Foo, UArgs),
907    [] = from_files(Foo, Fmt),
908    delete_files([Foo | EFs]),
909
910    L11 = [{a,1,x4},{b,2,x4},{c,3,x4}],
911    L21 = [{a,1,x3},{b,2,x3},{c,3,x3}],
912    L31 = [{a,1,x2},{b,2,x2},{c,3,x2}],
913    L41 = [{a,1,x1},{b,2,x1},{c,3,x1}],
914    CAll = [L11, L21, L31, L41],
915    CMerged1 = lists:merge(KComp, L11, L21),
916    CMerged2 = lists:merge(KComp, L31, L41),
917    CMerged = lists:merge(KComp, CMerged1, CMerged2),
918    CFs1 = to_files(CAll, Fmt, Config),
919    ok = file_sorter:merge(CFs1, Foo, Args),
920    CMerged = from_files(Foo, Fmt),
921
922    Args4 = make_args(Fmt, [{size,50} | XArgs]),
923    ok = file_sorter:merge(CFs1, Foo, [{order,KComp} | Args4]),
924    CMerged = from_files(Foo, Fmt),
925
926    UMerged1 = lists:umerge(KComp, L11, L21),
927    UMerged2 = lists:umerge(KComp, L31, L41),
928    UMerged = lists:umerge(KComp, UMerged1, UMerged2),
929    ok = file_sorter:merge(CFs1, Foo, [{order,KComp} | UArgs]),
930    UMerged = from_files(Foo, Fmt),
931    UArgs2 =
932        lists:keydelete(order, 1,
933                        make_args(Fmt, [{unique,true}, {size,50} | XArgs])),
934    ok = file_sorter:merge(CFs1, Foo, [{order,KComp} | UArgs2]),
935    UMerged = from_files(Foo, Fmt),
936    delete_files(Foo),
937
938    List1 = [{a,1,x4},{b,2,x4},{c,3,x4}],
939    List2 = [{a,3,x4},{b,4,x4},{c,5,x4}],
940    List3 = [{a,5,x4},{b,6,x4},{c,7,x4}],
941    FsLL = to_files([List1, List2, List3], Fmt, Config),
942    ok = file_sorter:merge(FsLL, Foo, Args),
943    List1_2 = lists:merge(KComp,lists:merge(KComp,List1,List2),List3),
944    List1_2 = from_files(Foo, Fmt),
945    ok = file_sorter:merge(FsLL, Foo, [{order,KComp} | UArgs]),
946    UList1_2 =
947        lists:umerge(KComp,lists:umerge(KComp, List1, List2),List3),
948    UList1_2 = from_files(Foo, Fmt),
949    delete_files([Foo | CFs1]),
950
951    fun() ->
952	    LL1 = [{d,4},{e,5},{f,6}],
953	    LL2 = [{a,1},{b,2},{c,3}],
954	    LL3 = [{j,10},{k,11},{l,12}],
955	    LL4 = [{g,7},{h,8},{i,9}],
956	    LL5 = [{p,16},{q,17},{r,18}],
957	    LL6 = [{m,13},{n,14},{o,15}],
958	    LLAll = [LL1,LL2,LL3,LL4,LL5,LL6],
959	    FsLL6 = to_files(LLAll, Fmt, Config),
960	    LL = lists:sort(lists:append(LLAll)),
961	    ok = file_sorter:merge(FsLL6, Foo, Args),
962	    LL = from_files(Foo, Fmt),
963	    ok = file_sorter:merge(FsLL6, Foo, UArgs),
964	    LL = from_files(Foo, Fmt),
965	    delete_files([Foo | FsLL6])
966    end(),
967
968    fun() ->
969	    RLL1 = [{b,2},{h,8},{n,14}],
970	    RLL2 = [{a,1},{g,7},{m,13}],
971	    RLL3 = [{d,4},{j,10},{p,16}],
972	    RLL4 = [{c,3},{i,9},{o,15}],
973	    RLL5 = [{f,6},{l,12},{r,18}],
974	    RLL6 = [{e,5},{k,11},{q,17}],
975	    RLLAll = [RLL1,RLL2,RLL3,RLL4,RLL5,RLL6],
976	    RFsLL6 = to_files(RLLAll, Fmt, Config),
977	    RLL = lists:sort(lists:append(RLLAll)),
978	    ok = file_sorter:merge(RFsLL6, Foo, Args),
979	    RLL = from_files(Foo, Fmt),
980	    ok = file_sorter:merge(RFsLL6, Foo, UArgs),
981	    RLL = from_files(Foo, Fmt),
982	    delete_files([Foo | RFsLL6])
983    end(),
984
985    ok.
986
987check(Fmt, Config) ->
988    Args0 = make_args(Fmt, [{size,5}]),
989    Args = Args0 ++ [{tmpdir,?privdir(Config)}],
990
991    Fun = fun compare/2,
992
993    L1 = [3,1,2,5,4],
994    [F1_0] = Fs1 = to_files([L1], Fmt, Config),
995    F1 = filename:absname(F1_0),
996    {ok, [{F1,2,1}]} = file_sorter:check(Fs1, Args),
997    {ok, [{F1,2,1}]} = file_sorter:check(Fs1, [{order,Fun} | Args]),
998    {ok, [{F1,2,1}]} = file_sorter:check(Fs1, [{unique,true} | Args]),
999    {ok, [{F1,2,1}]} =
1000	file_sorter:check(Fs1, [{order,Fun},{unique,true} | Args]),
1001    {ok, [{F1,3,2}]} =
1002	file_sorter:check(Fs1, [{order,descending} | Args]),
1003    {ok, [{F1,3,2}]} =
1004	file_sorter:check(Fs1, [{unique,true},{order,descending} | Args]),
1005    delete_files(Fs1),
1006
1007    L2 = [[1,2,2,3,3,4,5,5],[5,5,4,3,3,2,2,1]],
1008    [F2_0,F3_0] = Fs2 = to_files(L2, Fmt, Config),
1009    F2 = filename:absname(F2_0),
1010    F3 = filename:absname(F3_0),
1011    {ok, [{F3,3,4}]} = file_sorter:check(Fs2, Args),
1012    {ok, [{F3,3,4}]} = file_sorter:check(Fs2, [{order,Fun} | Args]),
1013    {ok, [{F2,3,2},{F3,2,5}]} =
1014	file_sorter:check(Fs2, [{unique, true} | Args]),
1015    {ok, [{F2,3,2},{F3,2,5}]} =
1016	file_sorter:check(Fs2, [{order,Fun},{unique, true} | Args]),
1017    {ok, [{F2,2,2}]} =
1018	file_sorter:check(Fs2, [{order,descending} | Args]),
1019    {ok, [{F2,2,2},{F3,2,5}]} =
1020	file_sorter:check(Fs2, [{unique,true},{order,descending} | Args]),
1021    delete_files(Fs2),
1022
1023    L3 = [1,2,3,4],
1024    Fs3 = to_files([L3], Fmt, Config),
1025    {ok, []} = file_sorter:check(Fs3, [{unique,true} | Args]),
1026    {ok, []} =
1027	file_sorter:check(Fs3, [{unique,true},{order,Fun} | Args]),
1028    delete_files(Fs3),
1029
1030    %% big objects
1031    T1 = erlang:make_tuple(10000,foo),
1032    T2 = erlang:make_tuple(10000,bar),
1033    L4 = [T1,T2],
1034    [FF_0] = Fs4 = to_files([L4], Fmt, Config),
1035    FF = filename:absname(FF_0),
1036    {ok, [{FF,2,T2}]} = file_sorter:check(Fs4, [{unique,true} | Args]),
1037    delete_files(Fs4),
1038
1039    CFun = key_compare(2),
1040    L10 = [[{1,a},{2,b},T10_1={1,b},{3,c}], [{1,b},T10_2={2,a}]],
1041    [F10_0,F11_0] = Fs10 = to_files(L10, Fmt, Config),
1042    F10_1 = filename:absname(F10_0),
1043    F11_1 = filename:absname(F11_0),
1044    {ok, [{F10_1,3,T10_1},{F11_1,2,T10_2}]} =
1045        file_sorter:check(Fs10, [{unique,true},{order,CFun} | Args]),
1046    delete_files(Fs10),
1047
1048    ok.
1049
1050keycheck(Fmt, Config) ->
1051    Args0 = make_args(Fmt, [{size,5}]),
1052    Args = Args0 ++ [{tmpdir,?privdir(Config)}],
1053
1054    L1 = [[{a,1},{b,2}], [{c,2},{b,1},{a,3}]],
1055    [F1_0,F2_0] = Fs1 = to_files(L1, Fmt, Config),
1056    F1 = filename:absname(F1_0),
1057    F2 = filename:absname(F2_0),
1058    {ok, [{F2,2,{b,1}}]} = file_sorter:keycheck(1, Fs1, Args),
1059    {ok, [{F2,2,{b,1}}]} =
1060	file_sorter:keycheck(1, Fs1, [{unique,true} | Args]),
1061    {ok, [{F1,2,{b,2}}]} =
1062	file_sorter:keycheck(1, Fs1, [{order,descending},{unique,true} | Args]),
1063    delete_files(Fs1),
1064
1065    L2 = [[{a,1},{a,2},{a,2},{b,2}], [{c,2},{b,1},{b,2},{b,2},{a,3}]],
1066    [F3_0,F4_0] = Fs2 = to_files(L2, Fmt, Config),
1067    F3 = filename:absname(F3_0),
1068    F4 = filename:absname(F4_0),
1069    {ok, [{F4,2,{b,1}}]} = file_sorter:keycheck(1, Fs2, Args),
1070    {ok, [{F3,2,{a,2}},{F4,2,{b,1}}]} =
1071	file_sorter:keycheck(1, Fs2, [{unique,true} | Args]),
1072    {ok, [{F3,4,{b,2}}]} =
1073	file_sorter:keycheck(1, Fs2, [{order,descending} | Args]),
1074    {ok, [{F3,2,{a,2}},{F4,3,{b,2}}]} =
1075	file_sorter:keycheck(1, Fs2,
1076			     [{order,descending},{unique,true} | Args]),
1077    delete_files(Fs2),
1078
1079    ok.
1080
1081rev(L, Args) ->
1082    case lists:member({order, descending}, Args) of
1083	true ->
1084	    lists:reverse(L);
1085	false ->
1086	    L
1087    end.
1088
1089make_args({HL, Fmt}, Args) ->
1090    make_args(Fmt, [{header, HL} | Args]);
1091make_args(Fmt, Args) ->
1092    [{format, Fmt} | Args].
1093
1094compare(X, Y) ->
1095    X =< Y.
1096
1097key_compare(I) ->
1098    fun(X, Y) ->
1099            element(I, bin_to_term(X)) =< element(I, bin_to_term(Y))
1100    end.
1101
1102bin_to_term(B) when is_binary(B) -> binary_to_term(B);
1103bin_to_term(T) -> T.
1104
1105-define(CHUNKSIZE, 8096).
1106
1107pps() ->
1108    erlang:ports().
1109
1110input(L, N, term) ->
1111    input(L, N);
1112input(L, N, {_HL, Format}) when Format =:= binary_term; Format =:= binary ->
1113    binput(L, N);
1114input(L, N, Format) when Format =:= binary_term; Format =:= binary ->
1115    binput(L, N).
1116
1117binput(L, N) ->
1118    Bs = lists:map(fun(T) -> term_to_binary(T) end, L),
1119    input(Bs, N).
1120
1121input(L, N) ->
1122    fun(close) ->
1123	    ok;
1124       (read) ->
1125	    case L of
1126		[] -> end_of_input;
1127		_ ->
1128		    R = lists:sublist(L, N),
1129		    NL = lists:nthtail(length(R), L),
1130		    {R, input(NL, N)}
1131	    end
1132    end.
1133
1134output(L, term) ->
1135    output(L);
1136output(L, {_HL, Format}) when Format =:= binary_term; Format =:= binary ->
1137    boutput(L);
1138output(L, Format) when Format =:= binary_term; Format =:= binary ->
1139    boutput(L).
1140
1141output(A) ->
1142    fun(close) ->
1143	    lists:append(lists:reverse(A));
1144       (L) when is_list(L) ->
1145	    output([L | A])
1146    end.
1147
1148boutput(A) ->
1149    fun(close) ->
1150	    Bs = lists:append(lists:reverse(A)),
1151	    lists:map(fun(B) -> binary_to_term(B) end, Bs);
1152       (L) when is_list(L) ->
1153	    boutput([L | A])
1154    end.
1155
1156outfile(Name, Config) ->
1157    list_to_atom(filename:join(?privdir(Config), Name)).
1158
1159%% [[term()]] -> [filename()]
1160to_files(Lists, term, Config) ->
1161    terms_to_files(Lists, Config);
1162to_files(Lists, Format, Config) when Format =:= binary_term;
1163				     Format =:= binary ->
1164    bins_to_files(Lists, 4, Config);
1165to_files(Lists, {HL, Format}, Config) when Format =:= binary_term;
1166					   Format =:= binary ->
1167    bins_to_files(Lists, HL, Config).
1168
1169%% [[term()]] -> [filename()]
1170terms_to_files(Lists, Config) ->
1171    PrivDir = ?privdir(Config),
1172    terms_to_files(Lists, PrivDir, 1).
1173
1174terms_to_files([L | Ls], PrivDir, N) ->
1175    F = lists:concat([?MODULE, '_', N]),
1176    File = filename:join(PrivDir, F),
1177    {ok, Fd} = file:open(File, [write]),
1178    write_terms(Fd, L),
1179    file:close(Fd),
1180    [list_to_atom(File) | terms_to_files(Ls, PrivDir, N+1)];
1181terms_to_files([], _PrivDir, _N) ->
1182    [].
1183
1184write_terms(Fd, [T | Ts]) ->
1185    io:format(Fd, "~p.~n", [T]),
1186    write_terms(Fd, Ts);
1187write_terms(_Fd, []) ->
1188    ok.
1189
1190%% [[term()]] -> [filename()]
1191bins_to_files(Lists, HL, Config) ->
1192    PrivDir = ?privdir(Config),
1193    bins_to_files(Lists, PrivDir, 1, HL).
1194
1195bins_to_files([L | Fs], PrivDir, N, HL) ->
1196    F = lists:concat([?MODULE, '_', N]),
1197    File = filename:join(PrivDir, F),
1198    {ok, Fd} = file:open(File, [raw,binary,write]),
1199    write_bins(Fd, L, HL),
1200    file:close(Fd),
1201    [list_to_atom(File) | bins_to_files(Fs, PrivDir, N+1, HL)];
1202bins_to_files([], _PrivDir, _N, _HL) ->
1203    [].
1204
1205write_bins(Fd, [T | Ts], HL) ->
1206    B = term_to_binary(T),
1207    Sz = byte_size(B),
1208    ok = file:write(Fd, [<<Sz:HL/unit:8>>, B]),
1209    write_bins(Fd, Ts, HL);
1210write_bins(_Fd, [], _HL) ->
1211    ok.
1212
1213%% [filename()] -> [[term()]] or filename() -> [term()]
1214from_files(Files, term) ->
1215    terms_from_files(Files);
1216from_files(Files, Format) when Format =:= binary_term; Format =:= binary ->
1217    bins_from_files(Files, 4);
1218from_files(Files, {HL, Format}) when Format =:= binary_term;
1219                                     Format =:= binary ->
1220    bins_from_files(Files, HL).
1221
1222%% [filename()] -> [[term()]] or filename() -> [term()]
1223terms_from_files(File) when is_atom(File) ->
1224    [Terms] = terms_from_files([File]),
1225    Terms;
1226terms_from_files(Files) ->
1227    lists:map(fun(F) -> terms_from_file(F) end, Files).
1228
1229terms_from_file(File) ->
1230    {ok, Fd} = file:open(File, [read,compressed]),
1231    terms_from_file(Fd, []).
1232
1233terms_from_file(Fd, L) ->
1234    case io:read(Fd, '') of
1235	{ok, Term} ->
1236	    terms_from_file(Fd, [Term | L]);
1237	eof ->
1238	    file:close(Fd),
1239	    lists:reverse(L)
1240    end.
1241
1242%% [filename()] -> [[term()]]
1243bins_from_files(File, HL) when is_atom(File) ->
1244    [Bins] = bins_from_files([File], HL),
1245    Bins;
1246bins_from_files(Files, HL) ->
1247    lists:map(fun(F) -> collect(F, HL) end, Files).
1248
1249delete_files(File) when is_atom(File) ->
1250    file:delete(File);
1251delete_files(Files) ->
1252    lists:foreach(fun(F) -> file:delete(F) end, Files).
1253
1254%%%
1255%%% Collects binaries converted to terms in a list. Not very efficient.
1256%%%
1257collect(F, HL) ->
1258    {ok, Fd} = file:open(F, [read, binary, raw, compressed]),
1259    R = (catch c(Fd, <<>>, 0, ?CHUNKSIZE, HL, [])),
1260    file:close(Fd),
1261    R.
1262
1263c(Fd, Bin0, Size0, NoBytes, HL, L) ->
1264    case file:read(Fd, NoBytes) of
1265	{ok, Bin} ->
1266	    Size = Size0 + byte_size(Bin),
1267	    NBin = list_to_binary([Bin0, Bin]),
1268	    c1(Fd, NBin, Size, HL, L);
1269	eof when Size0 =:= 0 ->
1270	    lists:reverse(L);
1271        eof ->
1272	    ct:fail({error, premature_eof});
1273	Error ->
1274	    ct:fail(Error)
1275    end.
1276
1277c1(Fd, B, BinSize, HL, L) ->
1278    case B of
1279	<<Size:HL/unit:8, Bin/binary>> ->
1280	    if
1281		Size > BinSize - HL, Size > ?CHUNKSIZE ->
1282		    c(Fd, B, BinSize, Size + HL, HL, L);
1283		Size > BinSize - HL ->
1284		    c(Fd, B, BinSize, ?CHUNKSIZE, HL, L);
1285		true ->
1286		    <<BinTerm:Size/binary, R/binary>> = Bin,
1287		    E = case catch binary_to_term(BinTerm) of
1288                            {'EXIT', _} ->
1289				ct:fail({error, bad_object});
1290			    Term ->
1291				Term
1292			end,
1293		    NBinSize = BinSize - HL - Size,
1294		    c1(Fd, R, NBinSize, HL, [E | L])
1295	    end;
1296	_ ->
1297	    c(Fd, B, BinSize, ?CHUNKSIZE, HL, L)
1298    end.
1299