Skip to content

Commit

Permalink
Merge pull request #2872 from MarkoMin/rebar_src_dirs_env
Browse files Browse the repository at this point in the history
REBAR_SRC_DIRS and REBAR_APP_DIRS fix by making `rebar_dir:src_dirs/1` options default to `["src"]`
  • Loading branch information
ferd authored Mar 25, 2024
2 parents 06aaecd + bd42627 commit 7ff5618
Show file tree
Hide file tree
Showing 14 changed files with 50 additions and 28 deletions.
1 change: 1 addition & 0 deletions apps/rebar/src/rebar.hrl
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@

-define(DEFAULT_BASE_DIR, "_build").
-define(DEFAULT_ROOT_DIR, ".").
-define(DEFAULT_PROJECT_SRC_DIRS, ["src"]).
-define(DEFAULT_PROJECT_APP_DIRS, ["apps/*", "lib/*", "."]).
-define(DEFAULT_PROJECT_PLUGIN_DIRS, ["plugins/*"]).
-define(DEFAULT_CHECKOUTS_DIR, "_checkouts").
Expand Down
4 changes: 2 additions & 2 deletions apps/rebar/src/rebar_app_discover.erl
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@ do(State, LibDirs) ->
BaseDir = rebar_state:dir(State),
Dirs = [filename:join(BaseDir, LibDir) || LibDir <- LibDirs],
RebarOpts = rebar_state:opts(State),
SrcDirs = rebar_dir:src_dirs(RebarOpts, ["src"]),
SrcDirs = rebar_dir:src_dirs(RebarOpts),
Apps = find_apps(Dirs, SrcDirs, all, State),
ProjectDeps = rebar_state:deps_names(State),
DepsDir = rebar_dir:deps_dir(State),
Expand Down Expand Up @@ -318,7 +318,7 @@ find_app(AppInfo, AppDir, Validate, State) ->
%% if no src dir is passed, figure it out from the app info, with a default
%% of src/
AppOpts = rebar_app_info:opts(AppInfo),
SrcDirs = rebar_dir:src_dirs(AppOpts, ["src"]),
SrcDirs = rebar_dir:src_dirs(AppOpts),
find_app_(AppInfo, AppDir, SrcDirs, Validate, State).

%% @doc check that a given app in a directory is there, and whether it's
Expand Down
2 changes: 1 addition & 1 deletion apps/rebar/src/rebar_compiler.erl
Original file line number Diff line number Diff line change
Expand Up @@ -375,7 +375,7 @@ clean_(CompilerMod, AppInfo, _Label) ->
annotate_extras(AppInfo) ->
AppOpts = rebar_app_info:opts(AppInfo),
ExtraDirs = rebar_dir:extra_src_dirs(AppOpts, []),
OldSrcDirs = rebar_dir:src_dirs(AppOpts, ["src"]),
OldSrcDirs = rebar_dir:src_dirs(AppOpts),
%% Re-annotate the directories with non-default options if it is the
%% case; otherwise, later down the line, the options get dropped with
%% profiles. All of this must be done with the rebar_dir functionality
Expand Down
8 changes: 4 additions & 4 deletions apps/rebar/src/rebar_compiler_erl.erl
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,7 @@ context(AppInfo) ->
Mappings = [{".beam", EbinDir}],

OutDir = rebar_app_info:dir(AppInfo),
SrcDirs = rebar_dir:src_dirs(rebar_app_info:opts(AppInfo), ["src"]),
SrcDirs = rebar_dir:src_dirs(rebar_app_info:opts(AppInfo)),
ExistingSrcDirs = lists:filter(fun(D) ->
ec_file:is_dir(filename:join(OutDir, D))
end, SrcDirs),
Expand All @@ -31,7 +31,7 @@ context(AppInfo) ->
%% all source directories are valid, and might also be recursive
lists:append([
find_recursive_incl(OutDir, Src, RebarOpts) ||
Src <- rebar_dir:all_src_dirs(RebarOpts, ["src"], [])
Src <- rebar_dir:all_src_dirs(RebarOpts)
]) ++
%% top-level dir for legacy stuff
[OutDir],
Expand Down Expand Up @@ -84,7 +84,7 @@ needed_files(Graph, FoundFiles, _, AppInfo) ->
),

