Skip to content

Commit

Permalink
Removed filelib_find_source macro, and rebar_utils:find_source/3
Browse files Browse the repository at this point in the history
* introcuded by dec4846
* introcuded to workaround releases prior R20 not having filelib:find_source/3 [1]
* CI/CD now uses R25 to R27.

[1] https://www.erlang.org/doc/apps/stdlib/filelib.html#find_source/3
  • Loading branch information
ariel-anieli committed Jun 21, 2024
1 parent d456815 commit 1c5567c
Show file tree
Hide file tree
Showing 2 changed files with 1 addition and 78 deletions.
4 changes: 1 addition & 3 deletions apps/rebar/rebar.config
Original file line number Diff line number Diff line change
Expand Up @@ -34,9 +34,7 @@

{overrides, [{add, relx, [{erl_opts, [{d, 'RLX_LOG', rebar_log}]}]}]}.

{erl_opts, [warnings_as_errors,
{platform_define, "^(2[1-9])|(20\\\\.3)", filelib_find_source}
]}.
{erl_opts, [warnings_as_errors]}.

{edoc_opts, [preprocess]}.

Expand Down
75 changes: 0 additions & 75 deletions apps/rebar/src/rebar_utils.erl
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,6 @@
find_files/2,
find_files/3,
find_files_in_dirs/3,
find_source/3,
beam_to_mod/1,
erl_to_mod/1,
beams/1,
Expand Down Expand Up @@ -1211,77 +1210,3 @@ version_pad([Major, Minor, Patch]) ->
{list_to_integer(Major), list_to_integer(Minor), list_to_integer(Patch)};
version_pad([Major, Minor, Patch | _]) ->
{list_to_integer(Major), list_to_integer(Minor), list_to_integer(Patch)}.


-ifdef(filelib_find_source).
find_source(Filename, Dir, Rules) ->
filelib:find_source(Filename, Dir, Rules).
-else.
%% Looks for a file relative to a given directory

-type find_file_rule() :: {ObjDirSuffix::string(), SrcDirSuffix::string()}.

%% Looks for a source file relative to the object file name and directory

-type find_source_rule() :: {ObjExtension::string(), SrcExtension::string(),
[find_file_rule()]}.

keep_suffix_search_rules(Rules) ->
[T || {_,_,_}=T <- Rules].

-spec find_source(file:filename(), file:filename(), [find_source_rule()]) ->
{ok, file:filename()} | {error, not_found}.
find_source(Filename, Dir, Rules) ->
try_suffix_rules(keep_suffix_search_rules(Rules), Filename, Dir).

try_suffix_rules(Rules, Filename, Dir) ->
Ext = filename:extension(Filename),
try_suffix_rules(Rules, filename:rootname(Filename, Ext), Dir, Ext).

try_suffix_rules([{Ext,Src,Rules}|Rest], Root, Dir, Ext)
when is_list(Src), is_list(Rules) ->
case try_dir_rules(add_local_search(Rules), Root ++ Src, Dir) of
{ok, File} -> {ok, File};
_Other ->
try_suffix_rules(Rest, Root, Dir, Ext)
end;
try_suffix_rules([_|Rest], Root, Dir, Ext) ->
try_suffix_rules(Rest, Root, Dir, Ext);
try_suffix_rules([], _Root, _Dir, _Ext) ->
{error, not_found}.

%% ensuring we check the directory of the object file before any other directory
add_local_search(Rules) ->
Local = {"",""},
[Local] ++ lists:filter(fun (X) -> X =/= Local end, Rules).

try_dir_rules([{From, To}|Rest], Filename, Dir)
when is_list(From), is_list(To) ->
case try_dir_rule(Dir, Filename, From, To) of
{ok, File} -> {ok, File};
error -> try_dir_rules(Rest, Filename, Dir)
end;
try_dir_rules([], _Filename, _Dir) ->
{error, not_found}.

try_dir_rule(Dir, Filename, From, To) ->
case lists:suffix(From, Dir) of
true ->
NewDir = lists:sublist(Dir, 1, length(Dir)-length(From))++To,
Src = filename:join(NewDir, Filename),
case filelib:is_regular(Src) of
true -> {ok, Src};
false -> find_regular_file(filelib:wildcard(Src))
end;
false ->
error
end.

find_regular_file([]) ->
error;
find_regular_file([File|Files]) ->
case filelib:is_regular(File) of
true -> {ok, File};
false -> find_regular_file(Files)
end.
-endif.

0 comments on commit 1c5567c

Please sign in to comment.