diff --git a/src/rebar_prv_eunit.erl b/src/rebar_prv_eunit.erl index 5d0f65fb9..309f41719 100644 --- a/src/rebar_prv_eunit.erl +++ b/src/rebar_prv_eunit.erl @@ -63,6 +63,8 @@ do(State) -> do_tests(State, Tests) -> EUnitOpts = resolve_eunit_opts(State), + ?DEBUG("eunit_tests ~p", [Tests]), + ?DEBUG("eunit_opts ~p", [EUnitOpts]), Result = eunit:test(Tests, EUnitOpts), ok = rebar_prv_cover:maybe_write_coverdata(State, ?PROVIDER), case handle_results(Result) of @@ -76,7 +78,9 @@ do_tests(State, Tests) -> format_error(unknown_error) -> io_lib:format("Error running tests", []); format_error({error_running_tests, Reason}) -> - io_lib:format("Error running tests: ~p", [Reason]). + io_lib:format("Error running tests: ~p", [Reason]); +format_error({error, Error}) -> + format_error({error_running_tests, Error}). %% =================================================================== %% Internal functions @@ -108,55 +112,87 @@ first_files(State) -> prepare_tests(State) -> {RawOpts, _} = rebar_state:command_parsed_args(State), ok = maybe_cover_compile(State, RawOpts), + CmdTests = resolve_tests(RawOpts), + CfgTests = rebar_state:get(State, eunit_tests, []), ProjectApps = project_apps(State), - resolve_tests(ProjectApps, RawOpts). - -maybe_cover_compile(State, Opts) -> - State1 = case proplists:get_value(cover, Opts, false) of - true -> rebar_state:set(State, cover_enabled, true); - false -> State - end, - rebar_prv_cover:maybe_cover_compile(State1). + Tests = select_tests(ProjectApps, CmdTests, CfgTests), + validate_tests(State, ProjectApps, Tests). + +resolve_tests(RawOpts) -> + Apps = resolve(app, application, RawOpts), + Dirs = resolve(dir, RawOpts), + Files = resolve(file, RawOpts), + Modules = resolve(module, RawOpts), + Suites = resolve(suite, module, RawOpts), + Apps ++ Dirs ++ Files ++ Modules ++ Suites. + +resolve(Flag, RawOpts) -> resolve(Flag, Flag, RawOpts). + +resolve(Flag, EUnitKey, RawOpts) -> + case proplists:get_value(Flag, RawOpts) of + undefined -> []; + Args -> lists:map(fun(Arg) -> normalize(EUnitKey, Arg) end, string:tokens(Args, [$,])) + end. -resolve_tests(ProjectApps, RawOpts) -> - case proplists:get_value(file, RawOpts) of - undefined -> resolve_apps(ProjectApps, RawOpts); - Files -> resolve_files(ProjectApps, Files, RawOpts) +normalize(Key, Value) when Key == dir; Key == file -> {Key, Value}; +normalize(Key, Value) -> {Key, list_to_atom(Value)}. + +select_tests(ProjectApps, [], []) -> default_tests(ProjectApps); +select_tests(_ProjectApps, A, B) -> A ++ B. + +validate_tests(State, ProjectApps, Tests) -> + {ok, lists:filter(fun(Elem) -> validate(State, ProjectApps, Elem) end, Tests)}. + +validate(_State, ProjectApps, {application, App}) -> + validate_app(App, ProjectApps); +validate(State, _ProjectApps, {dir, Dir}) -> + ok = maybe_compile_dir(State, Dir), + validate_dir(Dir); +validate(State, _ProjectApps, {file, File}) -> + ok = maybe_compile_file(State, File), + validate_file(File); +validate(_State, ProjectApps, {module, Module}) -> + validate_module(Module, ProjectApps); +validate(_State, ProjectApps, {suite, Module}) -> + validate_module(Module, ProjectApps); +validate(_State, ProjectApps, Module) when is_atom(Module) -> + validate_module(Module, ProjectApps); +validate(State, ProjectApps, Path) when is_list(Path) -> + case ec_file:is_dir(Path) of + true -> validate(State, ProjectApps, {dir, Path}); + false -> validate(State, ProjectApps, {file, Path}) + end; +%% unrecognized tests should be included. if they're invalid eunit will error +%% and rebar.config may contain arbitrarily complex tests that are effectively +%% unvalidatable +validate(_State, _ProjectApps, _Test) -> true. + +validate_app(AppName, []) -> + ?WARN(lists:concat(["Application `", AppName, "' not found in project."]), []), + false; +validate_app(AppName, [App|Rest]) -> + case AppName == binary_to_atom(rebar_app_info:name(App), unicode) of + true -> true; + false -> validate_app(AppName, Rest) end. -resolve_files(ProjectApps, Files, RawOpts) -> - case {proplists:get_value(app, RawOpts), proplists:get_value(suite, RawOpts)} of - {undefined, undefined} -> resolve_files(Files, []); - _ -> - case resolve_apps(ProjectApps, RawOpts) of - {ok, TestSet} -> resolve_files(Files, TestSet); - Error -> Error - end +validate_dir(Dir) -> + case ec_file:is_dir(Dir) of + true -> true; + false -> ?WARN(lists:concat(["Directory `", Dir, "' not found."]), []), false end. -resolve_files(Files, TestSet) -> - FileNames = string:tokens(Files, [$,]), - {ok, TestSet ++ set_files(FileNames, [])}. - -resolve_apps(ProjectApps, RawOpts) -> - case proplists:get_value(app, RawOpts) of - undefined -> resolve_suites(ProjectApps, RawOpts); - %% convert app name strings to `rebar_app_info` objects - Apps -> AppNames = string:tokens(Apps, [$,]), - case filter_apps_by_name(AppNames, ProjectApps) of - {ok, TestApps} -> resolve_suites(TestApps, RawOpts); - Error -> Error - end +validate_file(File) -> + case ec_file:exists(File) of + true -> true; + false -> ?WARN(lists:concat(["File `", File, "' not found."]), []), false end. -resolve_suites(Apps, RawOpts) -> - case proplists:get_value(suite, RawOpts) of - undefined -> test_set(Apps, all); - Suites -> SuiteNames = string:tokens(Suites, [$,]), - case filter_suites_by_apps(SuiteNames, Apps) of - {ok, S} -> test_set(Apps, S); - Error -> Error - end +validate_module(Module, Apps) -> + AppModules = app_modules([binary_to_atom(rebar_app_info:name(A), unicode) || A <- Apps], []), + case lists:member(Module, AppModules) of + true -> true; + false -> ?WARN(lists:concat(["Module `", Module, "' not found in applications."]), []), false end. project_apps(State) -> @@ -171,42 +207,6 @@ filter_checkouts([App|Rest], Acc) -> false -> filter_checkouts(Rest, [App|Acc]) end. -%% make sure applications specified actually exist -filter_apps_by_name(AppNames, ProjectApps) -> - filter_apps_by_name(AppNames, ProjectApps, []). - -filter_apps_by_name([], _ProjectApps, Acc) -> {ok, lists:reverse(Acc)}; -filter_apps_by_name([Name|Rest], ProjectApps, Acc) -> - case find_app_by_name(Name, ProjectApps) of - {error, app_not_found} -> - ?PRV_ERROR({error_running_tests, - "Application `" ++ Name ++ "' not found in project."}); - App -> - filter_apps_by_name(Rest, ProjectApps, [App|Acc]) - end. - -find_app_by_name(_, []) -> {error, app_not_found}; -find_app_by_name(Name, [App|Rest]) -> - case Name == binary_to_list(rebar_app_info:name(App)) of - true -> App; - false -> find_app_by_name(Name, Rest) - end. - -%% ensure specified suites are in the applications included -filter_suites_by_apps(Suites, ProjectApps) -> - filter_suites_by_apps(Suites, ProjectApps, []). - -filter_suites_by_apps([], _ProjectApps, Acc) -> {ok, lists:reverse(Acc)}; -filter_suites_by_apps([Suite|Rest], Apps, Acc) -> - Modules = app_modules([binary_to_atom(rebar_app_info:name(A), unicode) || A <- Apps], []), - case lists:member(list_to_atom(Suite), Modules) of - false -> - ?PRV_ERROR({error_running_tests, - "Module `" ++ Suite ++ "' not found in applications."}); - true -> - filter_suites_by_apps(Rest, Apps, [Suite|Acc]) - end. - app_modules([], Acc) -> Acc; app_modules([App|Rest], Acc) -> Unload = case application:load(App) of @@ -225,22 +225,13 @@ app_modules([App|Rest], Acc) -> app_modules(Rest, NewAcc) end. -test_set(Apps, all) -> {ok, set_apps(Apps, [])}; -test_set(_Apps, Suites) -> {ok, set_suites(Suites, [])}. +default_tests(Apps) -> set_apps(Apps, []). set_apps([], Acc) -> lists:reverse(Acc); set_apps([App|Rest], Acc) -> AppName = list_to_atom(binary_to_list(rebar_app_info:name(App))), set_apps(Rest, [{application, AppName}|Acc]). -set_suites([], Acc) -> lists:reverse(Acc); -set_suites([Suite|Rest], Acc) -> - set_suites(Rest, [{module, list_to_atom(Suite)}|Acc]). - -set_files([], Acc) -> lists:reverse(Acc); -set_files([File|Rest], Acc) -> - set_files(Rest, [{file, File}|Acc]). - resolve_eunit_opts(State) -> {Opts, _} = rebar_state:command_parsed_args(State), EUnitOpts = rebar_state:get(State, eunit_opts, []), @@ -256,6 +247,16 @@ set_verbose(Opts) -> false -> [verbose] ++ Opts end. +maybe_compile_dir(_, _) -> ok. +maybe_compile_file(_, _) -> ok. + +maybe_cover_compile(State, Opts) -> + State1 = case proplists:get_value(cover, Opts, false) of + true -> rebar_state:set(State, cover_enabled, true); + false -> State + end, + rebar_prv_cover:maybe_cover_compile(State1). + handle_results(ok) -> ok; handle_results(error) -> {error, unknown_error}; @@ -265,12 +266,16 @@ handle_results({error, Reason}) -> eunit_opts(_State) -> [{app, undefined, "app", string, help(app)}, {cover, $c, "cover", boolean, help(cover)}, - {file, $f, "file", string, help(file)}, + {dir, undefined, "dir", string, help(dir)}, + {file, undefined, "file", string, help(file)}, + {module, undefined, "module", string, help(module)}, {suite, undefined, "suite", string, help(suite)}, {verbose, $v, "verbose", boolean, help(verbose)}]. -help(app) -> "Comma seperated list of application test suites to run. Equivalent to `[{application, App}]`."; +help(app) -> "Comma separated list of application test suites to run. Equivalent to `[{application, App}]`."; help(cover) -> "Generate cover data. Defaults to false."; -help(file) -> "Comma seperated list of files to run. Equivalent to `[{file, File}]`."; -help(suite) -> "Comma seperated list of test suites to run. Equivalent to `[{module, Suite}]`."; +help(dir) -> "Comma separated list of dirs to load tests from. Equivalent to `[{dir, Dir}]`."; +help(file) -> "Comma separated list of files to load tests from. Equivalent to `[{file, File}]`."; +help(module) -> "Comma separated list of modules to load tests from. Equivalent to `[{module, Module}]`."; +help(suite) -> "Comma separated list of test suites to run. Equivalent to `[{module, Suite}]`."; help(verbose) -> "Verbose output. Defaults to false.". diff --git a/test/rebar_eunit_SUITE.erl b/test/rebar_eunit_SUITE.erl index d2dac1d24..0600b4579 100644 --- a/test/rebar_eunit_SUITE.erl +++ b/test/rebar_eunit_SUITE.erl @@ -14,14 +14,11 @@ test_multi_defines/1, test_single_app_flag/1, test_multiple_app_flag/1, - test_nonexistent_app_flag/1, test_single_suite_flag/1, test_suite_in_app_flag/1, - test_suite_in_wrong_app_flag/1, - test_nonexistent_suite_flag/1, test_single_file_flag/1, test_multiple_file_flag/1, - test_nonexistent_file_flag/1]). + test_config_tests/1]). -include_lib("common_test/include/ct.hrl"). -include_lib("eunit/include/eunit.hrl"). @@ -43,10 +40,10 @@ all() -> [test_basic_app, test_multi_app, test_profile, test_basic_exports, test_multi_exports, test_basic_defines, test_multi_defines, - test_single_app_flag, test_multiple_app_flag, test_nonexistent_app_flag, + test_single_app_flag, test_multiple_app_flag, test_single_suite_flag, test_suite_in_app_flag, - test_suite_in_wrong_app_flag, test_nonexistent_suite_flag, - test_single_file_flag, test_multiple_file_flag, test_nonexistent_file_flag]. + test_single_file_flag, test_multiple_file_flag, + test_config_tests]. test_basic_app(Config) -> AppDir = ?config(apps, Config), @@ -281,30 +278,6 @@ test_multiple_app_flag(Config) -> {module, Suite2} = code:ensure_loaded(Suite2), {error, nofile} = code:ensure_loaded(all_tests). -test_nonexistent_app_flag(Config) -> - AppDir = ?config(apps, Config), - - Name1 = rebar_test_utils:create_random_name("multi_exports_app1_"), - Vsn1 = rebar_test_utils:create_random_vsn(), - rebar_test_utils:create_eunit_app(filename:join([AppDir,Name1]), - Name1, - Vsn1, - [kernel, stdlib]), - Name2 = rebar_test_utils:create_random_name("multi_exports_app2_"), - Vsn2 = rebar_test_utils:create_random_vsn(), - rebar_test_utils:create_eunit_app(filename:join([AppDir,"apps",Name2]), - Name2, - Vsn2, - [kernel, stdlib]), - - RebarConfig = [{erl_opts, [{d, some_define}]}], - {error, {_, Error}} = rebar_test_utils:run_and_check(Config, - RebarConfig, - ["eunit", "--app=not_a_real_app"], - return), - - Error = {error_running_tests, "Application `not_a_real_app' not found in project."}. - test_single_suite_flag(Config) -> AppDir = ?config(apps, Config), @@ -359,58 +332,6 @@ test_suite_in_app_flag(Config) -> Suite2 = list_to_atom("not_a_real_src_" ++ Name2 ++ "_tests"), {error, nofile} = code:ensure_loaded(Suite2). -test_suite_in_wrong_app_flag(Config) -> - AppDir = ?config(apps, Config), - - Name1 = rebar_test_utils:create_random_name("multi_exports_app1_"), - Vsn1 = rebar_test_utils:create_random_vsn(), - rebar_test_utils:create_eunit_app(filename:join([AppDir,"apps",Name1]), - Name1, - Vsn1, - [kernel, stdlib]), - Name2 = rebar_test_utils:create_random_name("multi_exports_app2_"), - Vsn2 = rebar_test_utils:create_random_vsn(), - rebar_test_utils:create_eunit_app(filename:join([AppDir,"apps",Name2]), - Name2, - Vsn2, - [kernel, stdlib]), - - RebarConfig = [{erl_opts, [{d, some_define}]}], - {error, {_, Error}} = rebar_test_utils:run_and_check(Config, - RebarConfig, - ["eunit", - "--app=" ++ Name1, - "--suite=not_a_real_src_" ++ Name2], - return), - - Error = {error_running_tests, "Module `not_a_real_src_" ++ - Name2 ++ - "' not found in applications."}. - -test_nonexistent_suite_flag(Config) -> - AppDir = ?config(apps, Config), - - Name1 = rebar_test_utils:create_random_name("multi_exports_app1_"), - Vsn1 = rebar_test_utils:create_random_vsn(), - rebar_test_utils:create_eunit_app(filename:join([AppDir,"apps",Name1]), - Name1, - Vsn1, - [kernel, stdlib]), - Name2 = rebar_test_utils:create_random_name("multi_exports_app2_"), - Vsn2 = rebar_test_utils:create_random_vsn(), - rebar_test_utils:create_eunit_app(filename:join([AppDir,"apps",Name2]), - Name2, - Vsn2, - [kernel, stdlib]), - - RebarConfig = [{erl_opts, [{d, some_define}]}], - {error, {_, Error}} = rebar_test_utils:run_and_check(Config, - RebarConfig, - ["eunit", "--suite=not_a_real_module"], - return), - - Error = {error_running_tests, "Module `not_a_real_module' not found in applications."}. - test_single_file_flag(Config) -> AppDir = ?config(apps, Config), @@ -421,7 +342,7 @@ test_single_file_flag(Config) -> RebarConfig = [{erl_opts, [{d, some_define}]}], rebar_test_utils:run_and_check(Config, RebarConfig, - ["eunit", "--file=not_a_real_src_" ++ Name ++ "_tests.beam"], + ["eunit", "--file=" ++ AppDir ++ "/_build/test/lib/" ++ Name ++ "/ebin/not_a_real_src_" ++ Name ++ "_tests.beam"], {ok, [{app, Name}]}), File = list_to_atom("not_a_real_src_" ++ Name ++ "_tests"), @@ -437,7 +358,7 @@ test_multiple_file_flag(Config) -> RebarConfig = [{erl_opts, [{d, some_define}]}], rebar_test_utils:run_and_check(Config, RebarConfig, - ["eunit", "--file=not_a_real_src_" ++ Name ++ "_tests.beam,not_a_real_src_" ++ Name ++ ".beam"], + ["eunit", "--file=" ++ AppDir ++ "/_build/test/lib/" ++ Name ++ "/ebin/not_a_real_src_" ++ Name ++ "_tests.beam," ++ AppDir ++ "/_build/test/lib/" ++ Name ++ "/ebin/not_a_real_src_" ++ Name ++ ".beam"], {ok, [{app, Name}]}), File1 = list_to_atom("not_a_real_src_" ++ Name ++ "_tests"), @@ -446,19 +367,40 @@ test_multiple_file_flag(Config) -> File2 = list_to_atom("not_a_real_src_" ++ Name), {module, File2} = code:ensure_loaded(File2). -test_nonexistent_file_flag(Config) -> +test_config_tests(Config) -> AppDir = ?config(apps, Config), - Name = rebar_test_utils:create_random_name("nonexistent_file_flag_app_"), - Vsn = rebar_test_utils:create_random_vsn(), - rebar_test_utils:create_eunit_app(AppDir, - Name, - Vsn, + Name1 = rebar_test_utils:create_random_name("config_tests_app1_"), + Vsn1 = rebar_test_utils:create_random_vsn(), + rebar_test_utils:create_eunit_app(filename:join([AppDir,"apps",Name1]), + Name1, + Vsn1, + [kernel, stdlib]), + Name2 = rebar_test_utils:create_random_name("config_tests_app2_"), + Vsn2 = rebar_test_utils:create_random_vsn(), + rebar_test_utils:create_eunit_app(filename:join([AppDir,"apps",Name2]), + Name2, + Vsn2, [kernel, stdlib]), - RebarConfig = [{erl_opts, [{d, some_define}]}], - {error, {rebar_prv_eunit, _Error}} = rebar_test_utils:run_and_check(Config, - RebarConfig, - ["eunit", "--file=" ++ filename:join(["some_path", "not_a_real_file.erl"])], - return). + BareSuite = io_lib:format("-module(all_tests).\n" + "-compile(export_all).\n" + "-include_lib(\"eunit/include/eunit.hrl\").\n" + "some_test_() -> ?_assert(true).\n" + "define_test_() -> ?_assertEqual(true, ?some_define).\n", []), + FileName = filename:join([AppDir, "test", "all_tests.erl"]), + ok = filelib:ensure_dir(FileName), + ok = ec_file:write(FileName, BareSuite), + + RebarConfig = [{erl_opts, [{d, some_define}]}, {eunit_tests, [{application, list_to_atom(Name1)}]}], + rebar_test_utils:run_and_check(Config, + RebarConfig, + ["eunit"], + {ok, [{app, Name1}, {app, Name2}]}), + + Suite1 = list_to_atom("not_a_real_src_" ++ Name1 ++ "_tests"), + {module, Suite1} = code:ensure_loaded(Suite1), + Suite2 = list_to_atom("not_a_real_src_" ++ Name2 ++ "_tests"), + {error, nofile} = code:ensure_loaded(Suite2), + {error, nofile} = code:ensure_loaded(all_tests).