PrivIncludes = [{i, filename:join(OutDir, Src)}
|| Src <- rebar_dir:all_src_dirs(RebarOpts, ["src"], [])],
|| Src <- rebar_dir:all_src_dirs(RebarOpts)],
AdditionalOpts = PrivIncludes ++ [{i, filename:join(OutDir, "include")}, {i, OutDir}, return],

true = digraph:delete(SubGraph),
Expand Down Expand Up @@ -241,7 +241,7 @@ filename_to_atom(F) -> list_to_atom(filename:rootname(filename:basename(F))).
%% dependencies induced by given graph G.
needed_files(Graph, ErlOpts, RebarOpts, Dir, OutDir, SourceFiles) ->
PrivIncludes = [{i, filename:join(Dir, Src)}
|| Src <- rebar_dir:all_src_dirs(RebarOpts, ["src"], [])],
|| Src <- rebar_dir:all_src_dirs(RebarOpts)],
SharedOpts = [{i, filename:join(Dir, "include")},
{i, Dir}] ++ PrivIncludes ++ ErlOpts,
CompilerOptsSet = erl_compiler_opts_set(),
Expand Down
6 changes: 4 additions & 2 deletions apps/rebar/src/rebar_dir.erl
Original file line number Diff line number Diff line change
Expand Up @@ -250,7 +250,7 @@ do_make_relative_path(Source, Target) ->
%%% the given directory, no matter if it is configured as `src_dirs' or
%%% `extra_src_dirs'.
-spec src_dirs(rebar_dict()) -> list(file:filename_all()).
src_dirs(Opts) -> src_dirs(Opts, []).
src_dirs(Opts) -> src_dirs(Opts, ?DEFAULT_PROJECT_SRC_DIRS).

