1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 2005-2020. 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(filelib_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_per_testcase/2,end_per_testcase/2,
26	 wildcard_one/1,wildcard_two/1,wildcard_errors/1,
27	 fold_files/1,otp_5960/1,ensure_dir_eexist/1,ensure_dir_symlink/1,
28	 wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1,
29         find_source/1, find_source_subdir/1]).
30
31-import(lists, [foreach/2]).
32
33-include_lib("common_test/include/ct.hrl").
34-include_lib("kernel/include/file.hrl").
35
36-define(PRIM_FILE, prim_file).
37
38init_per_testcase(_Case, Config) ->
39    Config.
40
41end_per_testcase(_Case, _Config) ->
42    ok.
43
44suite() ->
45    [{ct_hooks,[ts_install_cth]},
46     {timetrap,{minutes,5}}].
47
48all() ->
49    [wildcard_one, wildcard_two, wildcard_errors,
50     fold_files, otp_5960, ensure_dir_eexist, ensure_dir_symlink,
51     wildcard_symlink, is_file_symlink, file_props_symlink,
52     find_source, find_source_subdir].
53
54groups() ->
55    [].
56
57init_per_suite(Config) ->
58    Config.
59
60end_per_suite(_Config) ->
61    ok.
62
63init_per_group(_GroupName, Config) ->
64    Config.
65
66end_per_group(_GroupName, Config) ->
67    Config.
68
69
70wildcard_one(Config) when is_list(Config) ->
71    {ok,OldCwd} = file:get_cwd(),
72    Dir = filename:join(proplists:get_value(priv_dir, Config), "wildcard_one"),
73    ok = file:make_dir(Dir),
74    do_wildcard_1(Dir,
75		  fun(Wc) ->
76			  filelib:wildcard(Wc, Dir, erl_prim_loader)
77		  end),
78    file:set_cwd(Dir),
79    do_wildcard_1(Dir,
80		  fun(Wc) ->
81			  L = filelib:wildcard(Wc),
82			  L = filelib:wildcard(disable_prefix_opt(Wc)),
83			  L = filelib:wildcard(Wc, erl_prim_loader),
84			  L = filelib:wildcard(Wc, "."),
85			  L = filelib:wildcard(Wc, Dir),
86			  L = filelib:wildcard(disable_prefix_opt(Wc), Dir),
87			  L = filelib:wildcard(Wc, Dir++"/.")
88		  end),
89    file:set_cwd(OldCwd),
90    ok = file:del_dir(Dir),
91    ok.
92
93wildcard_two(Config) when is_list(Config) ->
94    Dir = filename:join(proplists:get_value(priv_dir, Config), "wildcard_two"),
95    ok = file:make_dir(Dir),
96    do_wildcard_1(Dir, fun(Wc) -> io:format("~p~n",[{Wc,Dir, X = filelib:wildcard(Wc, Dir)}]),X  end),
97    do_wildcard_1(Dir, fun(Wc) -> filelib:wildcard(Wc, Dir++"/") end),
98    do_wildcard_1(Dir, fun(Wc) -> filelib:wildcard(Wc, Dir++"/.") end),
99    case os:type() of
100	{win32,_} ->
101	    ok;
102	_ ->
103	    do_wildcard_1(Dir, fun(Wc) -> filelib:wildcard(Wc, "//"++Dir) end)
104    end,
105    ok = file:del_dir(Dir),
106    ok.
107
108wildcard_errors(Config) when is_list(Config) ->
109    wcc("{", missing_delimiter),
110    wcc("{a", missing_delimiter),
111    wcc("{a,", missing_delimiter),
112    wcc("{a,b", missing_delimiter),
113    ok.
114
115wcc(Wc, Error) ->
116    {'EXIT',{{badpattern,Error},
117	     [{filelib,compile_wildcard,1,_}|_]}} =
118	(catch filelib:compile_wildcard(Wc)),
119    {'EXIT',{{badpattern,Error},
120	     [{filelib,wildcard,1,_}|_]}} = (catch filelib:wildcard(Wc)),
121    {'EXIT',{{badpattern,Error},
122	     [{filelib,wildcard,2,_}|_]}} = (catch filelib:wildcard(Wc, ".")).
123
124disable_prefix_opt([C|Wc]) when $a =< C, C =< $z; C =:= $@ ->
125    %% There is an optimization for patterns that have a literal prefix
126    %% (such as "lib/compiler/ebin/*"). Test that we'll get the same result
127    %% if we disable that optimization.
128    [$[, C, $] | Wc];
129disable_prefix_opt(Wc) ->
130    Wc.
131
132do_wildcard_1(Dir, Wcf0) ->
133    do_wildcard_2(Dir, Wcf0),
134    Wcf = fun(Wc0) ->
135		  Wc = Dir ++ "/" ++ Wc0,
136		  L = Wcf0(Wc),
137		  [subtract_dir(N, Dir) || N <- L]
138	  end,
139    do_wildcard_2(Dir, Wcf).
140
141subtract_dir([C|Cs], [C|Dir]) -> subtract_dir(Cs, Dir);
142subtract_dir("/"++Cs, []) -> Cs.
143
144do_wildcard_2(Dir, Wcf) ->
145    %% Basic wildcards.
146    All = ["abc","abcdef","glurf"],
147    Files = mkfiles(lists:reverse(All), Dir),
148    All = Wcf("*"),
149    ["abc","abcdef"] = Wcf("a*"),
150    ["abc","abcdef"] = Wcf("abc*"),
151    ["abcdef"] = Wcf("abc???"),
152    ["abcdef"] = Wcf("abcd*"),
153    ["abcdef"] = Wcf("*def"),
154    ["abcdef","glurf"] = Wcf("{*def,gl*}"),
155    ["abc","abcdef"] = Wcf("a*{def,}"),
156    ["abc","abcdef"] = Wcf("a*{,def}"),
157
158    %% Constant wildcard.
159    ["abcdef"] = Wcf("abcdef"),
160
161    %% Negative tests.
162    [] = Wcf("b*"),
163    [] = Wcf("bufflig"),
164
165    del(Files),
166    do_wildcard_3(Dir, Wcf).
167
168do_wildcard_3(Dir, Wcf) ->
169    %% Some character sets.
170    All = ["a01","a02","a03","b00","c02","d19"],
171    Files = mkfiles(lists:reverse(All), Dir),
172    All = Wcf("[a-z]*"),
173    All = Wcf("[a-d]*"),
174    All = Wcf("[adbc]*"),
175    All = Wcf("?[0-9][0-9]"),
176    All = Wcf("?[0-1][0-39]"),
177    All = Wcf("[abcdefgh][10][01239]"),
178    ["a01","a02","a03","b00","c02"] = Wcf("[a-z]0[0-3]"),
179    [] = Wcf("?[a-z][0-39]"),
180    del(Files),
181    do_wildcard_4(Dir, Wcf).
182
183do_wildcard_4(Dir, Wcf) ->
184    %% More character sets: tricky characters.
185    All = ["a-","aA","aB","aC","a[","a]"],
186    Files = mkfiles(lists:reverse(All), Dir),
187    All = Wcf("a[][A-C-]"),
188    ["a-"] = Wcf("a[-]"),
189    ["a["] = Wcf("a["),
190    del(Files),
191    do_wildcard_5(Dir, Wcf).
192
193do_wildcard_5(Dir, Wcf) ->
194    Dirs = ["xa","blurf","yyy"],
195    foreach(fun(D) -> ok = file:make_dir(filename:join(Dir, D)) end, Dirs),
196    All = ["blurf/nisse","xa/arne","xa/kalle","yyy/arne"],
197    Files = mkfiles(lists:reverse(All), Dir),
198
199    %% Test.
200    All = Wcf("*/*"),
201    ["blurf/nisse","xa/arne","xa/kalle"] = Wcf("{blurf,xa}/*"),
202    ["xa/arne","yyy/arne"] = Wcf("*/arne"),
203    ["blurf/nisse"] = Wcf("*/nisse"),
204    [] = Wcf("mountain/*"),
205    [] = Wcf("xa/gurka"),
206    ["blurf/nisse"] = Wcf("blurf/nisse"),
207
208    %% Cleanup
209    del(Files),
210    foreach(fun(D) -> ok = file:del_dir(filename:join(Dir, D)) end, Dirs),
211    do_wildcard_6(Dir, Wcf).
212
213do_wildcard_6(Dir, Wcf) ->
214    ok = file:make_dir(filename:join(Dir, "xbin")),
215    All = ["xbin/a.x","xbin/b.x","xbin/c.x"],
216    Files = mkfiles(All, Dir),
217    All = Wcf("xbin/*.x"),
218    All = Wcf("xbin/*"),
219    ["xbin"] = Wcf("*"),
220    All = Wcf("*/*"),
221    del(Files),
222    ok = file:del_dir(filename:join(Dir, "xbin")),
223    do_wildcard_7(Dir, Wcf).
224
225do_wildcard_7(Dir, Wcf) ->
226    Dirs = ["blurf","xa","yyy"],
227    SubDirs = ["blurf/nisse"],
228    foreach(fun(D) ->
229		    ok = file:make_dir(filename:join(Dir, D))
230	    end, Dirs ++ SubDirs),
231    All = ["blurf/nisse/baz","xa/arne","xa/kalle","yyy/arne"],
232    Files = mkfiles(lists:reverse(All), Dir),
233
234    %% Test.
235    Listing = Wcf("**"),
236    ["blurf","blurf/nisse","blurf/nisse/baz",
237     "xa","xa/arne","xa/kalle","yyy","yyy/arne"] = Listing,
238    Listing = Wcf("**/*"),
239    ["xa/arne","yyy/arne"] = Wcf("**/arne"),
240    ["blurf/nisse"] = Wcf("**/nisse"),
241    [] = Wcf("mountain/**"),
242
243    %% Cleanup
244    del(Files),
245    foreach(fun(D) ->
246		    ok = file:del_dir(filename:join(Dir, D))
247	    end, SubDirs ++ Dirs),
248    do_wildcard_8(Dir, Wcf).
249
250do_wildcard_8(Dir, Wcf) ->
251    Dirs0 = ["blurf"],
252    Dirs1 = ["blurf/nisse"],
253    Dirs2 = ["blurf/nisse/a", "blurf/nisse/b"],
254    foreach(fun(D) ->
255		    ok = file:make_dir(filename:join(Dir, D))
256	    end, Dirs0 ++ Dirs1 ++ Dirs2),
257    All = ["blurf/nisse/a/1.txt", "blurf/nisse/b/2.txt", "blurf/nisse/b/3.txt"],
258    Files = mkfiles(lists:reverse(All), Dir),
259
260    %% Test.
261    All = Wcf("**/blurf/**/*.txt"),
262
263    %% Cleanup
264    del(Files),
265    foreach(fun(D) ->
266		    ok = file:del_dir(filename:join(Dir, D))
267	    end, Dirs2 ++ Dirs1 ++ Dirs0),
268    do_wildcard_9(Dir, Wcf).
269
270do_wildcard_9(Dir, Wcf) ->
271    Dirs0 = ["lib","lib/app","lib/app/ebin"],
272    Dirs = [filename:join(Dir, D) || D <- Dirs0],
273    [ok = file:make_dir(D) || D <- Dirs],
274    Files0 = [filename:join("lib/app/ebin", F++".bar") ||
275		 F <- ["abc","foo","foobar"]],
276    Files = [filename:join(Dir, F) || F <- Files0],
277    [ok = file:write_file(F, <<"some content\n">>) || F <- Files],
278    Files0 = Wcf("lib/app/ebin/*.bar"),
279
280    %% Cleanup.
281    del(Files),
282    [ok = file:del_dir(D) || D <- lists:reverse(Dirs)],
283    do_wildcard_10(Dir, Wcf).
284
285%% ERL-451/OTP-14577: Escape characters using \\.
286do_wildcard_10(Dir, Wcf) ->
287    All0 = ["{abc}","abc","def","---","z--","@a,b","@c"],
288    All = case os:type() of
289              {unix,_} ->
290                  %% '?' is allowed in file names on Unix, but
291                  %% not on Windows.
292                  ["?q"|All0];
293              _ ->
294                  All0
295          end,
296    Files = mkfiles(lists:reverse(All), Dir),
297
298    ["{abc}"] = Wcf("\\{a*"),
299    ["{abc}"] = Wcf("\\{abc}"),
300    ["abc","def","z--"] = Wcf("[a-z]*"),
301    ["---","abc","z--"] = Wcf("[a\\-z]*"),
302    ["@a,b","@c"] = Wcf("@{a\\,b,c}"),
303    ["@c"] = Wcf("@{a,b,c}"),
304
305    case os:type() of
306        {unix,_} ->
307            ["?q"] = Wcf("\\?q");
308        _ ->
309            [] = Wcf("\\?q")
310    end,
311
312    del(Files),
313    wildcard_11(Dir, Wcf).
314
315%% ERL-ERL-1029/OTP-15987: Fix problems with "@/.." and ".." in general.
316wildcard_11(Dir, Wcf) ->
317    Dirs0 = ["@","@dir","dir@"],
318    Dirs = [filename:join(Dir, D) || D <- Dirs0],
319    _ = [ok = file:make_dir(D) || D <- Dirs],
320    Files0 = ["@a","b@","x","y","z"],
321    Files = mkfiles(Files0, Dir),
322
323    ["@","@a","@dir","b@","dir@","x","y","z"] = Wcf("*"),
324    ["@"] = Wcf("@"),
325    ["@","@a","@dir"] = Wcf("@*"),
326    ["@/..","@dir/.."] = Wcf("@*/.."),
327    ["@/../@","@/../@a","@/../@dir",
328     "@dir/../@","@dir/../@a","@dir/../@dir"] = Wcf("@*/../@*"),
329
330    %% Non-directories followed by "/.." should not match any files.
331    [] = Wcf("@a/.."),
332    [] = Wcf("x/.."),
333
334    %% Cleanup.
335    del(Files),
336    [ok = file:del_dir(D) || D <- Dirs],
337    ok.
338
339fold_files(Config) when is_list(Config) ->
340    Dir = filename:join(proplists:get_value(priv_dir, Config), "fold_files"),
341    ok = file:make_dir(Dir),
342    Dirs = [filename:join(Dir, D) || D <- ["blurf","blurf/blarf"]],
343    foreach(fun(D) -> ok = file:make_dir(D) end, Dirs),
344    All = ["fb.txt","ko.txt",
345	   "blurf/nisse.text","blurf/blarf/aaa.txt","blurf/blarf/urfa.txt"],
346    Files = mkfiles(lists:reverse(All), Dir),
347
348    %% Test.
349    Files0 = filelib:fold_files(Dir, "^", false,
350				fun(H, T) -> [H|T] end, []),
351    same_lists(["fb.txt","ko.txt"], Files0, Dir),
352
353    Files1 = filelib:fold_files(Dir, "^", true,
354				fun(H, T) -> [H|T] end, []),
355    same_lists(All, Files1, Dir),
356
357    Files2 = filelib:fold_files(Dir, "[.]text$", true,
358				fun(H, T) -> [H|T] end, []),
359    same_lists(["blurf/nisse.text"], Files2, Dir),
360
361
362    Files3 = filelib:fold_files(Dir, "^..[.]", true,
363				fun(H, T) -> [H|T] end, []),
364    same_lists(["fb.txt","ko.txt"], Files3, Dir),
365
366    Files4 = filelib:fold_files(Dir, "^ko[.]txt$", true,
367				fun(H, T) -> [H|T] end, []),
368    same_lists(["ko.txt"], Files4, Dir),
369    Files4 = filelib:fold_files(Dir, "^ko[.]txt$", false,
370				fun(H, T) -> [H|T] end, []),
371
372    [] = filelib:fold_files(Dir, "^$", true,
373			    fun(H, T) -> [H|T] end, []),
374
375    %% Cleanup
376    del(Files),
377    foreach(fun(D) -> ok = file:del_dir(D) end, lists:reverse(Dirs)),
378    ok = file:del_dir(Dir).
379
380same_lists(Expected0, Actual0, BaseDir) ->
381    Expected = [filename:absname(N, BaseDir) || N <- lists:sort(Expected0)],
382    Actual = lists:sort(Actual0),
383    Expected = Actual.
384
385mkfiles([H|T], Dir) ->
386    Name = filename:join(Dir, H),
387    Garbage = [31+rand:uniform(95) || _ <- lists:seq(1, rand:uniform(1024))],
388    file:write_file(Name, Garbage),
389    [Name|mkfiles(T, Dir)];
390mkfiles([], _) -> [].
391
392del([H|T]) ->
393    ok = file:delete(H),
394    del(T);
395del([]) -> ok.
396
397%% Test that filelib:ensure_dir/1 returns ok or {error,Reason}.
398otp_5960(Config) when is_list(Config) ->
399    PrivDir = proplists:get_value(priv_dir, Config),
400    Dir = filename:join(PrivDir, "otp_5960_dir"),
401    Name1 = filename:join(Dir, name1),
402    Name2 = filename:join(Dir, name2),
403    ok = filelib:ensure_dir(Name1), % parent is created
404    ok = filelib:ensure_dir(Name1), % repeating it should be OK
405    ok = filelib:ensure_dir(Name2), % parent already exists
406    ok = filelib:ensure_dir(Name2), % repeating it should be OK
407    Name3 = filename:join(Name1, name3),
408    {ok, FileInfo} = file:read_file_info(Dir),
409    case os:type() of
410	{win32,_} ->
411	    %% Not possibly to write protect directories on Windows
412	    %% (at least not using file:write_file_info/2).
413	    ok;
414	_ ->
415	    Mode = FileInfo#file_info.mode,
416	    NoWriteMode = Mode - 8#00200 - 8#00020 - 8#00002,
417	    ok = file:write_file_info(Dir, #file_info{mode=NoWriteMode}),
418	    {error, _} = filelib:ensure_dir(Name3),
419	    ok = file:write_file_info(Dir, #file_info{mode=Mode}),
420	    ok
421    end.
422
423ensure_dir_eexist(Config) when is_list(Config) ->
424    PrivDir = proplists:get_value(priv_dir, Config),
425    Dir = filename:join(PrivDir, "ensure_dir_eexist"),
426    Name = filename:join(Dir, "same_name_as_file_and_dir"),
427    ok = filelib:ensure_dir(Name),
428    ok = file:write_file(Name, <<"some string\n">>),
429
430    %% There already is a file with the name of the directory
431    %% we want to create.
432    NeedFile = filename:join(Name, "file"),
433    NeedFileB = filename:join(Name, <<"file">>),
434    {error, eexist} = filelib:ensure_dir(NeedFile),
435    {error, eexist} = filelib:ensure_dir(NeedFileB),
436    ok.
437
438ensure_dir_symlink(Config) when is_list(Config) ->
439    PrivDir = proplists:get_value(priv_dir, Config),
440    Dir = filename:join(PrivDir, "ensure_dir_symlink"),
441    Name = filename:join(Dir, "same_name_as_file_and_dir"),
442    ok = filelib:ensure_dir(Name),
443    ok = file:write_file(Name, <<"some string\n">>),
444    %% With a symlink to the directory.
445    Symlink = filename:join(PrivDir, "ensure_dir_symlink_link"),
446    case file:make_symlink(Dir, Symlink) of
447        {error,enotsup} ->
448            {skip,"Symlinks not supported on this platform"};
449        {error,eperm} ->
450            {win32,_} = os:type(),
451            {skip,"Windows user not privileged to create symlinks"};
452        ok ->
453            SymlinkedName = filename:join(Symlink, "same_name_as_file_and_dir"),
454            ok = filelib:ensure_dir(SymlinkedName)
455    end.
456
457wildcard_symlink(Config) when is_list(Config) ->
458    PrivDir = proplists:get_value(priv_dir, Config),
459    Dir = filename:join(PrivDir, ?MODULE_STRING++"_wildcard_symlink"),
460    SubDir = filename:join(Dir, "sub"),
461    AFile = filename:join(SubDir, "a_file"),
462    Alias = filename:join(Dir, "symlink"),
463    ok = file:make_dir(Dir),
464    ok = file:make_dir(SubDir),
465    ok = file:write_file(AFile, "not that big\n"),
466    case file:make_symlink(AFile, Alias) of
467	{error, enotsup} ->
468	    {skip, "Links not supported on this platform"};
469	{error, eperm} ->
470	    {win32,_} = os:type(),
471	    {skip, "Windows user not privileged to create symlinks"};
472	ok ->
473	    ["sub","symlink"] =
474		basenames(Dir, filelib:wildcard(filename:join(Dir, "*"))),
475	    ["symlink"] =
476		basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"))),
477	    ["sub","symlink"] =
478		basenames(Dir, filelib:wildcard(filename:join(Dir, "*"),
479						erl_prim_loader)),
480	    ["symlink"] =
481		basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"),
482						erl_prim_loader)),
483	    ["sub","symlink"] =
484		basenames(Dir, filelib:wildcard(filename:join(Dir, "*"),
485						?PRIM_FILE)),
486	    ["symlink"] =
487		basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"),
488						?PRIM_FILE)),
489	    ok = file:delete(AFile),
490	    %% The symlink should still be visible even when its target
491	    %% has been deleted.
492	    ["sub","symlink"] =
493		basenames(Dir, filelib:wildcard(filename:join(Dir, "*"))),
494	    ["symlink"] =
495		basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"))),
496	    ["sub","symlink"] =
497		basenames(Dir, filelib:wildcard(filename:join(Dir, "*"),
498						erl_prim_loader)),
499	    ["symlink"] =
500		basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"),
501						erl_prim_loader)),
502	    ["sub","symlink"] =
503		basenames(Dir, filelib:wildcard(filename:join(Dir, "*"),
504						?PRIM_FILE)),
505	    ["symlink"] =
506		basenames(Dir, filelib:wildcard(filename:join(Dir, "symlink"),
507						?PRIM_FILE)),
508	    ok
509    end.
510
511basenames(Dir, Files) ->
512    [begin
513	 Dir = filename:dirname(F),
514	 filename:basename(F)
515     end || F <- Files].
516
517is_file_symlink(Config) ->
518    PrivDir = proplists:get_value(priv_dir, Config),
519    Dir = filename:join(PrivDir, ?MODULE_STRING++"_is_file_symlink"),
520    SubDir = filename:join(Dir, "sub"),
521    AFile = filename:join(SubDir, "a_file"),
522    DirAlias = filename:join(Dir, "dir_symlink"),
523    FileAlias = filename:join(Dir, "file_symlink"),
524    ok = file:make_dir(Dir),
525    ok = file:make_dir(SubDir),
526    ok = file:write_file(AFile, "not that big\n"),
527    case file:make_symlink(SubDir, DirAlias) of
528	{error, enotsup} ->
529	    {skip, "Links not supported on this platform"};
530	{error, eperm} ->
531	    {win32,_} = os:type(),
532	    {skip, "Windows user not privileged to create symlinks"};
533	ok ->
534	    true = filelib:is_dir(DirAlias),
535	    true = filelib:is_dir(DirAlias, erl_prim_loader),
536	    true = filelib:is_dir(DirAlias, ?PRIM_FILE),
537	    true = filelib:is_file(DirAlias),
538	    true = filelib:is_file(DirAlias, erl_prim_loader),
539	    true = filelib:is_file(DirAlias, ?PRIM_FILE),
540	    ok = file:make_symlink(AFile,FileAlias),
541	    true = filelib:is_file(FileAlias),
542	    true = filelib:is_file(FileAlias, erl_prim_loader),
543	    true = filelib:is_file(FileAlias, ?PRIM_FILE),
544	    true = filelib:is_regular(FileAlias),
545	    true = filelib:is_regular(FileAlias, erl_prim_loader),
546	    true = filelib:is_regular(FileAlias, ?PRIM_FILE),
547	    ok
548    end.
549
550file_props_symlink(Config) ->
551    PrivDir = proplists:get_value(priv_dir, Config),
552    Dir = filename:join(PrivDir, ?MODULE_STRING++"_file_props_symlink"),
553    AFile = filename:join(Dir, "a_file"),
554    Alias = filename:join(Dir, "symlink"),
555    ok = file:make_dir(Dir),
556    ok = file:write_file(AFile, "not that big\n"),
557    case file:make_symlink(AFile, Alias) of
558	{error, enotsup} ->
559	    {skip, "Links not supported on this platform"};
560	{error, eperm} ->
561	    {win32,_} = os:type(),
562	    {skip, "Windows user not privileged to create symlinks"};
563	ok ->
564	    {_,_} = LastMod = filelib:last_modified(AFile),
565	    LastMod = filelib:last_modified(Alias),
566	    LastMod = filelib:last_modified(Alias, erl_prim_loader),
567	    LastMod = filelib:last_modified(Alias, ?PRIM_FILE),
568	    FileSize = filelib:file_size(AFile),
569	    FileSize = filelib:file_size(Alias),
570	    FileSize = filelib:file_size(Alias, erl_prim_loader),
571	    FileSize = filelib:file_size(Alias, ?PRIM_FILE)
572    end.
573
574find_source(Config) when is_list(Config) ->
575    %% filename:find_{file,source}() does not work if the files are
576    %% cover-compiled. To make sure that the test does not fail
577    %% when the STDLIB is cover-compiled, search for modules in
578    %% the compiler application.
579
580    BeamFile = code:which(compile),
581    BeamName = filename:basename(BeamFile),
582    BeamDir = filename:dirname(BeamFile),
583    SrcName = filename:basename(BeamFile, ".beam") ++ ".erl",
584
585    {ok, BeamFile} = filelib:find_file(BeamName, BeamDir),
586    {ok, BeamFile} = filelib:find_file(BeamName, BeamDir, []),
587    {ok, BeamFile} = filelib:find_file(BeamName, BeamDir, [{"",""},{"ebin","src"}]),
588    {error, not_found} = filelib:find_file(BeamName, BeamDir, [{"ebin","src"}]),
589
590    {ok, SrcFile} = filelib:find_file(SrcName, BeamDir),
591    {ok, SrcFile} = filelib:find_file(SrcName, BeamDir, []),
592    {ok, SrcFile} = filelib:find_file(SrcName, BeamDir, [{"foo","bar"},{"ebin","src"}]),
593    {error, not_found} = filelib:find_file(SrcName, BeamDir, [{"",""}]),
594
595    {ok, SrcFile} = filelib:find_source(BeamFile),
596    {ok, SrcFile} = filelib:find_source(BeamName, BeamDir),
597    {ok, SrcFile} = filelib:find_source(BeamName, BeamDir,
598                                         [{".erl",".yrl",[{"",""}]},
599                                          {".beam",".erl",[{"ebin","src"}]}]),
600    {error, not_found} = filelib:find_source(BeamName, BeamDir,
601                                              [{".erl",".yrl",[{"",""}]}]),
602
603    {ok, ParserErl} = filelib:find_source(code:which(core_parse)),
604    ParserErlName = filename:basename(ParserErl),
605    ParserErlDir = filename:dirname(ParserErl),
606    {ok, ParserYrl} = filelib:find_source(ParserErl),
607    "lry." ++ _ = lists:reverse(ParserYrl),
608    {ok, ParserYrl} = filelib:find_source(ParserErlName, ParserErlDir,
609                                           [{".beam",".erl",[{"ebin","src"}]},
610                                            {".erl",".yrl",[{"",""}]}]),
611
612    %% find_source automatically checks the local directory regardless of rules
613    {ok, ParserYrl} = filelib:find_source(ParserErl),
614    {ok, ParserYrl} = filelib:find_source(ParserErlName, ParserErlDir,
615                                          [{".erl",".yrl",[{"ebin","src"}]}]),
616
617    %% find_file does not check the local directory unless in the rules
618    ParserYrlName = filename:basename(ParserYrl),
619    ParserYrlDir = filename:dirname(ParserYrl),
620    {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir,
621                                        [{"",""}]),
622    {error, not_found} = filelib:find_file(ParserYrlName, ParserYrlDir,
623                                           [{"ebin","src"}]),
624
625    %% local directory is in the default list for find_file
626    {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir),
627    {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir, []),
628    ok.
629
630find_source_subdir(Config) when is_list(Config) ->
631    BeamFile = code:which(inets), % Located in lib/inets/src/inets_app/
632    BeamName = filename:basename(BeamFile),
633    BeamDir = filename:dirname(BeamFile),
634    SrcName = filename:basename(BeamFile, ".beam") ++ ".erl",
635
636    {ok, SrcFile} = filelib:find_source(BeamName, BeamDir),
637    SrcName = filename:basename(SrcFile),
638
639    {error, not_found} =
640        filelib:find_source(BeamName, BeamDir,
641                            [{".beam",".erl",[{"ebin","src"}]}]),
642    {ok, SrcFile} =
643        filelib:find_source(BeamName, BeamDir,
644                            [{".beam",".erl",
645                              [{"ebin",filename:join("src", "*")}]}]),
646
647    {ok, SrcFile} = filelib:find_file(SrcName, BeamDir),
648
649    ok.
650