diff --git a/erts/test/erlc_SUITE.erl b/erts/test/erlc_SUITE.erl index cfdc8a10e77e..943412dfea75 100644 --- a/erts/test/erlc_SUITE.erl +++ b/erts/test/erlc_SUITE.erl @@ -835,7 +835,7 @@ features_macros(Config) when is_list(Config) -> erpc:call(Node1, code, load_file, [f_macros]), %% Check features enabled during compilation [approved_ftr_1, approved_ftr_2, experimental_ftr_1] = - erpc:call(Node1, erl_features, used, [f_macros]), + lists:sort(erpc:call(Node1, erl_features, used, [f_macros])), peer:stop(Peer1), @@ -903,7 +903,7 @@ features_all(Config) when is_list(Config) -> {Peer0, Node0} = peer(["-pa", OutDir]), %% Check features enabled during compilation [approved_ftr_1,approved_ftr_2,experimental_ftr_1,experimental_ftr_2] = - erpc:call(Node0, erl_features, used, [foo]), + lists:sort(erpc:call(Node0, erl_features, used, [foo])), peer:stop(Peer0), Compile("foo.erl", longopt(disable, all), @@ -997,8 +997,8 @@ features_runtime(Config) when is_list(Config) -> peer:stop(Peer0), {Peer1, Node1} = peer(["-enable-feature", "experimental_ftr_2"]), - [experimental_ftr_2, approved_ftr_2, approved_ftr_1] = - erpc:call(Node1, erl_features, enabled, []), + [approved_ftr_1, approved_ftr_2, experimental_ftr_2] = + lists:sort(erpc:call(Node1, erl_features, enabled, [])), [while, until, unless] = erpc:call(Node1, erl_features, keywords, []), peer:stop(Peer1), @@ -1077,7 +1077,7 @@ features_include(Config) when is_list(Config) -> {conditional, off, none} = erpc:call(Node3, f_include_exp2, foo, []), [approved_ftr_1, approved_ftr_2, experimental_ftr_2] = - erpc:call(Node3, erl_features, used, [f_include_exp2]), + lists:sort(erpc:call(Node3, erl_features, used, [f_include_exp2])), peer:stop(Peer3), ok. diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 0aaec4405953..f627aec471b1 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -1729,8 +1729,6 @@ abstr_passes(AbstrStatus) -> [ {unless,no_docs,?pass(beam_docs)}, ?pass(remove_doc_attributes), - - %% Add all -compile() directives to #compile.options ?pass(compile_directives), {delay,[{iff,debug_info,?pass(save_abstract_code)}]}, @@ -1975,12 +1973,10 @@ do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) -> [] end]), case R of - %% FIXME Extra should include used features as well {ok,Forms0,Extra} -> Encoding = proplists:get_value(encoding, Extra), %% Get features used in the module, indicated by - %% enabling features with - %% -compile({feature, .., enable}). + %% enabling features with -feature(...). UsedFtrs = proplists:get_value(features, Extra), St1 = metadata_add_features(UsedFtrs, St), Forms = case with_columns(Opts ++ compile_options(Forms0)) of @@ -1989,7 +1985,8 @@ do_parse_module(DefEncoding, #compile{ifile=File,options=Opts,dir=Dir}=St) -> false -> strip_columns(Forms0) end, - {ok,Forms,St1#compile{encoding=Encoding}}; + {ok,Forms,St1#compile{encoding=Encoding, + options=[{features, UsedFtrs}|Opts]}}; {error,E} -> Es = [{St#compile.ifile,[{none,?MODULE,{epp,E}}]}], {error,St#compile{errors=St#compile.errors ++ Es}} @@ -2423,6 +2420,7 @@ legalize_vars(Code0, St) -> end, Code0), {ok,Code,St}. +%% Add all -compile() directives to #compile.options compile_directives(Forms, St) -> Opts = [C || {attribute,_,compile,C} <- Forms], compile_directives_1(Opts, Forms, St). diff --git a/lib/stdlib/src/erl_features.erl b/lib/stdlib/src/erl_features.erl index 4218e7cc8917..3a84c3444788 100644 --- a/lib/stdlib/src/erl_features.erl +++ b/lib/stdlib/src/erl_features.erl @@ -93,6 +93,10 @@ all() -> end, lists:sort(maps:keys(Map)). +approved() -> + [Ftr || Ftr <- all(), + maps:get(status, info(Ftr)) =:= approved]. + -doc """ Return a list of all configurable features, that is, features with status `experimental` or `approved`. These are the features that can be enabled or @@ -228,8 +232,7 @@ keyword_fun(Opts, KeywordFun) -> (_) -> false end, FeatureOps = lists:filter(IsFtr, Opts), - {AddFeatures, DelFeatures, RawFtrs} = collect_features(FeatureOps), - + {AddFeatures, DelFeatures, RawFtrs} = collect_features(FeatureOps, enabled()), case configurable_features(RawFtrs) of ok -> {ok, Fun} = add_features_fun(AddFeatures, KeywordFun), @@ -401,7 +404,7 @@ init_features() -> end end, FOps = lists:filtermap(F, FeatureOps), - {Features, _, _} = collect_features(FOps), + {Features, _, _} = collect_features(FOps, approved()), {Enabled0, Keywords} = lists:foldl(fun(Ftr, {Ftrs, Keys}) -> case lists:member(Ftr, Ftrs) of @@ -492,13 +495,10 @@ features_in(NameOrBin) -> end. %% Interpret feature ops (enable or disable) to build the full set of -%% features. The meta feature 'all' is expanded to all known -%% features. -collect_features(FOps) -> - %% Features enabled by default - Enabled = [Ftr || Ftr <- all(), - maps:get(status, info(Ftr)) == approved], - collect_features(FOps, Enabled, [], []). +%% features, starting from the given set. The meta feature 'all' is +%% expanded to all known features. +collect_features(FOps, Inital) -> + collect_features(FOps, Inital, [], []). collect_features([], Add, Del, Raw) -> {Add, Del, Raw}; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index fcbff047affe..5bd529e50587 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -221,6 +221,7 @@ value_option(Flag, Default, On, OnVal, Off, OffVal, Opts) -> :: #{ta() => #typeinfo{}}, exp_types=gb_sets:empty() %Exported types :: gb_sets:set(ta()), + features = [], %Enabled features feature_keywords = %Keywords in %configurable features feature_keywords() :: #{atom() => atom()}, @@ -743,9 +744,6 @@ entries in the list of errors. ErrorInfo :: error_info()). module(Forms, FileName, Opts0) -> - %% FIXME Hmm, this is not coherent with the semantics of features - %% We want the options given on the command line to take - %% precedence over options in the module. Opts = Opts0 ++ compiler_options(Forms), St = forms(Forms, start(FileName, Opts)), return_status(St). @@ -780,6 +778,7 @@ start(File, Opts) -> nowarn_format, 0, Opts), enabled_warnings = Enabled, nowarn_bif_clash = nowarn_function(nowarn_bif_clash, Opts), + features = proplists:get_value(features, Opts, []), file = File }.