%% @doc same as `src_dirs/1', but allows to pass in a list of default options.
-spec src_dirs(rebar_dict(), list(file:filename_all())) -> list(file:filename_all()).
Expand Down Expand Up @@ -287,7 +287,9 @@ raw_src_dirs(Type, Opts, Default) ->
%% @doc returns all the source directories (`src_dirs' and
%% `extra_src_dirs').
-spec all_src_dirs(rebar_dict()) -> list(file:filename_all()).
all_src_dirs(Opts) -> all_src_dirs(Opts, [], []).
all_src_dirs(Opts) -> all_src_dirs(Opts,
?DEFAULT_PROJECT_SRC_DIRS,
[]).

%% @doc returns all the source directories (`src_dirs' and
%% `extra_src_dirs') while being able to configure defaults for both.
Expand Down
15 changes: 9 additions & 6 deletions apps/rebar/src/rebar_env.erl
Original file line number Diff line number Diff line change
Expand Up @@ -17,8 +17,10 @@
%% REBAR_GLOBAL_CONFIG_DIR = rebar_dir:global_config_dir/1
%% REBAR_GLOBAL_CACHE_DIR = rebar_dir:global_cache_dir/1
%% REBAR_TEMPLATE_DIR = rebar_dir:template_dir/1
%%
%% (relative paths):
%% REBAR_APP_DIRS = rebar_dir:lib_dirs/1
%% REBAR_SRC_DIRS = rebar_dir:src_dirs/1
%% REBAR_SRC_DIRS = rebar_dir:all_src_dirs/1
%%
%% autoconf compatible variables
%% (see: http://www.gnu.org/software/autoconf/manual/autoconf.html#Erlang-Libraries):
Expand All @@ -28,6 +30,8 @@
%% ERLANG_LIB_VER_erl_interface = version part of path returned by code:lib_dir(erl_interface)
%% ERL = ERLANG_ROOT_DIR/bin/erl
%% ERLC = ERLANG_ROOT_DIR/bin/erl
%% ERLANG_ARCH = rebar_api:wordsize/0
%% ERLANG_TARGET = rebar_api:get_arch/0
%%

-spec create_env(rebar_state:t()) -> proplists:proplist().
Expand All @@ -37,7 +41,6 @@ create_env(State) ->

-spec create_env(rebar_state:t(), rebar_dict()) -> proplists:proplist().
create_env(State, Opts) ->
BaseDir = rebar_dir:base_dir(State),
EnvVars = [
{"REBAR_DEPS_DIR", filename:absname(rebar_dir:deps_dir(State))},
{"REBAR_BUILD_DIR", filename:absname(rebar_dir:base_dir(State))},
Expand All @@ -48,8 +51,8 @@ create_env(State, Opts) ->
{"REBAR_GLOBAL_CONFIG_DIR", filename:absname(rebar_dir:global_config_dir(State))},
{"REBAR_GLOBAL_CACHE_DIR", filename:absname(rebar_dir:global_cache_dir(Opts))},
{"REBAR_TEMPLATE_DIR", filename:absname(rebar_dir:template_dir(State))},
{"REBAR_APP_DIRS", join_dirs(BaseDir, rebar_dir:lib_dirs(State))},
{"REBAR_SRC_DIRS", join_dirs(BaseDir, rebar_dir:all_src_dirs(Opts))},
{"REBAR_APP_DIRS", join_dirs(rebar_dir:lib_dirs(State))},
{"REBAR_SRC_DIRS", join_dirs(rebar_dir:all_src_dirs(Opts))},
{"ERLANG_ERTS_VER", erlang:system_info(version)},
{"ERLANG_ROOT_DIR", code:root_dir()},
{"ERL", filename:join([code:root_dir(), "bin", "erl"])},
Expand Down Expand Up @@ -79,8 +82,8 @@ create_erl_interface_env() ->
%% Internal functions
%% ====================================================================

join_dirs(BaseDir, Dirs) ->
rebar_string:join([filename:join(BaseDir, Dir) || Dir <- Dirs], ":").
join_dirs(Dirs) ->
rebar_string:join(Dirs, ":").

re_version(Path) ->
case re:run(Path, "^.*-(?<VER>[^/-]*)$", [{capture,[1],list}, unicode]) of
Expand Down
6 changes: 3 additions & 3 deletions apps/rebar/src/rebar_erlc_compiler.erl
Original file line number Diff line number Diff line change
Expand Up @@ -118,7 +118,7 @@ compile(AppInfo, CompileOpts) when element(1, AppInfo) == app_info_t ->
compile_mib(AppInfo), MibsOpts),

SrcDirs = lists:map(fun(SrcDir) -> filename:join(Dir, SrcDir) end,
rebar_dir:src_dirs(RebarOpts, ["src"])),
rebar_dir:src_dirs(RebarOpts)),
OutDir = filename:join(Dir, outdir(RebarOpts)),
compile_dirs(RebarOpts, Dir, SrcDirs, OutDir, CompileOpts),

Expand Down Expand Up @@ -151,7 +151,7 @@ compile(State, BaseDir, OutDir, CompileOpts) when element(1, State) == state_t -
compile(RebarOpts, BaseDir, OutDir, CompileOpts) ->
warn_deprecated(),
SrcDirs = lists:map(fun(SrcDir) -> filename:join(BaseDir, SrcDir) end,
rebar_dir:src_dirs(RebarOpts, ["src"])),
rebar_dir:src_dirs(RebarOpts)),
compile_dirs(RebarOpts, BaseDir, SrcDirs, OutDir, CompileOpts),

ExtraDirs = rebar_dir:extra_src_dirs(RebarOpts),
Expand Down Expand Up @@ -563,7 +563,7 @@ internal_erl_compile(Opts, Dir, Module, OutDir, ErlOpts, RebarOpts) ->
Target = target_base(OutDir, Module) ++ ".beam",
ok = filelib:ensure_dir(Target),
PrivIncludes = [{i, filename:join(Dir, Src)}
|| Src <- rebar_dir:all_src_dirs(RebarOpts, ["src"], [])],
|| Src <- rebar_dir:all_src_dirs(RebarOpts)],
AllOpts = [{outdir, filename:dirname(Target)}, no_spawn_compiler_process]
++ ErlOpts ++ PrivIncludes ++
[{i, filename:join(Dir, "include")}, {i, Dir}, return],
Expand Down
2 changes: 1 addition & 1 deletion apps/rebar/src/rebar_otp_app.erl
Original file line number Diff line number Diff line change
Expand Up @@ -182,7 +182,7 @@ ebin_modules(AppInfo, Dir) ->

extra_dirs(State) ->
Extras = rebar_dir:extra_src_dirs(rebar_app_info:opts(State)),
SrcDirs = rebar_dir:src_dirs(rebar_app_info:opts(State), ["src"]),
SrcDirs = rebar_dir:src_dirs(rebar_app_info:opts(State)),
%% remove any dirs that are defined in `src_dirs` from `extra_src_dirs`
Extras -- SrcDirs.

Expand Down
4 changes: 2 additions & 2 deletions apps/rebar/src/rebar_plugins.erl
Original file line number Diff line number Diff line change
Expand Up @@ -205,7 +205,7 @@ discover_plugins(State) ->
LibDirs = rebar_dir:project_plugin_dirs(State),
Dirs = [filename:join(BaseDir, LibDir) || LibDir <- LibDirs],
RebarOpts = rebar_state:opts(State),
SrcDirs = rebar_dir:src_dirs(RebarOpts, ["src"]),
SrcDirs = rebar_dir:src_dirs(RebarOpts),
Found = rebar_app_discover:find_apps(Dirs, SrcDirs, all, State),
?DEBUG("Found local plugins: ~p~n"
"\tusing config: {project_plugin_dirs, ~p}",
Expand Down Expand Up @@ -233,7 +233,7 @@ is_umbrella(State) ->
%% we know this is not an umbrella application.
Root = rebar_dir:root_dir(State),
LibPaths = lists:usort(rebar_dir:lib_dirs(State)) -- ["."],
SrcPaths = rebar_dir:src_dirs(rebar_state:opts(State), ["src"]),
SrcPaths = rebar_dir:src_dirs(rebar_state:opts(State)),
lists:any(fun(Dir) -> [] == filelib:wildcard(filename:join(Root, Dir)) end, LibPaths)
andalso
lists:all(fun(Dir) -> not filelib:is_dir(filename:join(Root, Dir)) end, SrcPaths).
Expand Down
2 changes: 1 addition & 1 deletion apps/rebar/src/rebar_prv_compile.erl
Original file line number Diff line number Diff line change
Expand Up @@ -513,7 +513,7 @@ delete_if_symlink(Path) ->
end.

resolve_src_dirs(Opts) ->
SrcDirs = rebar_dir:src_dirs(Opts, ["src"]),
SrcDirs = rebar_dir:src_dirs(Opts),
ExtraDirs = rebar_dir:extra_src_dirs(Opts, []),
normalize_src_dirs(SrcDirs, ExtraDirs).

Expand Down
2 changes: 1 addition & 1 deletion apps/rebar/src/rebar_prv_eunit.erl
Original file line number Diff line number Diff line change
Expand Up @@ -220,7 +220,7 @@ set_modules([], State, {AppAcc, TestAcc}) ->
dedupe_tests({AppAcc, TestAcc ++ TestSrc});
set_modules([App|Rest], State, {AppAcc, TestAcc}) ->
F = fun(Dir) -> filename:join([rebar_app_info:dir(App), Dir]) end,
AppDirs = lists:map(F, rebar_dir:src_dirs(rebar_app_info:opts(App), ["src"])),
AppDirs = lists:map(F, rebar_dir:src_dirs(rebar_app_info:opts(App))),
Regex = rebar_state:get(State, eunit_test_regex, ?DEFAULT_TEST_REGEX),
AppSrc = gather_src(AppDirs, Regex),
TestDirs = [filename:join([rebar_app_info:dir(App), "test"])],
Expand Down
2 changes: 1 addition & 1 deletion apps/rebar/src/rebar_prv_plugins.erl
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@ do(State) ->
display_plugins("Global plugins", GlobalApps, GlobalPlugins),

RebarOpts = rebar_state:opts(State),
SrcDirs = rebar_dir:src_dirs(RebarOpts, ["src"]),
SrcDirs = rebar_dir:src_dirs(RebarOpts),
{LocalPluginsDefs, _} = list_local_plugins(State),
PluginsDirs = filelib:wildcard(filename:join(rebar_dir:plugins_dir(State), "*")),

Expand Down
8 changes: 5 additions & 3 deletions apps/rebar/test/rebar_dir_SUITE.erl
Original file line number Diff line number Diff line change
Expand Up @@ -68,8 +68,9 @@ end_per_testcase(_, _Config) -> ok.
default_src_dirs(Config) ->
{ok, State} = rebar_test_utils:run_and_check(Config, [], ["compile"], return),

[] = rebar_dir:src_dirs(rebar_state:opts(State)),
["src"] = rebar_dir:src_dirs(rebar_state:opts(State), ["src"]).
[] = rebar_dir:src_dirs(rebar_state:opts(State), []),
["src"] = rebar_dir:src_dirs(rebar_state:opts(State)),
["lib"] = rebar_dir:src_dirs(rebar_state:opts(State), ["lib"]).

default_extra_src_dirs(Config) ->
{ok, State} = rebar_test_utils:run_and_check(Config, [], ["compile"], return),
Expand All @@ -80,7 +81,8 @@ default_extra_src_dirs(Config) ->
default_all_src_dirs(Config) ->
{ok, State} = rebar_test_utils:run_and_check(Config, [], ["compile"], return),

[] = rebar_dir:all_src_dirs(rebar_state:opts(State)),
[] = rebar_dir:all_src_dirs(rebar_state:opts(State), [], []),
["src"] = rebar_dir:all_src_dirs(rebar_state:opts(State)),
["src", "test"] = rebar_dir:all_src_dirs(rebar_state:opts(State), ["src"], ["test"]).

src_dirs(Config) ->
Expand Down
16 changes: 15 additions & 1 deletion apps/rebar/test/rebar_hooks_SUITE.erl
Original file line number Diff line number Diff line change
Expand Up @@ -288,4 +288,18 @@ env_vars_in_hooks(Config) ->
rebar_test_utils:create_config(AppDir, RebarConfig),
rebar_test_utils:create_app(AppDir, Name, Vsn, [kernel, stdlib]),
rebar_test_utils:run_and_check(Config, RebarConfig, ["compile"],
{ok, [{app, Name, valid}, {file, HookFile}]}).
{ok, [{app, Name, valid}, {file, HookFile}]}),

State = rebar_state:new(),
Env = rebar_env:create_env(State),
EnvVars = [Var || {Var,_Value} <- Env],
ShOpts = [{env, Env}],
[check_env(Var,ShOpts) || Var <- EnvVars].

check_env(EnvName, ShOpts) ->
%% check that a variable has a value
%% dont use 'echo -n' because it's not portable
Resp = rebar_utils:sh("echo $"++EnvName, ShOpts),
?assertMatch({ok,_}, Resp),
?assertNotEqual({ok,"\n"},
Resp).

0 comments on commit 7ff5618

Please sign in to comment.