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
21-module(ram_file_SUITE).
22
23-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
24	 init_per_group/2,end_per_group/2,
25	 %% init/1, fini/1,
26	 init_per_testcase/2, end_per_testcase/2]).
27-export([open_modes/1, pread_pwrite/1, position/1,
28	 truncate/1, sync/1, get_file_and_size/1,
29	 large_file_errors/1, large_file_light/1,
30	 large_file_heavy/0, large_file_heavy/1]).
31
32-include_lib("common_test/include/ct.hrl").
33-include_lib("kernel/include/file.hrl").
34
35-define(FILE_MODULE, file).         % Name of module to test
36-define(RAM_FILE_MODULE, ram_file). % Name of module to test
37
38%%--------------------------------------------------------------------------
39
40suite() ->
41    [{ct_hooks,[ts_install_cth]},
42     {timetrap,{minutes,1}}].
43
44all() ->
45    [open_modes, pread_pwrite, position,
46     truncate, sync, get_file_and_size,
47     large_file_errors, large_file_light, large_file_heavy].
48
49groups() ->
50    [].
51
52init_per_suite(Config) ->
53    Config.
54
55end_per_suite(_Config) ->
56    ok.
57
58init_per_group(_GroupName, Config) ->
59    Config.
60
61end_per_group(_GroupName, Config) ->
62    Config.
63
64
65init_per_testcase(_Func, Config) ->
66    Config.
67
68end_per_testcase(_Func, Config) ->
69    Config.
70
71%%--------------------------------------------------------------------------
72%% Test suites
73
74%% Test that the basic read, write and binary options works for open/2.
75open_modes(Config) when is_list(Config) ->
76    Str1 = "The quick brown fox ",
77    Str2 = "jumps over a lazy dog ",
78    Str  = Str1 ++ Str2,
79    Bin1 = list_to_binary(Str1),
80    Bin2 = list_to_binary(Str2),
81    Bin  = list_to_binary(Str),
82    %%
83    open_read_write(?FILE_MODULE, Str1, [ram, read, write], Str2),
84    open_read(?FILE_MODULE, Str, [ram]),
85    open_read_write(?FILE_MODULE, Bin1, [ram, binary, read, write], Bin2),
86    open_read(?FILE_MODULE, Bin, [ram, binary, read]),
87    %%
88    ok.
89
90open_read_write(Module, Data1, Options, Data2) ->
91    io:format("~p:open_read_write(~p, ~p, ~p, ~p)~n",
92	      [?MODULE, Module, Data1, Options, Data2]),
93    %%
94    Size1 = sizeof(Data1),
95    Size2 = sizeof(Data2),
96    Data  = append(Data1, Data2),
97    Size  = Size1 + Size2,
98    %%
99    {ok, Fd}    = Module:open(Data1, Options),
100    {ok, Data1} = Module:read(Fd, Size1),
101    eof         = Module:read(Fd, 1),
102    {ok, Zero}  = Module:read(Fd, 0),
103    0           = sizeof(Zero),
104    ok          = Module:write(Fd, Data2),
105    {ok, 0}     = Module:position(Fd, bof),
106    {ok, Data}  = Module:read(Fd, Size),
107    eof         = Module:read(Fd, 1),
108    {ok, Zero}  = Module:read(Fd, 0),
109    ok          = Module:close(Fd),
110    %%
111    ok.
112
113open_read(Module, Data, Options) ->
114    io:format("~p:open_read(~p, ~p, ~p)~n",
115	      [?MODULE, Module, Data, Options]),
116    %%
117    Size = sizeof(Data),
118    %%
119    {ok, Fd}         = Module:open(Data, Options),
120    {ok, Data}       = Module:read(Fd, Size),
121    eof              = Module:read(Fd, 1),
122    {ok, Zero}       = Module:read(Fd, 0),
123    0                = sizeof(Zero),
124    {error, ebadf}   = Module:write(Fd, Data),
125    {ok, 0}          = Module:position(Fd, bof),
126    {ok, Data}       = Module:read(Fd, Size),
127    eof              = Module:read(Fd, 1),
128    {ok, Zero}       = Module:read(Fd, 0),
129    ok               = Module:close(Fd),
130    %%
131    ok.
132
133
134
135%% Test that pread/2,3 and pwrite/2,3 works.
136pread_pwrite(Config) when is_list(Config) ->
137    Str = "Flygande bäckaziner söka hwila på mjuqa tuvor x",
138    Bin = list_to_binary(Str),
139    %%
140    pread_pwrite_test(?FILE_MODULE, Str, [ram, read, write]),
141    pread_pwrite_test(?FILE_MODULE, Bin, [ram, binary, read, write]),
142    pread_pwrite_test(?RAM_FILE_MODULE, Str, [read, write]),
143    pread_pwrite_test(?RAM_FILE_MODULE, Bin, [binary, read, write]),
144    %%
145    ok.
146
147pread_pwrite_test(Module, Data, Options) ->
148    io:format("~p:pread_pwrite_test(~p, ~p, ~p)~n",
149	      [?MODULE, Module, Data, Options]),
150    %%
151    Size = sizeof(Data),
152    %%
153    {ok, Fd}         = Module:open([], Options),
154    ok               = Module:pwrite(Fd, 0, Data),
155    {ok, Data}       = Module:pread(Fd, 0, Size+1),
156    eof              = Module:pread(Fd, Size+1, 1),
157    {ok, Zero}       = Module:pread(Fd, Size+1, 0),
158    0                = sizeof(Zero),
159    ok               = Module:pwrite(Fd, [{0, Data}, {Size+17, Data}]),
160    {ok, [Data,
161	  eof,
162	  Data,
163	  Zero]}     = Module:pread(Fd, [{Size+17, Size+1},
164					 {2*Size+17+1, 1},
165					 {0, Size},
166					 {2*Size+17+1, 0}]),
167    ok               = Module:close(Fd),
168    %%
169    ok.
170
171%% Test that position/2 works.
172position(Config) when is_list(Config) ->
173    Str = "Att vara eller icke vara, det är frågan. ",
174    Bin = list_to_binary(Str),
175    %%
176    position_test(?FILE_MODULE, Str, [ram, read]),
177    position_test(?FILE_MODULE, Bin, [ram, binary]),
178    position_test(?RAM_FILE_MODULE, Str, [read]),
179    position_test(?RAM_FILE_MODULE, Bin, [binary, read]),
180    %%
181    ok.
182
183position_test(Module, Data, Options) ->
184    io:format("~p:position_test(~p, ~p, ~p)~n",
185	      [?MODULE, Module, Data, Options]),
186    %%
187    Size = sizeof(Data),
188    Size_7 = Size+7,
189    %%
190    Slice_0_2 = slice(Data, 0, 2),
191    Slice_0_3 = slice(Data, 0, 3),
192    Slice_2_5 = slice(Data, 2, 5),
193    Slice_3_4 = slice(Data, 3, 4),
194    Slice_5   = slice(Data, 5, Size),
195    %%
196    {ok, Fd}          = Module:open(Data, Options),
197    %%
198    io:format("CUR positions"),
199    {ok, Slice_0_2}   = Module:read(Fd, 2),
200    {ok, 2}           = Module:position(Fd, cur),
201    {ok, Slice_2_5}   = Module:read(Fd, 5),
202    {ok, 3}           = Module:position(Fd, {cur, -4}),
203    {ok, Slice_3_4}   = Module:read(Fd, 4),
204    {ok, 0}           = Module:position(Fd, {cur, -7}),
205    {ok, Slice_0_3}   = Module:read(Fd, 3),
206    {ok, 0}           = Module:position(Fd, {cur, -3}),
207    {error, einval}   = Module:position(Fd, {cur, -1}),
208    {ok, 0}           = Module:position(Fd, 0),
209    {ok, 2}           = Module:position(Fd, {cur, 2}),
210    {ok, Slice_2_5}   = Module:read(Fd, 5),
211    {ok, Size_7}      = Module:position(Fd, {cur, Size}),
212    {ok, Zero}        = Module:read(Fd, 0),
213    0                 = sizeof(Zero),
214    eof               = Module:read(Fd, 1),
215    %%
216    io:format("Absolute and BOF positions"),
217    {ok, Size}        = Module:position(Fd, Size),
218    eof               = Module:read(Fd, 1),
219    {ok, 5}           = Module:position(Fd, 5),
220    {ok, Slice_5}     = Module:read(Fd, Size),
221    {ok, 2}           = Module:position(Fd, {bof, 2}),
222    {ok, Slice_2_5}   = Module:read(Fd, 5),
223    {ok, 3}           = Module:position(Fd, 3),
224    {ok, Slice_3_4}   = Module:read(Fd, 4),
225    {ok, 0}           = Module:position(Fd, bof),
226    {ok, Slice_0_2}   = Module:read(Fd, 2),
227    {ok, Size_7}      = Module:position(Fd, {bof, Size_7}),
228    {ok, Zero}        = Module:read(Fd, 0),
229    %%
230    io:format("EOF positions"),
231    {ok, Size}        = Module:position(Fd, eof),
232    eof               = Module:read(Fd, 1),
233    {ok, 5}           = Module:position(Fd, {eof, -Size+5}),
234    {ok, Slice_5}     = Module:read(Fd, Size),
235    {ok, 2}           = Module:position(Fd, {eof, -Size+2}),
236    {ok, Slice_2_5}   = Module:read(Fd, 5),
237    {ok, 3}           = Module:position(Fd, {eof, -Size+3}),
238    {ok, Slice_3_4}   = Module:read(Fd, 4),
239    {ok, 0}           = Module:position(Fd, {eof, -Size}),
240    {ok, Slice_0_2}   = Module:read(Fd, 2),
241    {ok, Size_7}      = Module:position(Fd, {eof, 7}),
242    {ok, Zero}        = Module:read(Fd, 0),
243    eof               = Module:read(Fd, 1),
244    %%
245    ok.
246
247
248
249%% Test that truncate/1 works.
250truncate(Config) when is_list(Config) ->
251    Str = "Mån ädlare att lida och fördraga "
252	++ "ett bittert ödes stygn av pilar, ",
253    Bin = list_to_binary(Str),
254    %%
255    ok = truncate_test(?FILE_MODULE, Str, [ram, read, write]),
256    ok = truncate_test(?FILE_MODULE, Bin, [ram, binary, read, write]),
257    ok = truncate_test(?RAM_FILE_MODULE, Str, [read, write]),
258    ok = truncate_test(?RAM_FILE_MODULE, Bin, [binary, read, write]),
259    %%
260    {error, eacces} = truncate_test(?FILE_MODULE, Str, [ram]),
261    {error, eacces} = truncate_test(?FILE_MODULE, Bin, [ram, binary, read]),
262    {error, eacces} = truncate_test(?RAM_FILE_MODULE, Str, [read]),
263    {error, eacces} = truncate_test(?RAM_FILE_MODULE, Bin, [binary, read]),
264    %%
265    ok.
266
267truncate_test(Module, Data, Options) ->
268    io:format("~p:truncate_test(~p, ~p, ~p)~n",
269	      [?MODULE, Module, Data, Options]),
270    %%
271    Size = sizeof(Data),
272    Size1 = Size-2,
273    Data1 = slice(Data, 0, Size1),
274    %%
275    {ok, Fd}    = Module:open(Data, Options),
276    {ok, Size1} = Module:position(Fd, Size1),
277    case Module:truncate(Fd) of
278	ok ->
279	    {ok, 0}     = Module:position(Fd, 0),
280	    {ok, Data1} = Module:read(Fd, Size),
281	    ok          = Module:close(Fd),
282	    ok;
283	Error ->
284	    ok      = Module:close(Fd),
285	    Error
286    end.
287
288
289
290%% Test that sync/1 at least does not crash.
291sync(Config) when is_list(Config) ->
292    Str = "än att ta till vapen mot ett hav av kval. ",
293    Bin = list_to_binary(Str),
294    %%
295    sync_test(?FILE_MODULE, Str, [ram, read, write]),
296    sync_test(?FILE_MODULE, Bin, [ram, binary, read, write]),
297    sync_test(?RAM_FILE_MODULE, Str, [read, write]),
298    sync_test(?RAM_FILE_MODULE, Bin, [binary, read, write]),
299    %%
300    sync_test(?FILE_MODULE, Str, [ram]),
301    sync_test(?FILE_MODULE, Bin, [ram, binary, read]),
302    sync_test(?RAM_FILE_MODULE, Str, [read]),
303    sync_test(?RAM_FILE_MODULE, Bin, [binary, read]),
304    %%
305    ok.
306
307sync_test(Module, Data, Options) ->
308    io:format("~p:sync_test(~p, ~p, ~p)~n",
309	      [?MODULE, Module, Data, Options]),
310    %%
311    Size = sizeof(Data),
312    %%
313    {ok, Fd}    = Module:open(Data, Options),
314    ok          = Module:sync(Fd),
315    {ok, Data}  = Module:read(Fd, Size+1),
316    ok.
317
318
319
320%% Tests get_file/1 and get_size/1.
321get_file_and_size(Config) when is_list(Config) ->
322    %% These two strings should not be of equal length.
323    Str  = "När högan nord blir snöbetäckt, ",
324    Bin  = list_to_binary(Str),
325    %%
326    ok = get_file_and_size_test(Str, [read, write]),
327    ok = get_file_and_size_test(Bin, [binary, read, write]),
328    ok = get_file_and_size_test(Str, [read]),
329    ok = get_file_and_size_test(Bin, [binary, read]),
330    %%
331    ok.
332
333get_file_and_size_test(Data, Options) ->
334    io:format("~p:get_file_and_size_test(~p, ~p)~n",
335	      [?MODULE, Data, Options]),
336    %%
337    Size  = sizeof(Data),
338    %%
339    {ok, Fd}        = ?RAM_FILE_MODULE:open(Data, Options),
340    {ok, Size}      = ?RAM_FILE_MODULE:get_size(Fd),
341    {ok, Data}      = ?RAM_FILE_MODULE:get_file(Fd),
342    ok              = ?RAM_FILE_MODULE:close(Fd),
343    {error, einval} = ?RAM_FILE_MODULE:get_size(Fd),
344    ok.
345
346
347
348%% Test error checking of large file offsets.
349large_file_errors(Config) when is_list(Config) ->
350    TwoGig = 1 bsl 31,
351    {ok,Fd}         = ?RAM_FILE_MODULE:open("1234567890", [read,write]),
352    {error, einval} = ?FILE_MODULE:read(Fd, TwoGig),
353    {error, badarg} = ?FILE_MODULE:read(Fd, -1),
354    {error, einval} = ?FILE_MODULE:position(Fd, {bof,TwoGig}),
355    {error, einval} = ?FILE_MODULE:position(Fd, {bof,-TwoGig-1}),
356    {error, einval} = ?FILE_MODULE:position(Fd, {bof,-1}),
357    {error, einval} = ?FILE_MODULE:position(Fd, {cur,TwoGig}),
358    {error, einval} = ?FILE_MODULE:position(Fd, {cur,-TwoGig-1}),
359    {error, einval} = ?FILE_MODULE:position(Fd, {eof,TwoGig}),
360    {error, einval} = ?FILE_MODULE:position(Fd, {eof,-TwoGig-1}),
361    {error, einval} = ?FILE_MODULE:pread(Fd, TwoGig, 1),
362    {error, einval} = ?FILE_MODULE:pread(Fd, -TwoGig-1, 1),
363    {error, einval} = ?FILE_MODULE:pread(Fd, -1, 1),
364    {error, einval} = ?FILE_MODULE:pwrite(Fd, TwoGig, "@"),
365    {error, einval} = ?FILE_MODULE:pwrite(Fd, -TwoGig-1, "@"),
366    {error, einval} = ?FILE_MODULE:pwrite(Fd, -1, "@"),
367    {error, einval} = ?FILE_MODULE:pread(Fd, TwoGig, 0),
368    {error, einval} = ?FILE_MODULE:pread(Fd, -TwoGig-1, 0),
369    {error, einval} = ?FILE_MODULE:pread(Fd, -1, 0),
370    ok              = ?FILE_MODULE:close(Fd),
371    ok.
372
373
374
375%% Test light operations on a \large\ ram_file.
376large_file_light(Config) when is_list(Config) ->
377    PrivDir = proplists:get_value(priv_dir, Config),
378    %% Marker for next test case that is to heavy to run in a suite.
379    ok = ?FILE_MODULE:write_file(
380	    filename:join(PrivDir, "large_file_light"),
381	    <<"TAG">>),
382    %%
383    Data = "abcdefghijklmnopqrstuvwzyz",
384    Size = sizeof(Data),
385    Max = (1 bsl 31) - 1,
386    Max__1 = Max - 1,
387    {ok, Fd}        = ?RAM_FILE_MODULE:open(Data, [read]),
388    {ok, Data}      = ?FILE_MODULE:read(Fd, Size+1),
389    {ok, Max__1}    = ?FILE_MODULE:position(Fd, {eof, Max-Size-1}),
390    eof             = ?FILE_MODULE:read(Fd, 1),
391    {ok, Max}       = ?FILE_MODULE:position(Fd, {bof, Max}),
392    {ok, Zero}      = ?FILE_MODULE:read(Fd, 0),
393    0               = sizeof(Zero),
394    eof             = ?FILE_MODULE:read(Fd, 1),
395    eof             = ?FILE_MODULE:pread(Fd, Max__1, 1),
396    {ok, Zero}      = ?FILE_MODULE:pread(Fd, Max, 0),
397    eof             = ?FILE_MODULE:pread(Fd, Max, 1),
398    ok.
399
400
401
402large_file_heavy() ->
403    [{timetrap,{minutes,5}}].
404
405%% Test operations on a maximum size (2 GByte - 1) ram_file.
406large_file_heavy(Config) when is_list(Config) ->
407    PrivDir = proplists:get_value(priv_dir, Config),
408    %% Check previous test case marker.
409    case ?FILE_MODULE:read_file_info(
410	    filename:join(PrivDir, "large_file_light")) of
411	{ok,_} ->
412	    {skipped,"Too heavy for casual testing!"};
413	_ ->
414	    do_large_file_heavy(Config)
415    end.
416
417do_large_file_heavy(_Config) ->
418    Data = "qwertyuiopasdfghjklzxcvbnm",
419    Size = sizeof(Data),
420    Max = (1 bsl 31) - 1,
421    Max__1 = Max - 1,
422    Max__3 = Max - 3,
423    {ok, Fd}        = ?RAM_FILE_MODULE:open(Data, [read,write]),
424    {ok, Data}      = ?FILE_MODULE:read(Fd, Size+1),
425    {ok, Max}       = ?FILE_MODULE:position(Fd, {eof, Max-Size}),
426    eof             = ?FILE_MODULE:read(Fd, 1),
427    erlang:display({allocating,2,'GByte',please,be,patient,'...'}),
428    ok              = ?FILE_MODULE:write(Fd, ""),
429    erlang:display({allocating,2,'GByte',succeeded}),
430    {ok, Max__1}    = ?FILE_MODULE:position(Fd, {eof, -1}),
431    {ok, [0]}       = ?FILE_MODULE:read(Fd, 1),
432    {ok, []}        = ?FILE_MODULE:read(Fd, 0),
433    eof             = ?FILE_MODULE:read(Fd, 1),
434    ok              = ?FILE_MODULE:pwrite(Fd, Max-3, "TAG"),
435    {ok, Max}       = ?FILE_MODULE:position(Fd, cur),
436    {ok, Max__3}    = ?FILE_MODULE:position(Fd, {eof, -3}),
437    {ok, "TAG"}     = ?FILE_MODULE:read(Fd, 3+1),
438    {ok, Max__3}    = ?FILE_MODULE:position(Fd, {cur, -3}),
439    ok              = ?FILE_MODULE:write(Fd, "tag"),
440    {ok, Max}       = ?FILE_MODULE:position(Fd, cur),
441    {ok, 0}         = ?FILE_MODULE:position(Fd, bof),
442    {ok, "tag"}     = ?FILE_MODULE:pread(Fd, Max__3, 3+1),
443    {ok, 0}         = ?FILE_MODULE:position(Fd, cur),
444    ok              = ?FILE_MODULE:close(Fd),
445    ok.
446
447%%--------------------------------------------------------------------------
448%% Utility functions
449
450sizeof(Data) when is_list(Data) ->
451    length(Data);
452sizeof(Data) when is_binary(Data) ->
453    byte_size(Data).
454
455append(Data1, Data2) when is_list(Data1), is_list(Data2) ->
456    Data1 ++ Data2;
457append(Data1, Data2) when is_binary(Data1), is_binary(Data2) ->
458    list_to_binary([Data1 | Data2]).
459
460slice(Data, Start, Length) when is_list(Data) ->
461    lists:sublist(Data, Start+1, Length);
462slice(Data, Start, Length) when is_binary(Data) ->
463    {_, Bin} = split_binary(Data, Start),
464    if
465	Length >= byte_size(Bin) ->
466	    Bin;
467	true ->
468	    {B, _} = split_binary(Bin, Length),
469	    B
470    end.
471
472