diff options
Diffstat (limited to 'lib')
65 files changed, 1812 insertions, 1328 deletions
diff --git a/lib/common_test/src/ct_cover.erl b/lib/common_test/src/ct_cover.erl index c7f446dee9..b630a51835 100644 --- a/lib/common_test/src/ct_cover.erl +++ b/lib/common_test/src/ct_cover.erl @@ -174,7 +174,7 @@ get_spec_test(File) -> [] -> [#cover{app=none, level=details}]; _ -> Res end, - case get_cover_opts(Apps, Terms, []) of + case get_cover_opts(Apps, Terms, Dir, []) of E = {error,_} -> E; [CoverSpec] -> @@ -205,124 +205,125 @@ collect_apps([], Apps) -> %% get_cover_opts(Terms) -> AppCoverInfo %% AppCoverInfo: [#cover{app=App,...}] -get_cover_opts([App | Apps], Terms, CoverInfo) -> - case get_app_info(App, Terms) of +get_cover_opts([App | Apps], Terms, Dir, CoverInfo) -> + case get_app_info(App, Terms, Dir) of E = {error,_} -> E; AppInfo -> AppInfo1 = files2mods(AppInfo), - get_cover_opts(Apps, Terms, [AppInfo1|CoverInfo]) + get_cover_opts(Apps, Terms, Dir, [AppInfo1|CoverInfo]) end; -get_cover_opts([], _, CoverInfo) -> +get_cover_opts([], _, _, CoverInfo) -> lists:reverse(CoverInfo). -%% get_app_info(App, Terms) -> App1 +%% get_app_info(App, Terms, Dir) -> App1 -get_app_info(App=#cover{app=none}, [{incl_dirs,Dirs}|Terms]) -> - get_app_info(App, [{incl_dirs,none,Dirs}|Terms]); -get_app_info(App=#cover{app=Name}, [{incl_dirs,Name,Dirs}|Terms]) -> - case get_files(Dirs, ".beam", false, []) of +get_app_info(App=#cover{app=none}, [{incl_dirs,Dirs}|Terms], Dir) -> + get_app_info(App, [{incl_dirs,none,Dirs}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{incl_dirs,Name,Dirs}|Terms], Dir) -> + case get_files(Dirs, Dir, ".beam", false, []) of E = {error,_} -> E; Mods1 -> Mods = App#cover.incl_mods, - get_app_info(App#cover{incl_mods=Mods++Mods1},Terms) + get_app_info(App#cover{incl_mods=Mods++Mods1},Terms,Dir) end; -get_app_info(App=#cover{app=none}, [{incl_dirs_r,Dirs}|Terms]) -> - get_app_info(App, [{incl_dirs_r,none,Dirs}|Terms]); -get_app_info(App=#cover{app=Name}, [{incl_dirs_r,Name,Dirs}|Terms]) -> - case get_files(Dirs, ".beam", true, []) of +get_app_info(App=#cover{app=none}, [{incl_dirs_r,Dirs}|Terms], Dir) -> + get_app_info(App, [{incl_dirs_r,none,Dirs}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{incl_dirs_r,Name,Dirs}|Terms], Dir) -> + case get_files(Dirs, Dir, ".beam", true, []) of E = {error,_} -> E; Mods1 -> Mods = App#cover.incl_mods, - get_app_info(App#cover{incl_mods=Mods++Mods1},Terms) + get_app_info(App#cover{incl_mods=Mods++Mods1},Terms,Dir) end; -get_app_info(App=#cover{app=none}, [{incl_mods,Mods1}|Terms]) -> - get_app_info(App, [{incl_mods,none,Mods1}|Terms]); -get_app_info(App=#cover{app=Name}, [{incl_mods,Name,Mods1}|Terms]) -> +get_app_info(App=#cover{app=none}, [{incl_mods,Mods1}|Terms], Dir) -> + get_app_info(App, [{incl_mods,none,Mods1}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{incl_mods,Name,Mods1}|Terms], Dir) -> Mods = App#cover.incl_mods, - get_app_info(App#cover{incl_mods=Mods++Mods1},Terms); + get_app_info(App#cover{incl_mods=Mods++Mods1},Terms,Dir); -get_app_info(App=#cover{app=none}, [{excl_dirs,Dirs}|Terms]) -> - get_app_info(App, [{excl_dirs,none,Dirs}|Terms]); -get_app_info(App=#cover{app=Name}, [{excl_dirs,Name,Dirs}|Terms]) -> - case get_files(Dirs, ".beam", false, []) of +get_app_info(App=#cover{app=none}, [{excl_dirs,Dirs}|Terms], Dir) -> + get_app_info(App, [{excl_dirs,none,Dirs}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{excl_dirs,Name,Dirs}|Terms], Dir) -> + case get_files(Dirs, Dir, ".beam", false, []) of E = {error,_} -> E; Mods1 -> Mods = App#cover.excl_mods, - get_app_info(App#cover{excl_mods=Mods++Mods1},Terms) + get_app_info(App#cover{excl_mods=Mods++Mods1},Terms,Dir) end; -get_app_info(App=#cover{app=none}, [{excl_dirs_r,Dirs}|Terms]) -> - get_app_info(App, [{excl_dirs_r,none,Dirs}|Terms]); -get_app_info(App=#cover{app=Name}, [{excl_dirs_r,Name,Dirs}|Terms]) -> - case get_files(Dirs, ".beam", true, []) of +get_app_info(App=#cover{app=none}, [{excl_dirs_r,Dirs}|Terms],Dir) -> + get_app_info(App, [{excl_dirs_r,none,Dirs}|Terms],Dir); +get_app_info(App=#cover{app=Name}, [{excl_dirs_r,Name,Dirs}|Terms],Dir) -> + case get_files(Dirs, Dir, ".beam", true, []) of E = {error,_} -> E; Mods1 -> Mods = App#cover.excl_mods, - get_app_info(App#cover{excl_mods=Mods++Mods1},Terms) + get_app_info(App#cover{excl_mods=Mods++Mods1},Terms,Dir) end; -get_app_info(App=#cover{app=none}, [{excl_mods,Mods1}|Terms]) -> - get_app_info(App, [{excl_mods,none,Mods1}|Terms]); -get_app_info(App=#cover{app=Name}, [{excl_mods,Name,Mods1}|Terms]) -> +get_app_info(App=#cover{app=none}, [{excl_mods,Mods1}|Terms], Dir) -> + get_app_info(App, [{excl_mods,none,Mods1}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{excl_mods,Name,Mods1}|Terms], Dir) -> Mods = App#cover.excl_mods, - get_app_info(App#cover{excl_mods=Mods++Mods1},Terms); + get_app_info(App#cover{excl_mods=Mods++Mods1},Terms,Dir); -get_app_info(App=#cover{app=none}, [{cross,Cross}|Terms]) -> - get_app_info(App, [{cross,none,Cross}|Terms]); -get_app_info(App=#cover{app=Name}, [{cross,Name,Cross1}|Terms]) -> +get_app_info(App=#cover{app=none}, [{cross,Cross}|Terms], Dir) -> + get_app_info(App, [{cross,none,Cross}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{cross,Name,Cross1}|Terms], Dir) -> Cross = App#cover.cross, - get_app_info(App#cover{cross=Cross++Cross1},Terms); + get_app_info(App#cover{cross=Cross++Cross1},Terms,Dir); -get_app_info(App=#cover{app=none}, [{src_dirs,Dirs}|Terms]) -> - get_app_info(App, [{src_dirs,none,Dirs}|Terms]); -get_app_info(App=#cover{app=Name}, [{src_dirs,Name,Dirs}|Terms]) -> - case get_files(Dirs, ".erl", false, []) of +get_app_info(App=#cover{app=none}, [{src_dirs,Dirs}|Terms], Dir) -> + get_app_info(App, [{src_dirs,none,Dirs}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{src_dirs,Name,Dirs}|Terms], Dir) -> + case get_files(Dirs, Dir, ".erl", false, []) of E = {error,_} -> E; Src1 -> Src = App#cover.src, - get_app_info(App#cover{src=Src++Src1},Terms) + get_app_info(App#cover{src=Src++Src1},Terms,Dir) end; -get_app_info(App=#cover{app=none}, [{src_dirs_r,Dirs}|Terms]) -> - get_app_info(App, [{src_dirs_r,none,Dirs}|Terms]); -get_app_info(App=#cover{app=Name}, [{src_dirs_r,Name,Dirs}|Terms]) -> - case get_files(Dirs, ".erl", true, []) of +get_app_info(App=#cover{app=none}, [{src_dirs_r,Dirs}|Terms], Dir) -> + get_app_info(App, [{src_dirs_r,none,Dirs}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{src_dirs_r,Name,Dirs}|Terms], Dir) -> + case get_files(Dirs, Dir, ".erl", true, []) of E = {error,_} -> E; Src1 -> Src = App#cover.src, - get_app_info(App#cover{src=Src++Src1},Terms) + get_app_info(App#cover{src=Src++Src1},Terms,Dir) end; -get_app_info(App=#cover{app=none}, [{src_files,Src1}|Terms]) -> - get_app_info(App, [{src_files,none,Src1}|Terms]); -get_app_info(App=#cover{app=Name}, [{src_files,Name,Src1}|Terms]) -> +get_app_info(App=#cover{app=none}, [{src_files,Src1}|Terms], Dir) -> + get_app_info(App, [{src_files,none,Src1}|Terms], Dir); +get_app_info(App=#cover{app=Name}, [{src_files,Name,Src1}|Terms], Dir) -> Src = App#cover.src, - get_app_info(App#cover{src=Src++Src1},Terms); + get_app_info(App#cover{src=Src++Src1},Terms,Dir); -get_app_info(App, [_|Terms]) -> - get_app_info(App, Terms); +get_app_info(App, [_|Terms], Dir) -> + get_app_info(App, Terms, Dir); -get_app_info(App, []) -> +get_app_info(App, [], _) -> App. %% get_files(...) -get_files([Dir|Dirs], Ext, Recurse, Files) -> - case file:list_dir(Dir) of +get_files([Dir|Dirs], RootDir, Ext, Recurse, Files) -> + DirAbs = filename:absname(Dir, RootDir), + case file:list_dir(DirAbs) of {ok,Entries} -> - {SubDirs,Matches} = analyse_files(Entries, Dir, Ext, [], []), + {SubDirs,Matches} = analyse_files(Entries, DirAbs, Ext, [], []), if Recurse == false -> - get_files(Dirs, Ext, Recurse, Files++Matches); + get_files(Dirs, RootDir, Ext, Recurse, Files++Matches); true -> - Files1 = get_files(SubDirs, Ext, Recurse, Files++Matches), - get_files(Dirs, Ext, Recurse, Files1) + Files1 = get_files(SubDirs, RootDir, Ext, Recurse, Files++Matches), + get_files(Dirs, RootDir, Ext, Recurse, Files1) end; {error,Reason} -> - {error,{Reason,Dir}} + {error,{Reason,DirAbs}} end; -get_files([], _Ext, _R, Files) -> +get_files([], _RootDir, _Ext, _R, Files) -> Files. %% analyse_files(...) diff --git a/lib/common_test/src/ct_release_test.erl b/lib/common_test/src/ct_release_test.erl index eb9e9c832f..3f0b5bda67 100644 --- a/lib/common_test/src/ct_release_test.erl +++ b/lib/common_test/src/ct_release_test.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2014. All Rights Reserved. +%% Copyright Ericsson AB 2014-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -51,10 +51,11 @@ %% executed. %% %% <dl> -%% <dt>Module:upgrade_init(State) -> NewState</dt> +%% <dt>Module:upgrade_init(CtData,State) -> NewState</dt> %% <dd>Types: %% -%% <b><c>State = NewState = cb_state()</c></b> +%% <b><code>CtData = {@link ct_data()}</code></b><br/> +%% <b><code>State = NewState = cb_state()</code></b> %% %% Initialyze system before upgrade test starts. %% @@ -63,17 +64,22 @@ %% the boot script, so this callback is intended for additional %% initialization, if necessary. %% +%% <code>CtData</code> is an opaque data structure which shall be used +%% in any call to <code>ct_release_test</code> inside the callback. +%% %% Example: %% %% ``` -%% upgrade_init(State) -> +%% upgrade_init(CtData,State) -> +%% {ok,{FromVsn,ToVsn}} = ct_release_test:get_app_vsns(CtData,myapp), %% open_connection(State).''' %% </dd> %% -%% <dt>Module:upgrade_upgraded(State) -> NewState</dt> +%% <dt>Module:upgrade_upgraded(CtData,State) -> NewState</dt> %% <dd>Types: %% -%% <b><c>State = NewState = cb_state()</c></b> +%% <b><code>CtData = {@link ct_data()}</code></b><br/> +%% <b><code>State = NewState = cb_state()</code></b> %% %% Check that upgrade was successful. %% @@ -82,17 +88,21 @@ %% been made permanent. It allows application specific checks to %% ensure that the upgrade was successful. %% +%% <code>CtData</code> is an opaque data structure which shall be used +%% in any call to <code>ct_release_test</code> inside the callback. +%% %% Example: %% %% ``` -%% upgrade_upgraded(State) -> +%% upgrade_upgraded(CtData,State) -> %% check_connection_still_open(State).''' %% </dd> %% -%% <dt>Module:upgrade_downgraded(State) -> NewState</dt> +%% <dt>Module:upgrade_downgraded(CtData,State) -> NewState</dt> %% <dd>Types: %% -%% <b><c>State = NewState = cb_state()</c></b> +%% <b><code>CtData = {@link ct_data()}</code></b><br/> +%% <b><code>State = NewState = cb_state()</code></b> %% %% Check that downgrade was successful. %% @@ -101,10 +111,13 @@ %% made permanent. It allows application specific checks to ensure %% that the downgrade was successful. %% +%% <code>CtData</code> is an opaque data structure which shall be used +%% in any call to <code>ct_release_test</code> inside the callback. +%% %% Example: %% %% ``` -%% upgrade_init(State) -> +%% upgrade_downgraded(CtData,State) -> %% check_connection_closed(State).''' %% </dd> %% </dl> @@ -112,7 +125,7 @@ %%----------------------------------------------------------------- -module(ct_release_test). --export([init/1, upgrade/4, cleanup/1]). +-export([init/1, upgrade/4, cleanup/1, get_app_vsns/2, get_appup/2]). -include_lib("kernel/include/file.hrl"). @@ -121,12 +134,17 @@ -define(exclude_apps, [hipe, typer, dialyzer]). % never include these apps %%----------------------------------------------------------------- +-record(ct_data, {from,to}). + +%%----------------------------------------------------------------- -type config() :: [{atom(),term()}]. -type cb_state() :: term(). +-opaque ct_data() :: #ct_data{}. +-export_type([ct_data/0]). --callback upgrade_init(cb_state()) -> cb_state(). --callback upgrade_upgraded(cb_state()) -> cb_state(). --callback upgrade_downgraded(cb_state()) -> cb_state(). +-callback upgrade_init(ct_data(),cb_state()) -> cb_state(). +-callback upgrade_upgraded(ct_data(),cb_state()) -> cb_state(). +-callback upgrade_downgraded(ct_data(),cb_state()) -> cb_state(). %%----------------------------------------------------------------- -spec init(Config) -> Result when @@ -207,12 +225,12 @@ init(Config) -> %% <li>Perform the upgrade test and allow customized %% control by using callbacks: %% <ol> -%% <li>Callback: `upgrade_init/1'</li> +%% <li>Callback: `upgrade_init/2'</li> %% <li>Unpack the new release</li> %% <li>Install the new release</li> -%% <li>Callback: `upgrade_upgraded/1'</li> +%% <li>Callback: `upgrade_upgraded/2'</li> %% <li>Install the original release</li> -%% <li>Callback: `upgrade_downgraded/1'</li> +%% <li>Callback: `upgrade_downgraded/2'</li> %% </ol> %% </li> %% </ol> @@ -314,6 +332,71 @@ cleanup(Config) -> Config. %%----------------------------------------------------------------- +-spec get_app_vsns(CtData,App) -> {ok,{From,To}} | {error,Reason} when + CtData :: ct_data(), + App :: atom(), + From :: string(), + To :: string(), + Reason :: {app_not_found,App}. +%% @doc Get versions involved in this upgrade for the given application. +%% +%% This function can be called from inside any of the callback +%% functions. It returns the old (From) and new (To) versions involved +%% in the upgrade/downgrade test for the given application. +%% +%% <code>CtData</code> must be the first argument received in the +%% calling callback function - an opaque data structure set by +%% <code>ct_release_tests</code>. +get_app_vsns(#ct_data{from=FromApps,to=ToApps},App) -> + case {lists:keyfind(App,1,FromApps),lists:keyfind(App,1,ToApps)} of + {{App,FromVsn,_},{App,ToVsn,_}} -> + {ok,{FromVsn,ToVsn}}; + _ -> + {error,{app_not_found,App}} + end. + +%%----------------------------------------------------------------- +-spec get_appup(CtData,App) -> {ok,Appup} | {error,Reason} when + CtData :: ct_data(), + App :: atom(), + Appup :: {From,To,Up,Down}, + From :: string(), + To :: string(), + Up :: [Instr], + Down :: [Instr], + Instr :: term(), + Reason :: {app_not_found,App} | {vsn_not_found,{App,From}}. +%% @doc Get appup instructions for the given application. +%% +%% This function can be called from inside any of the callback +%% functions. It reads the appup file for the given application and +%% returns the instructions for upgrade and downgrade for the versions +%% in the test. +%% +%% <code>CtData</code> must be the first argument received in the +%% calling callback function - an opaque data structure set by +%% <code>ct_release_tests</code>. +%% +%% See reference manual for appup files for types definitions for the +%% instructions. +get_appup(#ct_data{from=FromApps,to=ToApps},App) -> + case lists:keyfind(App,1,ToApps) of + {App,ToVsn,ToDir} -> + Appup = filename:join([ToDir, "ebin", atom_to_list(App)++".appup"]), + {ok, [{ToVsn, Ups, Downs}]} = file:consult(Appup), + {App,FromVsn,_} = lists:keyfind(App,1,FromApps), + case {systools_relup:appup_search_for_version(FromVsn,Ups), + systools_relup:appup_search_for_version(FromVsn,Downs)} of + {{ok,Up},{ok,Down}} -> + {ok,{FromVsn,ToVsn,Up,Down}}; + _ -> + {error,{vsn_not_found,{App,FromVsn}}} + end; + false -> + {error,{app_not_found,App}} + end. + +%%----------------------------------------------------------------- init_upgrade_test() -> %% Check that a real release is running, not e.g. cerl ok = application:ensure_started(sasl), @@ -558,8 +641,14 @@ do_upgrade({Cb,InitState},FromVsn,FromAppsVsns,ToRel,ToAppsVsns,InstallDir) -> Start = filename:join([InstallDir,bin,start]), {ok,Node} = start_node(Start,FromVsn,FromAppsVsns), + %% Add path to this module, to allow calls to get_appup/2 + Dir = filename:dirname(code:which(?MODULE)), + _ = rpc:call(Node,code,add_pathz,[Dir]), + ct:log("Node started: ~p",[Node]), - State1 = do_callback(Node,Cb,upgrade_init,InitState), + CtData = #ct_data{from = [{A,V,code:lib_dir(A)} || {A,V} <- FromAppsVsns], + to=[{A,V,code:lib_dir(A)} || {A,V} <- ToAppsVsns]}, + State1 = do_callback(Node,Cb,upgrade_init,[CtData,InitState]), [{"OTP upgrade test",FromVsn,_,permanent}] = rpc:call(Node,release_handler,which_releases,[]), @@ -592,7 +681,7 @@ do_upgrade({Cb,InitState},FromVsn,FromAppsVsns,ToRel,ToAppsVsns,InstallDir) -> {"OTP upgrade test",FromVsn,_,old}] = rpc:call(Node,release_handler,which_releases,[]), - State2 = do_callback(Node,Cb,upgrade_upgraded,State1), + State2 = do_callback(Node,Cb,upgrade_upgraded,[CtData,State1]), ct:log("Re-installing old release"), case rpc:call(Node,release_handler,install_release,[FromVsn]) of @@ -615,7 +704,7 @@ do_upgrade({Cb,InitState},FromVsn,FromAppsVsns,ToRel,ToAppsVsns,InstallDir) -> {"OTP upgrade test",FromVsn,_,permanent}] = rpc:call(Node,release_handler,which_releases,[]), - _State3 = do_callback(Node,Cb,upgrade_downgraded,State2), + _State3 = do_callback(Node,Cb,upgrade_downgraded,[CtData,State2]), ct:log("Terminating node ~p",[Node]), erlang:monitor_node(Node,true), @@ -625,15 +714,15 @@ do_upgrade({Cb,InitState},FromVsn,FromAppsVsns,ToRel,ToAppsVsns,InstallDir) -> ok. -do_callback(Node,Mod,Func,State) -> +do_callback(Node,Mod,Func,Args) -> Dir = filename:dirname(code:which(Mod)), _ = rpc:call(Node,code,add_path,[Dir]), ct:log("Calling ~p:~p/1",[Mod,Func]), - R = rpc:call(Node,Mod,Func,[State]), - ct:log("~p:~p/1 returned: ~p",[Mod,Func,R]), + R = rpc:call(Node,Mod,Func,Args), + ct:log("~p:~p/~w returned: ~p",[Mod,Func,length(Args),R]), case R of {badrpc,Error} -> - test_server:fail({test_upgrade_callback,Mod,Func,State,Error}); + test_server:fail({test_upgrade_callback,Mod,Func,Args,Error}); NewState -> NewState end. diff --git a/lib/common_test/test/ct_cover_SUITE.erl b/lib/common_test/test/ct_cover_SUITE.erl index 87ba4ae1b9..1dab425509 100644 --- a/lib/common_test/test/ct_cover_SUITE.erl +++ b/lib/common_test/test/ct_cover_SUITE.erl @@ -77,7 +77,11 @@ all() -> ct_cover_add_remove_nodes, otp_9956, cross, - export_import + export_import, + relative_incl_dirs, + absolute_incl_dirs, + relative_excl_dirs, + absolute_excl_dirs ]. %%-------------------------------------------------------------------- @@ -215,6 +219,45 @@ export_import(Config) -> check_calls(Events2,2), ok. +relative_incl_dirs(Config) -> + false = check_cover(Config), + RelDir = rel_path(?config(priv_dir, Config), ?config(data_dir, Config)), + CoverSpec = [{incl_dirs, [RelDir]}], + CoverFile = create_cover_file(rel_incl_dirs, CoverSpec, Config), + Opts = [{cover, CoverFile}], + {ok, Events} = run_test(rel_incl_dirs, default, Opts, Config), + check_calls(Events, 1), + ok. + +absolute_incl_dirs(Config) -> + false = check_cover(Config), + CoverSpec = [{incl_dirs, [?config(data_dir, Config)]}], + CoverFile = create_cover_file(abs_incl_dirs, CoverSpec, Config), + Opts = [{cover, CoverFile}], + {ok, Events} = run_test(abs_incl_dirs, default, Opts, Config), + check_calls(Events, 1), + ok. + +relative_excl_dirs(Config) -> + false = check_cover(Config), + RelDir = rel_path(?config(priv_dir, Config), ?config(data_dir, Config)), + CoverSpec = default_cover_file_content() ++ [{excl_dirs, [RelDir]}], + CoverFile = create_cover_file(rel_excl_dirs, CoverSpec, Config), + Opts = [{cover, CoverFile}], + {ok, Events} = run_test(rel_excl_dirs, default_no_cover, Opts, Config), + check_no_cover_compiled(Events), + ok. + +absolute_excl_dirs(Config) -> + false = check_cover(Config), + AbsDir = ?config(data_dir, Config), + CoverSpec = default_cover_file_content() ++ [{excl_dirs, [AbsDir]}], + CoverFile = create_cover_file(abs_excl_dirs, CoverSpec, Config), + Opts = [{cover, CoverFile}], + {ok, Events} = run_test(abs_excl_dirs, default_no_cover, Opts, Config), + check_no_cover_compiled(Events), + ok. + %%%----------------------------------------------------------------- %%% HELP FUNCTIONS %%%----------------------------------------------------------------- @@ -288,23 +331,36 @@ get_log_dirs(Events) -> {ct_test_support_eh, {event,start_logging,_Node,LogDir}} <- Events]. +%% Check if a module was compiled without cover +check_no_cover_compiled(Events) -> + check_no_cover_compiled(Events, ?mod). +check_no_cover_compiled(Events, Mod) -> + [ {error, {not_cover_compiled, Mod}} = analyse_log(CoverLog, Mod) + || CoverLog <- cover_logs(Events) ]. + %% Check that each coverlog includes N calls to ?mod:foo/0 check_calls(Events,N) -> check_calls(Events,{?mod,foo,0},N). check_calls(Events,MFA,N) -> - CoverLogs = [filename:join(D,"all.coverdata") || D <- get_log_dirs(Events)], - do_check_logs(CoverLogs,MFA,N). + do_check_logs(cover_logs(Events),MFA,N). do_check_logs([CoverLog|CoverLogs],{Mod,_,_} = MFA,N) -> - {ok,_} = cover:start(), - ok = cover:import(CoverLog), - {ok,Calls} = cover:analyse(Mod,calls,function), - ok = cover:stop(), + {ok, Calls} = analyse_log(CoverLog, Mod), {MFA,N} = lists:keyfind(MFA,1,Calls), do_check_logs(CoverLogs,MFA,N); do_check_logs([],_,_) -> ok. +cover_logs(Events) -> + [filename:join(D,"all.coverdata") || D <- get_log_dirs(Events)]. + +analyse_log(CoverLog, Mod) -> + {ok, _} = cover:start(), + ok = cover:import(CoverLog), + Result = cover:analyse(Mod, calls, function), + ok = cover:stop(), + Result. + fullname(Name) -> {ok,Host} = inet:gethostname(), list_to_atom(atom_to_list(Name) ++ "@" ++ Host). @@ -333,3 +389,12 @@ start_slave(Name,Args) -> {boot_timeout,10}, % extending some timers for slow test hosts {init_timeout,10}, {startup_timeout,10}]). + +rel_path(From, To) -> + Segments = do_rel_path(filename:split(From), filename:split(To)), + filename:join(Segments). + +do_rel_path([Seg|RestA], [Seg|RestB]) -> + do_rel_path(RestA, RestB); +do_rel_path(PathA, PathB) -> + lists:duplicate(length(PathA), "..") ++ PathB. diff --git a/lib/common_test/test/ct_cover_SUITE_data/cover_SUITE.erl b/lib/common_test/test/ct_cover_SUITE_data/cover_SUITE.erl index 83d368c53d..789e48bd96 100644 --- a/lib/common_test/test/ct_cover_SUITE_data/cover_SUITE.erl +++ b/lib/common_test/test/ct_cover_SUITE_data/cover_SUITE.erl @@ -71,6 +71,10 @@ default(_Config) -> cover_test_mod:foo(), ok. +default_no_cover(_Config) -> + cover_test_mod:foo(), + ok. + slave(_Config) -> cover_compiled = code:which(cover_test_mod), cover_test_mod:foo(), diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index c6d09d85eb..2032392821 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -81,6 +81,7 @@ MODULES = \ rec_env \ sys_core_dsetel \ sys_core_fold \ + sys_core_fold_lists \ sys_core_inline \ sys_pre_attributes \ sys_pre_expand \ @@ -187,6 +188,7 @@ $(EBIN)/core_parse.beam: core_parse.hrl $(EGEN)/core_parse.erl $(EBIN)/core_pp.beam: core_parse.hrl $(EBIN)/sys_core_dsetel.beam: core_parse.hrl $(EBIN)/sys_core_fold.beam: core_parse.hrl +$(EBIN)/sys_core_fold_lists.beam: core_parse.hrl $(EBIN)/sys_core_inline.beam: core_parse.hrl $(EBIN)/sys_pre_expand.beam: ../../stdlib/include/erl_bits.hrl $(EBIN)/v3_codegen.beam: v3_life.hrl diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 4e699c4fbf..52fe0e90ce 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -295,12 +295,6 @@ opt([{test,_,{f,_}=Lbl,_,_,_}=I|Is], Acc, St) -> opt(Is, [I|Acc], label_used(Lbl, St)); opt([{select,_,_R,Fail,Vls}=I|Is], Acc, St) -> skip_unreachable(Is, [I|Acc], label_used([Fail|Vls], St)); -opt([{label,L}=I|Is], Acc, #st{entry=L}=St) -> - %% NEVER move the entry label. - opt(Is, [I|Acc], St); -opt([{label,L1},{jump,{f,L2}}=I|Is], [Prev|Acc], St0) -> - St = St0#st{mlbl=dict:append(L2, L1, St0#st.mlbl)}, - opt([Prev,I|Is], Acc, label_used({f,L2}, St)); opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) -> case dict:find(Lbl, Mlbl) of {ok,Lbls} -> @@ -310,9 +304,20 @@ opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) -> insert_labels([Lbl|Lbls], Is, Acc, St); error -> opt(Is, [I|Acc], St0) end; -opt([{jump,{f,Lbl}},{label,Lbl}=I|Is], Acc, St) -> - opt([I|Is], Acc, St); -opt([{jump,Lbl}=I|Is], Acc, St) -> +opt([{jump,{f,_}=X}|[{label,_},{jump,X}|_]=Is], Acc, St) -> + opt(Is, Acc, St); +opt([{jump,{f,Lbl}}|[{label,Lbl}|_]=Is], Acc, St) -> + opt(Is, Acc, St); +opt([{jump,{f,L}=Lbl}=I|Is], Acc0, #st{mlbl=Mlbl0}=St0) -> + %% All labels before this jump instruction should now be + %% moved to the location of the jump's target. + {Lbls,Acc} = collect_labels(Acc0, St0), + St = case Lbls of + [] -> St0; + [_|_] -> + Mlbl = dict:append_list(L, Lbls, Mlbl0), + St0#st{mlbl=Mlbl} + end, skip_unreachable(Is, [I|Acc], label_used(Lbl, St)); %% Optimization: quickly handle some common instructions that don't %% have any failure labels and where is_unreachable_after(I) =:= false. @@ -349,6 +354,17 @@ insert_fc_labels([L|Ls], Mlbl, Acc0) -> end; insert_fc_labels([], _, Acc) -> Acc. +collect_labels(Is, #st{entry=Entry}) -> + collect_labels_1(Is, Entry, []). + +collect_labels_1([{label,Entry}|_]=Is, Entry, Acc) -> + %% Never move the entry label. + {Acc,Is}; +collect_labels_1([{label,L}|Is], Entry, Acc) -> + collect_labels_1(Is, Entry, [L|Acc]); +collect_labels_1(Is, _Entry, Acc) -> + {Acc,Is}. + %% label_defined(Is, Label) -> true | false. %% Test whether the label Label is defined at the start of the instruction %% sequence, possibly preceeded by other label definitions. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 26020e1d29..3249024854 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -187,7 +187,7 @@ is_pure_test({test,is_lt,_,[_,_]}) -> true; is_pure_test({test,is_nil,_,[_]}) -> true; is_pure_test({test,is_nonempty_list,_,[_]}) -> true; is_pure_test({test,test_arity,_,[_,_]}) -> true; -is_pure_test({test,has_map_fields,_,[_,{list,_}]}) -> true; +is_pure_test({test,has_map_fields,_,[_|_]}) -> true; is_pure_test({test,Op,_,Ops}) -> erl_internal:new_type_test(Op, length(Ops)). diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index c156cf79fe..e60184c929 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -22,7 +22,6 @@ %% Avoid warning for local function error/1 clashing with autoimported BIF. -compile({no_auto_import,[error/1]}). --export([file/1, files/1]). %% Interface for compiler. -export([module/2, format_error/1]). @@ -40,38 +39,12 @@ -define(DBG_FORMAT(F, D), ok). -endif. -%%% -%%% API functions. -%%% - --spec file(file:filename()) -> 'ok' | {'error', term()}. - -file(Name) when is_list(Name) -> - case case filename:extension(Name) of - ".S" -> s_file(Name); - ".beam" -> beam_file(Name) - end of - [] -> ok; - Es -> {error,Es} - end. - --spec files([file:filename()]) -> 'ok'. - -files([F|Fs]) -> - ?DBG_FORMAT("# Verifying: ~p~n", [F]), - case file(F) of - ok -> ok; - {error,Es} -> - io:format("~tp:~n~ts~n", [F,format_error(Es)]) - end, - files(Fs); -files([]) -> ok. - %% To be called by the compiler. module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) when is_atom(Mod), is_list(Exp), is_list(Attr), is_integer(Lc) -> case validate(Mod, Fs) of - [] -> {ok,Code}; + [] -> + {ok,Code}; Es0 -> Es = [{?MODULE,E} || E <- Es0], {error,[{atom_to_list(Mod),Es}]} @@ -79,12 +52,6 @@ module({Mod,Exp,Attr,Fs,Lc}=Code, _Opts) -spec format_error(term()) -> iolist(). -format_error([]) -> []; -format_error([{{M,F,A},{I,Off,Desc}}|Es]) -> - [io_lib:format(" ~p:~p/~p+~p:~n ~p - ~p~n", - [M,F,A,Off,I,Desc])|format_error(Es)]; -format_error([Error|Es]) -> - [format_error(Error)|format_error(Es)]; format_error({{_M,F,A},{I,Off,limit}}) -> io_lib:format( "function ~p/~p+~p:~n" @@ -103,8 +70,6 @@ format_error({{_M,F,A},{I,Off,Desc}}) -> " Internal consistency check failed - please report this bug.~n" " Instruction: ~p~n" " Error: ~p:~n", [F,A,Off,I,Desc]); -format_error({Module,Error}) -> - [Module:format_error(Error)]; format_error(Error) -> io_lib:format("~p~n", [Error]). @@ -112,36 +77,6 @@ format_error(Error) -> %%% Local functions follow. %%% -s_file(Name) -> - {ok,Is} = file:consult(Name), - {module,Module} = lists:keyfind(module, 1, Is), - Fs = find_functions(Is), - validate(Module, Fs). - -find_functions(Fs) -> - find_functions_1(Fs, none, [], []). - -find_functions_1([{function,Name,Arity,Entry}|Is], Func, FuncAcc, Acc0) -> - Acc = add_func(Func, FuncAcc, Acc0), - find_functions_1(Is, {Name,Arity,Entry}, [], Acc); -find_functions_1([I|Is], Func, FuncAcc, Acc) -> - find_functions_1(Is, Func, [I|FuncAcc], Acc); -find_functions_1([], Func, FuncAcc, Acc) -> - reverse(add_func(Func, FuncAcc, Acc)). - -add_func(none, _, Acc) -> Acc; -add_func({Name,Arity,Entry}, Is, Acc) -> - [{function,Name,Arity,Entry,reverse(Is)}|Acc]. - -beam_file(Name) -> - try beam_disasm:file(Name) of - {error,beam_lib,Reason} -> [{beam_lib,Reason}]; - #beam_file{module=Module, code=Code0} -> - Code = normalize_disassembled_code(Code0), - validate(Module, Code) - catch _:_ -> [disassembly_failed] - end. - %%% %%% The validator follows. %%% @@ -196,23 +131,16 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> try validate_1(Code, Name, Ar, Entry, Ft) of _ -> validate_0(Module, Fs, Ft) catch - Error -> + throw:Error -> + %% Controlled error. [Error|validate_0(Module, Fs, Ft)]; - error:Error -> - [validate_error(Error, Module, Name, Ar)|validate_0(Module, Fs, Ft)] + Class:Error -> + %% Crash. + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Ar]), + erlang:raise(Class, Error, Stack) end. --ifdef(DEBUG). -validate_error(Error, Module, Name, Ar) -> - exit(validate_error_1(Error, Module, Name, Ar)). --else. -validate_error(Error, Module, Name, Ar) -> - validate_error_1(Error, Module, Name, Ar). --endif. -validate_error_1(Error, Module, Name, Ar) -> - {{Module,Name,Ar}, - {internal_error,'_',{Error,erlang:get_stacktrace()}}}. - -type index() :: non_neg_integer(). -type reg_tab() :: gb_trees:tree(index(), 'none' | {'value', _}). @@ -225,7 +153,6 @@ validate_error_1(Error, Module, Name, Ar) -> hf=0, %Available heap size for floats. fls=undefined, %Floating point state. ct=[], %List of hot catch/try labels - bsm=undefined, %Bit syntax matching state. bits=undefined, %Number of bits in bit syntax binary. setelem=false %Previous instruction was setelement/3. }). @@ -308,7 +235,7 @@ labels_1([{label,L}|Is], R) -> labels_1([{line,_}|Is], R) -> labels_1(Is, R); labels_1(Is, R) -> - {lists:reverse(R),Is}. + {reverse(R),Is}. init_state(Arity) -> Xs = init_regs(Arity, term), @@ -403,10 +330,6 @@ valfun_1({init,{y,_}=Reg}, Vst) -> set_type_y(initialized, Reg, Vst); valfun_1({test_heap,Heap,Live}, Vst) -> test_heap(Heap, Live, Vst); -valfun_1({bif,_Op,nofail,Src,Dst}, Vst) -> - %% The 'nofail' atom only occurs in disassembled code. - validate_src(Src, Vst), - set_type_reg(term, Dst, Vst); valfun_1({bif,Op,{f,_},Src,Dst}=I, Vst) -> case is_bif_safe(Op, length(Src)) of false -> @@ -432,9 +355,6 @@ valfun_1({put_tuple,Sz,Dst}, Vst0) when is_integer(Sz) -> valfun_1({put,Src}, Vst) -> assert_term(Src, Vst), eat_heap(1, Vst); -valfun_1({put_string,Sz,_,Dst}, Vst0) when is_integer(Sz) -> - Vst = eat_heap(2*Sz, Vst0), - set_type_reg(cons, Dst, Vst); %% Instructions for optimization of selective receives. valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) -> Vst; @@ -602,8 +522,6 @@ valfun_4({call_ext_last,Live,Func,StkSize}, tail_call(Func, Live, Vst); valfun_4({call_ext_last,_,_,_}, #vst{current=#st{numy=NumY}}) -> error({allocated,NumY}); -valfun_4({make_fun,_,_,Live}, Vst) -> - call('fun', Live, Vst); valfun_4({make_fun2,_,_,_,Live}, Vst) -> call(make_fun, Live, Vst); %% Other BIFs @@ -620,8 +538,6 @@ valfun_4({bif,element,{f,Fail},[Pos,Tuple],Dst}, Vst0) -> TupleType = upgrade_tuple_type({tuple,[get_tuple_size(PosType)]}, TupleType0), Vst = set_type(TupleType, Tuple, Vst1), set_type_reg(term, Dst, Vst); -valfun_4({raise,{f,_}=Fail,Src,Dst}, Vst) -> - valfun_4({bif,raise,Fail,Src,Dst}, Vst); valfun_4({bif,Op,{f,Fail},Src,Dst}, Vst0) -> validate_src(Src, Vst0), Vst = branch_state(Fail, Vst0), @@ -738,32 +654,6 @@ valfun_4({bs_save2,Ctx,SavePoint}, Vst) -> valfun_4({bs_restore2,Ctx,SavePoint}, Vst) -> bsm_restore(Ctx, SavePoint, Vst); -%% Bit syntax instructions. -valfun_4({bs_start_match,{f,_Fail}=F,Src}, Vst) -> - valfun_4({test,bs_start_match,F,[Src]}, Vst); -valfun_4({test,bs_start_match,{f,Fail},[Src]}, Vst) -> - assert_term(Src, Vst), - bs_start_match(branch_state(Fail, Vst)); - -valfun_4({bs_save,SavePoint}, Vst) -> - bs_assert_state(Vst), - bs_save(SavePoint, Vst); -valfun_4({bs_restore,SavePoint}, Vst) -> - bs_assert_state(Vst), - bs_assert_savepoint(SavePoint, Vst), - Vst; -valfun_4({test,bs_skip_bits,{f,Fail},[Src,_,_]}, Vst) -> - bs_assert_state(Vst), - assert_term(Src, Vst), - branch_state(Fail, Vst); -valfun_4({test,bs_test_tail,{f,Fail},_}, Vst) -> - bs_assert_state(Vst), - branch_state(Fail, Vst); -valfun_4({test,_,{f,Fail},[_,_,_,Dst]}, Vst0) -> - bs_assert_state(Vst0), - Vst = branch_state(Fail, Vst0), - set_type_reg({integer,[]}, Dst, Vst); - %% Other test instructions. valfun_4({test,is_float,{f,Lbl},[Float]}, Vst) -> assert_term(Float, Vst), @@ -795,9 +685,6 @@ valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) -> valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> assert_term(A, Vst), set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); -valfun_4({bs_bits_to_bytes,{f,Fail},Src,Dst}, Vst) -> - assert_term(Src, Vst), - set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), if @@ -868,16 +755,6 @@ valfun_4({bs_put_utf32,{f,Fail},_,Src}=I, Vst0) -> assert_term(Src, Vst0), Vst = bs_align_check(I, Vst0), branch_state(Fail, Vst); -%% Old bit syntax construction (before R10B). -valfun_4({bs_init,_,_}, Vst) -> - bs_zero_bits(Vst); -valfun_4({bs_need_buf,_}, Vst) -> Vst; -valfun_4({bs_final,{f,Fail},Dst}, Vst0) -> - Vst = branch_state(Fail, Vst0), - set_type_reg(binary, Dst, Vst); -valfun_4({bs_final2,Src,Dst}, Vst0) -> - assert_term(Src, Vst0), - set_type_reg(binary, Dst, Vst0); %% Map instructions. valfun_4({put_map_assoc,{f,Fail},Src,Dst,Live,{list,List}}, Vst) -> verify_put_map(Fail, Src, Dst, Live, List, Vst); @@ -891,10 +768,14 @@ valfun_4(_, _) -> verify_get_map(Fail, Src, List, Vst0) -> assert_term(Src, Vst0), Vst1 = branch_state(Fail, Vst0), - Lits = mmap(fun(L,_R) -> [L] end, List), - assert_strict_literal_termorder(Lits), + Keys = extract_map_keys(List), + assert_strict_literal_termorder(Keys), verify_get_map_pair(List,Vst0,Vst1). +extract_map_keys([Key,_Val|T]) -> + [Key|extract_map_keys(T)]; +extract_map_keys([]) -> []. + verify_get_map_pair([],_,Vst) -> Vst; verify_get_map_pair([Src,Dst|Vs],Vst0,Vsti) -> assert_term(Src, Vst0), @@ -936,9 +817,6 @@ validate_bs_skip_utf(Fail, Ctx, Live, Vst0) -> %% val_dsetel({move,_,_}, Vst) -> Vst; -val_dsetel({put_string,0,{string,""},_}, Vst) -> - %% An empty string is OK since it doesn't build anything. - Vst; val_dsetel({call_ext,3,{extfunc,erlang,setelement,3}}, #vst{current=St}=Vst) -> Vst#vst{current=St#st{setelem=true}}; val_dsetel({set_tuple_element,_,_,_}, #vst{current=#st{setelem=false}}) -> @@ -972,7 +850,7 @@ call(Name, Live, #vst{current=St}=Vst) -> Type when Type =/= exception -> %% Type is never 'exception' because it has been handled earlier. Xs = gb_trees_from_list([{0,Type}]), - Vst#vst{current=St#st{x=Xs,f=init_fregs(),bsm=undefined}} + Vst#vst{current=St#st{x=Xs,f=init_fregs()}} end. %% Tail call. @@ -1030,7 +908,7 @@ allocate(_, _, _, _, #vst{current=#st{numy=Numy}}) -> error({existing_stack_frame,{size,Numy}}). deallocate(#vst{current=St}=Vst) -> - Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none,bsm=undefined}}. + Vst#vst{current=St#st{y=init_regs(0, initialized),numy=none}}. test_heap(Heap, Live, Vst0) -> verify_live(Live, Vst0), @@ -1038,7 +916,7 @@ test_heap(Heap, Live, Vst0) -> heap_alloc(Heap, Vst). heap_alloc(Heap, #vst{current=St0}=Vst) -> - St1 = kill_heap_allocation(St0#st{bsm=undefined}), + St1 = kill_heap_allocation(St0), St = heap_alloc_1(Heap, St1), Vst#vst{current=St}. @@ -1122,74 +1000,30 @@ assert_freg_set(Fr, _) -> error({bad_source,Fr}). %%% Maps -%% ensure that a list of literals has a strict -%% ascending term order (also meaning unique literals). -%% Single item lists may have registers. -assert_strict_literal_termorder([_]) -> ok; -assert_strict_literal_termorder(Ls) -> - Vs = lists:map(fun (L) -> get_literal(L) end, Ls), +%% A single item list may be either a list or a register. +%% +%% A list with more than item must contain literals in +%% ascending term order. +%% +%% An empty list is not allowed. + +assert_strict_literal_termorder([]) -> + %% There is no reason to use the get_map_elements and + %% has_map_fields instructions with empty lists. + error(empty_field_list); +assert_strict_literal_termorder([_]) -> + ok; +assert_strict_literal_termorder([_,_|_]=Ls) -> + Vs = [get_literal(L) || L <- Ls], case check_strict_value_termorder(Vs) of true -> ok; - false -> error({not_strict_order, Ls}) - end. - -%% usage: -%% mmap(fun(A,B) -> [{A,B}] end, [1,2,3,4]), -%% [{1,2},{3,4}] - -mmap(F,List) -> - {arity,Ar} = erlang:fun_info(F,arity), - mmap(F,Ar,List). -mmap(_F,_,[]) -> []; -mmap(F,Ar,List) -> - {Hd,Tl} = lists:split(Ar,List), - apply(F,Hd) ++ mmap(F,Ar,Tl). - -check_strict_value_termorder([]) -> true; -check_strict_value_termorder([_]) -> true; -check_strict_value_termorder([V1,V2]) -> - erts_internal:cmp_term(V1,V2) < 0; -check_strict_value_termorder([V1,V2|Vs]) -> - case erts_internal:cmp_term(V1,V2) < 0 of - true -> check_strict_value_termorder([V2|Vs]); - false -> false - end. - -%%% -%%% Binary matching. -%%% -%%% Possible values for the bsm field (=bit syntax matching state). -%%% -%%% undefined - Undefined (initial state). No matching instructions allowed. -%%% -%%% (gb set) - The gb set contains the defined save points. -%%% -%%% The bsm field is reset to 'undefined' by instructions that may cause a -%%% a garbage collection (might move the binary) and/or context switch -%%% (may invalidate the save points). - -bs_start_match(#vst{current=#st{bsm=undefined}=St}=Vst) -> - Vst#vst{current=St#st{bsm=gb_sets:empty()}}; -bs_start_match(Vst) -> - %% Must retain save points here - it is possible to restore back - %% to a previous binary. - Vst. - -bs_save(Reg, #vst{current=#st{bsm=Saved}=St}=Vst) - when is_integer(Reg), Reg < ?MAXREG -> - Vst#vst{current=St#st{bsm=gb_sets:add(Reg, Saved)}}; -bs_save(_, _) -> error(limit). - -bs_assert_savepoint(Reg, #vst{current=#st{bsm=Saved}}) -> - case gb_sets:is_member(Reg, Saved) of - false -> error({no_save_point,Reg}); - true -> ok + false -> error(not_strict_order) end. -bs_assert_state(#vst{current=#st{bsm=undefined}}) -> - error(no_bs_match_state); -bs_assert_state(_) -> ok. - +check_strict_value_termorder([V1|[V2|_]=Vs]) -> + erts_internal:cmp_term(V1, V2) < 0 andalso + check_strict_value_termorder(Vs); +check_strict_value_termorder([_]) -> true. %%% %%% New binary matching instructions. @@ -1525,14 +1359,13 @@ merge_states(L, St, Branched) when L =/= 0 -> {value,OtherSt} -> merge_states_1(St, OtherSt) end. -merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0,bsm=Bsm0}=St, - #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1,bsm=Bsm1}) -> +merge_states_1(#st{x=Xs0,y=Ys0,numy=NumY0,h=H0,ct=Ct0}=St, + #st{x=Xs1,y=Ys1,numy=NumY1,h=H1,ct=Ct1}) -> NumY = merge_stk(NumY0, NumY1), Xs = merge_regs(Xs0, Xs1), Ys = merge_y_regs(Ys0, Ys1), Ct = merge_ct(Ct0, Ct1), - Bsm = merge_bsm(Bsm0, Bsm1), - St#st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct,bsm=Bsm}. + St#st{x=Xs,y=Ys,numy=NumY,h=min(H0, H1),ct=Ct}. merge_stk(S, S) -> S; merge_stk(_, _) -> undecided. @@ -1615,10 +1448,6 @@ merge_types(T1, T2) when T1 =/= T2 -> %% Too different. All we know is that the type is a 'term'. term. -merge_bsm(undefined, _) -> undefined; -merge_bsm(_, undefined) -> undefined; -merge_bsm(Bsm0, Bsm1) -> gb_sets:intersection(Bsm0, Bsm1). - tuple_sz([Sz]) -> Sz; tuple_sz(Sz) -> Sz. @@ -1840,52 +1669,3 @@ error(Error) -> exit(Error). -else. error(Error) -> throw(Error). -endif. - - -%%% -%%% Rewrite disassembled code to the same format as we used internally -%%% to not have to worry later. -%%% - -normalize_disassembled_code(Fs) -> - Index = ndc_index(Fs, []), - ndc(Fs, Index, []). - -ndc_index([{function,Name,Arity,Entry,_Code}|Fs], Acc) -> - ndc_index(Fs, [{{Name,Arity},Entry}|Acc]); -ndc_index([], Acc) -> - gb_trees:from_orddict(lists:sort(Acc)). - -ndc([{function,Name,Arity,Entry,Code0}|Fs], D, Acc) -> - Code = ndc_1(Code0, D, []), - ndc(Fs, D, [{function,Name,Arity,Entry,Code}|Acc]); -ndc([], _, Acc) -> reverse(Acc). - -ndc_1([{call=Op,A,{_,F,A}}|Is], D, Acc) -> - ndc_1(Is, D, [{Op,A,{f,gb_trees:get({F,A}, D)}}|Acc]); -ndc_1([{call_only=Op,A,{_,F,A}}|Is], D, Acc) -> - ndc_1(Is, D, [{Op,A,{f,gb_trees:get({F,A}, D)}}|Acc]); -ndc_1([{call_last=Op,A,{_,F,A},Sz}|Is], D, Acc) -> - ndc_1(Is, D, [{Op,A,{f,gb_trees:get({F,A}, D)},Sz}|Acc]); -ndc_1([{arithbif,Op,F,Src,Dst}|Is], D, Acc) -> - ndc_1(Is, D, [{bif,Op,F,Src,Dst}|Acc]); -ndc_1([{arithfbif,Op,F,Src,Dst}|Is], D, Acc) -> - ndc_1(Is, D, [{bif,Op,F,Src,Dst}|Acc]); -ndc_1([{test,bs_start_match2=Op,F,[A1,Live,A3,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3],Dst}|Acc]); -ndc_1([{test,bs_get_binary2=Op,F,[A1,Live,A3,A4,A5,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3,A4,A5],Dst}|Acc]); -ndc_1([{test,bs_get_float2=Op,F,[A1,Live,A3,A4,A5,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3,A4,A5],Dst}|Acc]); -ndc_1([{test,bs_get_integer2=Op,F,[A1,Live,A3,A4,A5,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3,A4,A5],Dst}|Acc]); -ndc_1([{test,bs_get_utf8=Op,F,[A1,Live,A3,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3],Dst}|Acc]); -ndc_1([{test,bs_get_utf16=Op,F,[A1,Live,A3,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3],Dst}|Acc]); -ndc_1([{test,bs_get_utf32=Op,F,[A1,Live,A3,Dst]}|Is], D, Acc) -> - ndc_1(Is, D, [{test,Op,F,Live,[A1,A3],Dst}|Acc]); -ndc_1([I|Is], D, Acc) -> - ndc_1(Is, D, [I|Acc]); -ndc_1([], _, Acc) -> - reverse(Acc). diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 1a2957ee31..3d4b9ee0c6 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -124,6 +124,7 @@ %% keep map exports here for now c_map_pattern/1, + is_c_map/1, map_es/1, map_arg/1, update_c_map/3, @@ -433,6 +434,8 @@ is_literal_term([H | T]) -> is_literal_term(T) when is_tuple(T) -> is_literal_term_list(tuple_to_list(T)); is_literal_term(B) when is_bitstring(B) -> true; +is_literal_term(M) when is_map(M) -> + is_literal_term_list(maps:to_list(M)); is_literal_term(_) -> false. @@ -1579,6 +1582,20 @@ ann_make_list(_, [], Node) -> %% --------------------------------------------------------------------- %% maps +%% @spec is_c_map(Node::cerl()) -> boolean() +%% +%% @doc Returns <code>true</code> if <code>Node</code> is an abstract +%% map constructor, otherwise <code>false</code>. + +-spec is_c_map(cerl()) -> boolean(). + +is_c_map(#c_map{}) -> + true; +is_c_map(#c_literal{val = V}) when is_map(V) -> + true; +is_c_map(_) -> + false. + -spec map_es(c_map()) -> [c_map_pair()]. map_es(#c_map{es = Es}) -> diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index 8f68915f8e..fbaa7a96fe 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -56,6 +56,7 @@ rec_env, sys_core_dsetel, sys_core_fold, + sys_core_fold_lists, sys_core_inline, sys_pre_attributes, sys_pre_expand, diff --git a/lib/compiler/src/core_lib.erl b/lib/compiler/src/core_lib.erl index 730e3a5317..66319dbd36 100644 --- a/lib/compiler/src/core_lib.erl +++ b/lib/compiler/src/core_lib.erl @@ -20,6 +20,12 @@ -module(core_lib). +-deprecated({get_anno,1,next_major_release}). +-deprecated({set_anno,2,next_major_release}). +-deprecated({is_literal,1,next_major_release}). +-deprecated({is_literal_list,1,next_major_release}). +-deprecated({literal_value,1,next_major_release}). + -export([get_anno/1,set_anno/2]). -export([is_literal/1,is_literal_list/1]). -export([literal_value/1]). @@ -33,59 +39,27 @@ %% -spec get_anno(cerl:cerl()) -> term(). -get_anno(C) -> element(2, C). +get_anno(C) -> cerl:get_ann(C). -spec set_anno(cerl:cerl(), term()) -> cerl:cerl(). -set_anno(C, A) -> setelement(2, C, A). +set_anno(C, A) -> cerl:set_ann(C, A). -spec is_literal(cerl:cerl()) -> boolean(). -is_literal(#c_literal{}) -> true; -is_literal(#c_cons{hd=H,tl=T}) -> - is_literal(H) andalso is_literal(T); -is_literal(#c_tuple{es=Es}) -> is_literal_list(Es); -is_literal(#c_binary{segments=Es}) -> is_lit_bin(Es); -is_literal(_) -> false. +is_literal(Cerl) -> + cerl:is_literal(cerl:fold_literal(Cerl)). -spec is_literal_list([cerl:cerl()]) -> boolean(). is_literal_list(Es) -> lists:all(fun is_literal/1, Es). -is_lit_bin(Es) -> - lists:all(fun (#c_bitstr{val=E,size=S}) -> - is_literal(E) andalso is_literal(S) - end, Es). - %% Return the value of LitExpr. -spec literal_value(cerl:c_literal() | cerl:c_binary() | cerl:c_map() | cerl:c_cons() | cerl:c_tuple()) -> term(). -literal_value(#c_literal{val=V}) -> V; -literal_value(#c_binary{segments=Es}) -> - list_to_binary([literal_value_bin(Bit) || Bit <- Es]); -literal_value(#c_cons{hd=H,tl=T}) -> - [literal_value(H)|literal_value(T)]; -literal_value(#c_tuple{es=Es}) -> - list_to_tuple(literal_value_list(Es)); -literal_value(#c_map{arg=Cm,es=Cmps}) -> - M = literal_value(Cm), - lists:foldl(fun(#c_map_pair{ key=Ck, val=Cv },Mi) -> - K = literal_value(Ck), - V = literal_value(Cv), - maps:put(K,V,Mi) - end, M, Cmps). - -literal_value_list(Vals) -> [literal_value(V) || V <- Vals]. - -literal_value_bin(#c_bitstr{val=Val,size=Sz,unit=U,type=T,flags=Fs}) -> - %% We will only handle literals constructed by make_literal/1. - %% Could be made more general in the future if the need arises. - 8 = literal_value(Sz), - 1 = literal_value(U), - integer = literal_value(T), - [unsigned,big] = literal_value(Fs), - literal_value(Val). +literal_value(Cerl) -> + cerl:concrete(cerl:fold_literal(Cerl)). %% Make a suitable values structure, expr or values, depending on Expr. -spec make_values([cerl:cerl()] | cerl:cerl()) -> cerl:cerl(). diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl index c0e2bdaba0..f62b2bb0ba 100644 --- a/lib/compiler/src/core_lint.erl +++ b/lib/compiler/src/core_lint.erl @@ -173,7 +173,7 @@ check_exports(Es, St) -> end. check_attrs(As, St) -> - case all(fun ({#c_literal{},V}) -> core_lib:is_literal(V); + case all(fun ({#c_literal{},#c_literal{}}) -> true; (_) -> false end, As) of true -> St; diff --git a/lib/compiler/src/core_parse.yrl b/lib/compiler/src/core_parse.yrl index 8bdb6bc37d..eeb9f5dba7 100644 --- a/lib/compiler/src/core_parse.yrl +++ b/lib/compiler/src/core_parse.yrl @@ -124,7 +124,7 @@ function_definition -> {'$1','$3'}. anno_fun -> '(' fun_expr '-|' annotation ')' : - core_lib:set_anno('$2', '$4'). + cerl:set_ann('$2', '$4'). anno_fun -> fun_expr : '$1'. %% Constant terms for annotations and attributes. @@ -163,7 +163,7 @@ tail_constant -> ',' constant tail_constant : ['$2'|'$3']. %% ( ( V -| <anno> ) = ( {a} -| <anno> ) -| <anno> ) anno_pattern -> '(' other_pattern '-|' annotation ')' : - core_lib:set_anno('$2', '$4'). + cerl:set_ann('$2', '$4'). anno_pattern -> other_pattern : '$1'. anno_pattern -> anno_variable : '$1'. @@ -224,7 +224,7 @@ anno_variables -> anno_variable : ['$1']. anno_variable -> variable : '$1'. anno_variable -> '(' variable '-|' annotation ')' : - core_lib:set_anno('$2', '$4'). + cerl:set_ann('$2', '$4'). %% Expressions %% Must split expressions into two levels as nested value expressions @@ -232,7 +232,7 @@ anno_variable -> '(' variable '-|' annotation ')' : anno_expression -> expression : '$1'. anno_expression -> '(' expression '-|' annotation ')' : - core_lib:set_anno('$2', '$4'). + cerl:set_ann('$2', '$4'). anno_expressions -> anno_expression ',' anno_expressions : ['$1' | '$3']. anno_expressions -> anno_expression : ['$1']. @@ -328,7 +328,7 @@ function_name -> atom '/' integer : anno_function_name -> function_name : '$1'. anno_function_name -> '(' function_name '-|' annotation ')' : - core_lib:set_anno('$2', '$4'). + cerl:set_ann('$2', '$4'). let_vars -> anno_variable : ['$1']. let_vars -> '<' '>' : []. @@ -356,7 +356,7 @@ anno_clauses -> anno_clause : ['$1']. anno_clause -> clause : '$1'. anno_clause -> '(' clause '-|' annotation ')' : - core_lib:set_anno('$2', '$4'). + cerl:set_ann('$2', '$4'). clause -> clause_pattern 'when' anno_expression '->' anno_expression : #c_clause{pats='$1',guard='$3',body='$5'}. diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl index 662ef6c83f..9cfca88e8c 100644 --- a/lib/compiler/src/core_pp.erl +++ b/lib/compiler/src/core_pp.erl @@ -45,7 +45,7 @@ format(Node) -> format(Node, #ctxt{}). maybe_anno(Node, Fun, Ctxt) -> - As = core_lib:get_anno(Node), + As = cerl:get_ann(Node), case get_line(As) of none -> maybe_anno(Node, Fun, Ctxt, As); @@ -195,7 +195,7 @@ format_1(#c_alias{var=V,pat=P}, Ctxt) -> Txt = [format(V, Ctxt)|" = "], [Txt|format(P, add_indent(Ctxt, width(Txt, Ctxt)))]; format_1(#c_let{vars=Vs0,arg=A,body=B}, Ctxt) -> - Vs = [core_lib:set_anno(V, []) || V <- Vs0], + Vs = [cerl:set_ann(V, []) || V <- Vs0], case is_simple_term(A) of false -> Ctxt1 = add_indent(Ctxt, Ctxt#ctxt.body_indent), @@ -213,7 +213,7 @@ format_1(#c_let{vars=Vs0,arg=A,body=B}, Ctxt) -> ["let ", format_values(Vs, add_indent(Ctxt, 4)), " = ", - format(core_lib:set_anno(A, []), Ctxt1), + format(cerl:set_ann(A, []), Ctxt1), nl_indent(Ctxt), "in " | format(B, add_indent(Ctxt, 4)) diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index de92792a68..7d1819ea15 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -96,6 +96,10 @@ t=[], %Types in_guard=false}). %In guard or not. +-type type_info() :: cerl:cerl() | 'bool'. +-type yes_no_maybe() :: 'yes' | 'no' | 'maybe'. +-type sub() :: #sub{}. + -spec module(cerl:c_module(), [compile:option()]) -> {'ok', cerl:c_module(), [_]}. @@ -462,10 +466,7 @@ is_safe_simple(#c_call{module=#c_literal{val=erlang}, case erl_internal:bool_op(Name, NumArgs) of true -> %% Boolean operators are safe if the arguments are boolean. - all(fun(#c_var{name=V}) -> is_boolean_type(V, Sub); - (#c_literal{val=Lit}) -> is_boolean(Lit); - (_) -> false - end, Args); + all(fun(C) -> is_boolean_type(C, Sub) =:= yes end, Args); false -> %% We need a rather complicated test to ensure that %% we only allow safe calls that are allowed in a guard. @@ -714,385 +715,23 @@ make_effect_seq([], _) -> void(). call(#c_call{args=As}=Call, #c_literal{val=M}=M0, #c_literal{val=N}=N0, Sub) -> case get(no_inline_list_funcs) of true -> - call_0(Call, M0, N0, As, Sub); + call_1(Call, M0, N0, As, Sub); false -> - call_1(Call, M, N, As, Sub) + case sys_core_fold_lists:call(Call, M, N, As) of + none -> + call_1(Call, M, N, As, Sub); + Core -> + expr(Core, Sub) + end + end; call(#c_call{args=As}=Call, M, N, Sub) -> - call_0(Call, M, N, As, Sub). + call_1(Call, M, N, As, Sub). -call_0(Call, M, N, As0, Sub) -> +call_1(Call, M, N, As0, Sub) -> As1 = expr_list(As0, value, Sub), fold_call(Call#c_call{args=As1}, M, N, As1, Sub). -%% We inline some very common higher order list operations. -%% We use the same evaluation order as the library function. - -call_1(#c_call{anno=Anno}, lists, all, [Arg1,Arg2], Sub) -> - Loop = #c_var{name={'lists^all',1}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, - CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, - body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, - CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, - body=#c_literal{val=false}}, - CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=match_fail(Anno, Err1)}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, - clauses = [CC1, CC2, CC3]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=1}]}, - body=#c_literal{val=true}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^all',1}}|Anno], Err2)}, - Fun = #c_fun{vars=[Xs], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, any, [Arg1,Arg2], Sub) -> - Loop = #c_var{name={'lists^any',1}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, - CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, - body=#c_literal{val=true}}, - CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, - body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, - CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=match_fail(Anno, Err1)}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, - clauses = [CC1, CC2, CC3]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=1}]}, - body=#c_literal{val=false}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^any',1}}|Anno], Err2)}, - Fun = #c_fun{vars=[Xs], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2], Sub) -> - Loop = #c_var{name={'lists^foreach',1}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_seq{arg=#c_apply{anno=Anno, op=F, args=[X]}, - body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=1}]}, - body=#c_literal{val=ok}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^foreach',1}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, map, [Arg1,Arg2], Sub) -> - Loop = #c_var{name={'lists^map',1}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - H = #c_var{name='H'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_let{vars=[H], arg=#c_apply{anno=Anno, - op=F, - args=[X]}, - body=#c_cons{hd=H, - anno=[compiler_generated], - tl=#c_apply{anno=Anno, - op=Loop, - args=[Xs]}}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=1}]}, - body=#c_literal{val=[]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^map',1}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2], Sub) -> - Loop = #c_var{name={'lists^flatmap',1}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - H = #c_var{name='H'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_let{vars=[H], - arg=#c_apply{anno=Anno, op=F, args=[X]}, - body=#c_call{anno=[compiler_generated|Anno], - module=#c_literal{val=erlang}, - name=#c_literal{val='++'}, - args=[H, - #c_apply{anno=Anno, - op=Loop, - args=[Xs]}]}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=1}]}, - body=#c_literal{val=[]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^flatmap',1}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2], Sub) -> - Loop = #c_var{name={'lists^filter',1}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - B = #c_var{name='B'}, - Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, - CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, - body=#c_cons{anno=[compiler_generated], hd=X, tl=Xs}}, - CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, - body=Xs}, - CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=match_fail(Anno, Err1)}, - Case = #c_case{arg=B, clauses = [CC1, CC2, CC3]}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_let{vars=[B], - arg=#c_apply{anno=Anno, op=F, args=[X]}, - body=#c_let{vars=[Xs], - arg=#c_apply{anno=Anno, - op=Loop, - args=[Xs]}, - body=Case}}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=1}]}, - body=#c_literal{val=[]}}, - Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^filter',1}}|Anno], Err2)}, - Fun = #c_fun{vars=[Xs], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3], Sub) -> - Loop = #c_var{name={'lists^foldl',2}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - A = #c_var{name='A'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_apply{anno=Anno, - op=Loop, - args=[Xs, #c_apply{anno=Anno, - op=F, - args=[X, A]}]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=2}]}, - body=A}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^foldl',2}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs, A], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3], Sub) -> - Loop = #c_var{name={'lists^foldr',2}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - A = #c_var{name='A'}, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=#c_apply{anno=Anno, - op=F, - args=[X, #c_apply{anno=Anno, - op=Loop, - args=[Xs, A]}]}}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=2}]}, - body=A}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^foldr',2}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs, A], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, - body=#c_letrec{defs=[{Loop,Fun}], - body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) -> - Loop = #c_var{name={'lists^mapfoldl',2}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - Avar = #c_var{name='A'}, - Match = - fun (A, P, E) -> - C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, - Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, - C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=match_fail(Anno, Err)}, - #c_case{arg=A, clauses=[C1, C2]} - end, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, - body=Match(#c_apply{anno=Anno, op=F, args=[X, Avar]}, - #c_tuple{es=[X, Avar]}, -%%% Tuple passing version - Match(#c_apply{anno=Anno, - op=Loop, - args=[Xs, Avar]}, - #c_tuple{es=[Xs, Avar]}, - #c_tuple{anno=[compiler_generated], - es=[#c_cons{anno=[compiler_generated], - hd=X, tl=Xs}, - Avar]}) -%%% Multiple-value version -%%% #c_let{vars=[Xs,A], -%%% %% The tuple here will be optimised -%%% %% away later; no worries. -%%% arg=#c_apply{op=Loop, args=[Xs, A]}, -%%% body=#c_values{es=[#c_cons{hd=X, tl=Xs}, -%%% A]}} - )}, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=2}]}, -%%% Tuple passing version - body=#c_tuple{anno=[compiler_generated], - es=[#c_literal{val=[]}, Avar]}}, -%%% Multiple-value version -%%% body=#c_values{es=[#c_literal{val=[]}, A]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^mapfoldl',2}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs, Avar], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, - body=#c_letrec{defs=[{Loop,Fun}], -%%% Tuple passing version - body=#c_apply{anno=Anno, - op=Loop, - args=[L, Avar]}}}, -%%% Multiple-value version -%%% body=#c_let{vars=[Xs, A], -%%% arg=#c_apply{op=Loop, -%%% args=[L, A]}, -%%% body=#c_tuple{es=[Xs, A]}}}}, - Sub); -call_1(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) -> - Loop = #c_var{name={'lists^mapfoldr',2}}, - F = #c_var{name='F'}, - Xs = #c_var{name='Xs'}, - X = #c_var{name='X'}, - Avar = #c_var{name='A'}, - Match = - fun (A, P, E) -> - C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, - Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, - C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, - body=match_fail(Anno, Err)}, - #c_case{arg=A, clauses=[C1, C2]} - end, - C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, -%%% Tuple passing version - body=Match(#c_apply{anno=Anno, - op=Loop, - args=[Xs, Avar]}, - #c_tuple{es=[Xs, Avar]}, - Match(#c_apply{anno=Anno, op=F, args=[X, Avar]}, - #c_tuple{es=[X, Avar]}, - #c_tuple{anno=[compiler_generated], - es=[#c_cons{anno=[compiler_generated], - hd=X, tl=Xs}, Avar]})) -%%% Multiple-value version -%%% body=#c_let{vars=[Xs,A], -%%% %% The tuple will be optimised away -%%% arg=#c_apply{op=Loop, args=[Xs, A]}, -%%% body=Match(#c_apply{op=F, args=[X, A]}, -%%% #c_tuple{es=[X, A]}, -%%% #c_values{es=[#c_cons{hd=X, tl=Xs}, -%%% A]})} - }, - C2 = #c_clause{pats=[#c_literal{val=[]}], - guard=#c_call{module=#c_literal{val=erlang}, - name=#c_literal{val=is_function}, - args=[F, #c_literal{val=2}]}, -%%% Tuple passing version - body=#c_tuple{anno=[compiler_generated], - es=[#c_literal{val=[]}, Avar]}}, -%%% Multiple-value version -%%% body=#c_values{es=[#c_literal{val=[]}, A]}}, - Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, - C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, - body=match_fail([{function_name,{'lists^mapfoldr',2}}|Anno], Err)}, - Fun = #c_fun{vars=[Xs, Avar], - body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, - L = #c_var{name='L'}, - expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, - body=#c_letrec{defs=[{Loop,Fun}], -%%% Tuple passing version - body=#c_apply{anno=Anno, - op=Loop, - args=[L, Avar]}}}, -%%% Multiple-value version -%%% body=#c_let{vars=[Xs, A], -%%% arg=#c_apply{op=Loop, -%%% args=[L, A]}, -%%% body=#c_tuple{es=[Xs, A]}}}}, - Sub); -call_1(#c_call{module=M, name=N}=Call, _, _, As, Sub) -> - call_0(Call, M, N, As, Sub). - -match_fail(Anno, Arg) -> - #c_primop{anno=Anno, - name=#c_literal{val='match_fail'}, - args=[Arg]}. - %% fold_call(Call, Mod, Name, Args, Sub) -> Expr. %% Try to safely evaluate the call. Just try to evaluate arguments, %% do the call and convert return values to literals. If this @@ -1117,29 +756,33 @@ fold_call_1(Call, Mod, Name, Args, Sub) -> true -> fold_call_2(Call, Mod, Name, Args, Sub) end. -fold_call_2(Call, Module, Name, Args0, Sub) -> - try - Args = [core_lib:literal_value(A) || A <- Args0], - try apply(Module, Name, Args) of - Val -> - case cerl:is_literal_term(Val) of - true -> - #c_literal{val=Val}; - false -> - %% Successful evaluation, but it was not - %% possible to express the computed value as a literal. - Call - end - catch - error:Reason -> - %% Evaluation of the function failed. Warn and replace - %% the call with a call to erlang:error/1. - eval_failure(Call, Reason) - end +fold_call_2(Call, Module, Name, Args, Sub) -> + case all(fun cerl:is_literal/1, Args) of + true -> + %% All arguments are literals. + fold_lit_args(Call, Module, Name, Args); + false -> + %% At least one non-literal argument. + fold_non_lit_args(Call, Module, Name, Args, Sub) + end. + +fold_lit_args(Call, Module, Name, Args0) -> + Args = [cerl:concrete(A) || A <- Args0], + try apply(Module, Name, Args) of + Val -> + case cerl:is_literal_term(Val) of + true -> + cerl:abstract(Val); + false -> + %% Successful evaluation, but it was not possible + %% to express the computed value as a literal. + Call + end catch - error:_ -> - %% There was at least one non-literal argument. - fold_non_lit_args(Call, Module, Name, Args0, Sub) + error:Reason -> + %% Evaluation of the function failed. Warn and replace + %% the call with a call to erlang:error/1. + eval_failure(Call, Reason) end. %% fold_non_lit_args(Call, Module, Name, Args, Sub) -> Expr. @@ -1178,17 +821,18 @@ fold_non_lit_args(Call, _, _, _, _) -> Call. %% Evaluate a relational operation using type information. eval_rel_op(Call, Op, [#c_var{name=V},#c_var{name=V}], _) -> Bool = erlang:Op(same, same), - #c_literal{anno=core_lib:get_anno(Call),val=Bool}; -eval_rel_op(Call, '=:=', [#c_var{name=V}=Var,#c_literal{val=true}], Sub) -> + #c_literal{anno=cerl:get_ann(Call),val=Bool}; +eval_rel_op(Call, '=:=', [Term,#c_literal{val=true}], Sub) -> %% BoolVar =:= true ==> BoolVar - case is_boolean_type(V, Sub) of - true -> Var; - false -> Call + case is_boolean_type(Term, Sub) of + yes -> Term; + maybe -> Call; + no -> #c_literal{val=false} end; eval_rel_op(Call, '==', Ops, _Sub) -> case is_exact_eq_ok(Ops) of true -> - Name = #c_literal{anno=core_lib:get_anno(Call),val='=:='}, + Name = #c_literal{anno=cerl:get_ann(Call),val='=:='}, Call#c_call{name=Name}; false -> Call @@ -1196,7 +840,7 @@ eval_rel_op(Call, '==', Ops, _Sub) -> eval_rel_op(Call, '/=', Ops, _Sub) -> case is_exact_eq_ok(Ops) of true -> - Name = #c_literal{anno=core_lib:get_anno(Call),val='=/='}, + Name = #c_literal{anno=cerl:get_ann(Call),val='=/='}, Call#c_call{name=Name}; false -> Call @@ -1231,40 +875,31 @@ is_non_numeric_tuple(_Tuple, 0) -> true. %% there must be at least one non-literal argument (i.e. %% there is no need to handle the case that all argments %% are literal). -eval_bool_op(Call, 'and', [#c_literal{val=true},#c_var{name=V}=Res], Sub) -> - case is_boolean_type(V, Sub) of - true -> Res; - false-> Call - end; -eval_bool_op(Call, 'and', [#c_var{name=V}=Res,#c_literal{val=true}], Sub) -> - case is_boolean_type(V, Sub) of - true -> Res; - false-> Call - end; -eval_bool_op(Call, 'and', [#c_literal{val=false}=Res,#c_var{name=V}], Sub) -> - case is_boolean_type(V, Sub) of - true -> Res; - false-> Call - end; -eval_bool_op(Call, 'and', [#c_var{name=V},#c_literal{val=false}=Res], Sub) -> - case is_boolean_type(V, Sub) of - true -> Res; - false-> Call - end; + +eval_bool_op(Call, 'and', [#c_literal{val=true},Term], Sub) -> + eval_bool_op_1(Call, Term, Term, Sub); +eval_bool_op(Call, 'and', [Term,#c_literal{val=true}], Sub) -> + eval_bool_op_1(Call, Term, Term, Sub); +eval_bool_op(Call, 'and', [#c_literal{val=false}=Res,Term], Sub) -> + eval_bool_op_1(Call, Res, Term, Sub); +eval_bool_op(Call, 'and', [Term,#c_literal{val=false}=Res], Sub) -> + eval_bool_op_1(Call, Res, Term, Sub); eval_bool_op(Call, _, _, _) -> Call. +eval_bool_op_1(Call, Res, Term, Sub) -> + case is_boolean_type(Term, Sub) of + yes -> Res; + no -> eval_failure(Call, badarg); + maybe -> Call + end. + %% Evaluate is_boolean/1 using type information. -eval_is_boolean(Call, #c_var{name=V}, Sub) -> - case is_boolean_type(V, Sub) of - true -> #c_literal{val=true}; - false -> Call - end; -eval_is_boolean(_, #c_cons{}, _) -> - #c_literal{val=false}; -eval_is_boolean(_, #c_tuple{}, _) -> - #c_literal{val=false}; -eval_is_boolean(Call, _, _) -> - Call. +eval_is_boolean(Call, Term, Sub) -> + case is_boolean_type(Term, Sub) of + no -> #c_literal{val=false}; + yes -> #c_literal{val=true}; + maybe -> Call + end. %% eval_length(Call, List) -> Val. %% Evaluates the length for the prefix of List which has a known @@ -1314,20 +949,19 @@ eval_append(Call, X, Y) -> %% Evaluates element/2 if the position Pos is a literal and %% the shape of the tuple Tuple is known. %% -eval_element(Call, #c_literal{val=Pos}, #c_tuple{es=Es}, _Types) when is_integer(Pos) -> - if - 1 =< Pos, Pos =< length(Es) -> - lists:nth(Pos, Es); - true -> - eval_failure(Call, badarg) - end; -eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types) +eval_element(Call, #c_literal{val=Pos}, Tuple, Types) when is_integer(Pos) -> - case orddict:find(V, Types#sub.t) of - {ok,#c_tuple{es=Elements}} -> + case get_type(Tuple, Types) of + none -> + Call; + Type -> + Es = case cerl:is_c_tuple(Type) of + false -> []; + true -> cerl:tuple_es(Type) + end, if - 1 =< Pos, Pos =< length(Elements) -> - El = lists:nth(Pos, Elements), + 1 =< Pos, Pos =< length(Es) -> + El = lists:nth(Pos, Es), try pat_to_expr(El) catch @@ -1335,15 +969,13 @@ eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types) Call end; true -> + %% Index outside tuple or not a tuple. eval_failure(Call, badarg) - end; - {ok,_} -> - eval_failure(Call, badarg); - error -> - Call + end end; -eval_element(Call, Pos, Tuple, _Types) -> - case is_not_integer(Pos) orelse is_not_tuple(Tuple) of +eval_element(Call, Pos, Tuple, Sub) -> + case is_int_type(Pos, Sub) =:= no orelse + is_tuple_type(Tuple, Sub) =:= no of true -> eval_failure(Call, badarg); false -> @@ -1353,32 +985,27 @@ eval_element(Call, Pos, Tuple, _Types) -> %% eval_is_record(Call, Var, Tag, Size, Types) -> Val. %% Evaluates is_record/3 using type information. %% -eval_is_record(Call, #c_var{name=V}, #c_literal{val=NeededTag}=Lit, +eval_is_record(Call, Term, #c_literal{val=NeededTag}, #c_literal{val=Size}, Types) -> - case orddict:find(V, Types#sub.t) of - {ok,#c_tuple{es=[#c_literal{val=Tag}|_]=Es}} -> - Lit#c_literal{val=Tag =:= NeededTag andalso - length(Es) =:= Size}; - _ -> - Call + case get_type(Term, Types) of + none -> + Call; + Type -> + Es = case cerl:is_c_tuple(Type) of + false -> []; + true -> cerl:tuple_es(Type) + end, + case Es of + [#c_literal{val=Tag}|_] -> + Bool = Tag =:= NeededTag andalso + length(Es) =:= Size, + #c_literal{val=Bool}; + _ -> + #c_literal{val=false} + end end; eval_is_record(Call, _, _, _, _) -> Call. -%% is_not_integer(Core) -> true | false. -%% Returns true if Core is definitely not an integer. - -is_not_integer(#c_literal{val=Val}) when not is_integer(Val) -> true; -is_not_integer(#c_tuple{}) -> true; -is_not_integer(#c_cons{}) -> true; -is_not_integer(_) -> false. - -%% is_not_tuple(Core) -> true | false. -%% Returns true if Core is definitely not a tuple. - -is_not_tuple(#c_literal{val=Val}) when not is_tuple(Val) -> true; -is_not_tuple(#c_cons{}) -> true; -is_not_tuple(_) -> false. - %% eval_setelement(Call, Pos, Tuple, NewVal) -> Core. %% Evaluates setelement/3 if position Pos is an integer %% the shape of the tuple Tuple is known. @@ -1482,7 +1109,7 @@ clause(#c_clause{pats=Ps0,guard=G0,body=B0}=Cl, Cexpr, Ctxt, Sub0) -> let_substs(Vs0, As0, Sub0) -> {Vs1,Sub1} = pattern_list(Vs0, Sub0), {Vs2,As1,Ss} = let_substs_1(Vs1, As0, Sub1), - Sub2 = scope_add([V || #c_var{name=V} <- Vs2], Sub1), + Sub2 = sub_add_scope([V || #c_var{name=V} <- Vs2], Sub1), {Vs2,As1, foldl(fun ({V,S}, Sub) -> sub_set_name(V, S, Sub) end, Sub2, Ss)}. @@ -1517,7 +1144,7 @@ pattern(#c_var{}=Pat, Isub, Osub) -> true -> V1 = make_var_name(), Pat1 = #c_var{name=V1}, - {Pat1,sub_set_var(Pat, Pat1, scope_add([V1], Osub))}; + {Pat1,sub_set_var(Pat, Pat1, sub_add_scope([V1], Osub))}; false -> {Pat,sub_del_var(Pat, Osub)} end; @@ -1587,6 +1214,7 @@ is_subst(_) -> false. %% sub_del_var(Var, #sub{}) -> #sub{}. %% sub_subst_var(Var, Value, #sub{}) -> [{Name,Value}]. %% sub_is_val(Var, #sub{}) -> boolean(). +%% sub_add_scope(#sub{}) -> #sub{} %% sub_subst_scope(#sub{}) -> #sub{} %% %% We use the variable name as key so as not have problems with @@ -1597,9 +1225,10 @@ is_subst(_) -> false. %% In addition to the list of substitutions, we also keep track of %% all variable currently live (the scope). %% -%% sub_subst_scope/1 adds dummy substitutions for all variables -%% in the scope in order to force renaming if variables in the -%% scope occurs as pattern variables. +%% sub_add_scope/2 adds variables to the scope. sub_subst_scope/1 +%% adds dummy substitutions for all variables in the scope in order +%% to force renaming if variables in the scope occurs as pattern +%% variables. sub_new() -> #sub{v=orddict:new(),s=gb_trees:empty(),t=[]}. @@ -1639,6 +1268,12 @@ sub_subst_var(#c_var{name=V}, Val, #sub{v=S0}) -> %% Fold chained substitutions. [{V,Val}] ++ [ {K,Val} || {K,#c_var{name=V1}} <- S0, V1 =:= V]. +sub_add_scope(Vs, #sub{s=Scope0}=Sub) -> + Scope = foldl(fun(V, S) when is_integer(V); is_atom(V) -> + gb_sets:add(V, S) + end, Scope0, Vs), + Sub#sub{s=Scope}. + sub_subst_scope(#sub{v=S0,s=Scope}=Sub) -> S = [{-1,#c_var{name=Sv}} || Sv <- gb_sets:to_list(Scope)]++S0, Sub#sub{v=S}. @@ -1686,7 +1321,7 @@ clauses(E, [C0|Cs], Ctxt, Sub, LitExpr) -> {yes,yes} -> case LitExpr of false -> - Line = get_line(core_lib:get_anno(C1)), + Line = get_line(cerl:get_ann(C1)), shadow_warning(Cs, Line); true -> %% If the case expression is a literal, @@ -1920,7 +1555,7 @@ opt_bool_case_guard(#c_case{arg=Arg,clauses=Cs0}=Case) -> Case; true -> Cs = opt_bool_case_guard(Arg, Cs0), - Case#c_case{arg=#c_values{anno=core_lib:get_anno(Arg),es=[]}, + Case#c_case{arg=#c_values{anno=cerl:get_ann(Arg),es=[]}, clauses=Cs} end. @@ -2394,11 +2029,8 @@ is_bool_expr(#c_let{vars=[V],arg=Arg,body=B}, Sub0) -> is_bool_expr(#c_let{body=B}, Sub) -> %% Binding of multiple variables. is_bool_expr(B, Sub); -is_bool_expr(#c_literal{val=Bool}, _) when is_boolean(Bool) -> - true; -is_bool_expr(#c_var{name=V}, Sub) -> - is_boolean_type(V, Sub); -is_bool_expr(_, _) -> false. +is_bool_expr(C, Sub) -> + is_boolean_type(C, Sub) =:= yes. is_bool_expr_list([C|Cs], Sub) -> is_bool_expr(C, Sub) andalso is_bool_expr_list(Cs, Sub); @@ -2612,12 +2244,6 @@ move_let_into_expr(_Let, _Expr, _Sub) -> impossible. is_failing_clause(#c_clause{body=B}) -> will_fail(B). -scope_add(Vs, #sub{s=Scope0}=Sub) -> - Scope = foldl(fun(V, S) when is_integer(V); is_atom(V) -> - gb_sets:add(V, S) - end, Scope0, Vs), - Sub#sub{s=Scope}. - %% opt_simple_let(#c_let{}, Context, Sub) -> CoreTerm %% Optimize a let construct that does not contain any lets in %% in its argument. @@ -2646,31 +2272,7 @@ opt_simple_let_1(#c_let{vars=Vs0,body=B0}=Let, Arg0, Ctxt, Sub0) -> Arg = core_lib:make_values(Args), opt_simple_let_2(Let, Vs, Arg, B, Ctxt, Sub1). -opt_simple_let_2(Let0, Vs0, Arg0, Body0, effect, Sub) -> - case {Vs0,Arg0,Body0} of - {[],#c_values{es=[]},Body} -> - %% No variables left (because of substitutions). - Body; - {[_|_],Arg,#c_literal{}} -> - %% The body is a literal. That means that we can ignore - %% it and that the return value is Arg revisited in - %% effect context. - body(Arg, effect, sub_new_preserve_types(Sub)); - {Vs,Arg,Body} -> - %% Since we are in effect context, there is a chance - %% that the body no longer references the variables. - %% In that case we can construct a sequence and visit - %% that in effect context: - %% let <Var> = Arg in BodyWithoutVar ==> seq Arg BodyWithoutVar - case is_any_var_used(Vs, Body) of - false -> - expr(#c_seq{arg=Arg,body=Body}, effect, sub_new_preserve_types(Sub)); - true -> - Let = Let0#c_let{vars=Vs,arg=Arg,body=Body}, - opt_case_in_let_arg(opt_case_in_let(Let, Sub), effect, Sub) - end - end; -opt_simple_let_2(Let0, Vs0, Arg0, Body, value, Sub) -> +opt_simple_let_2(Let0, Vs0, Arg0, Body, Ctxt, Sub) -> case {Vs0,Arg0,Body} of {[#c_var{name=N1}],Arg,#c_var{name=N2}} -> case N1 =:= N2 of @@ -2679,26 +2281,30 @@ opt_simple_let_2(Let0, Vs0, Arg0, Body, value, Sub) -> Arg; false -> %% let <Var> = Arg in <OtherVar> ==> seq Arg OtherVar - expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub)) + expr(#c_seq{arg=Arg,body=Body}, Ctxt, + sub_new_preserve_types(Sub)) end; {[],#c_values{es=[]},_} -> %% No variables left. Body; {_,Arg,#c_literal{}} -> - %% The variable is not used in the body. The argument - %% can be evaluated in effect context to simplify it. - expr(#c_seq{arg=Arg,body=Body}, value, sub_new_preserve_types(Sub)); - {Vs,Arg,Body} -> - %% If none of the variables are used in the body, we can rewrite the + %% Since the variable is not used in the body, we can rewrite the %% let to a sequence: - %% let <Var> = Arg in BodyWithoutVar ==> seq Arg BodyWithoutVar + %% let <Var> = Arg in Literal ==> seq Arg Literal + expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)); + {Vs,Arg,Body} -> + %% If none of the variables are used in the body, we can + %% rewrite the let to a sequence: + %% let <Var> = Arg in BodyWithoutVar ==> + %% seq Arg BodyWithoutVar case is_any_var_used(Vs, Body) of false -> - expr(#c_seq{arg=Arg,body=Body}, value, + expr(#c_seq{arg=Arg,body=Body}, Ctxt, sub_new_preserve_types(Sub)); true -> - Let = Let0#c_let{vars=Vs,arg=Arg,body=Body}, - opt_case_in_let_arg(opt_case_in_let(Let, Sub), value, Sub) + Let1 = Let0#c_let{vars=Vs,arg=Arg,body=Body}, + Let2 = opt_case_in_let(Let1, Sub), + opt_case_in_let_arg(Let2, Ctxt, Sub) end end. @@ -2822,12 +2428,61 @@ is_any_var_used([#c_var{name=V}|Vs], Expr) -> end; is_any_var_used([], _) -> false. -is_boolean_type(V, #sub{t=Tdb}) -> +%%% +%%% Retrieving information about types. +%%% + +-spec get_type(cerl:cerl(), #sub{}) -> type_info() | 'none'. + +get_type(#c_var{name=V}, #sub{t=Tdb}) -> case orddict:find(V, Tdb) of - {ok,bool} -> true; - _ -> false + {ok,Type} -> Type; + error -> none + end; +get_type(C, _) -> + case cerl:type(C) of + binary -> C; + map -> C; + _ -> + case cerl:is_data(C) of + true -> C; + false -> none + end + end. + +-spec is_boolean_type(cerl:cerl(), sub()) -> yes_no_maybe(). + +is_boolean_type(Var, Sub) -> + case get_type(Var, Sub) of + none -> + maybe; + bool -> + yes; + C -> + B = cerl:is_c_atom(C) andalso + is_boolean(cerl:atom_val(C)), + yes_no(B) + end. + +-spec is_int_type(cerl:cerl(), sub()) -> yes_no_maybe(). + +is_int_type(Var, Sub) -> + case get_type(Var, Sub) of + none -> maybe; + C -> yes_no(cerl:is_c_int(C)) end. +-spec is_tuple_type(cerl:cerl(), sub()) -> yes_no_maybe(). + +is_tuple_type(Var, Sub) -> + case get_type(Var, Sub) of + none -> maybe; + C -> yes_no(cerl:is_c_tuple(C)) + end. + +yes_no(true) -> yes; +yes_no(false) -> no. + %% update_types(Expr, Pattern, Sub) -> Sub' %% Update the type database. update_types(Expr, Pat, #sub{t=Tdb0}=Sub) -> @@ -3153,7 +2808,7 @@ add_warning(Core, Term) -> true -> ok; false -> - Anno = core_lib:get_anno(Core), + Anno = cerl:get_ann(Core), Line = get_line(Anno), File = get_file(Anno), Key = {?MODULE,warnings}, diff --git a/lib/compiler/src/sys_core_fold_lists.erl b/lib/compiler/src/sys_core_fold_lists.erl new file mode 100644 index 0000000000..49dc59052a --- /dev/null +++ b/lib/compiler/src/sys_core_fold_lists.erl @@ -0,0 +1,386 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% Purpose : Inline high order lists functions from the lists module. + +-module(sys_core_fold_lists). + +-export([call/4]). + +-include("core_parse.hrl"). + +%% We inline some very common higher order list operations. +%% We use the same evaluation order as the library function. + +-spec call(cerl:c_call(), atom(), atom(), [cerl:cerl()]) -> + 'none' | cerl:cerl(). + +call(#c_call{anno=Anno}, lists, all, [Arg1,Arg2]) -> + Loop = #c_var{name={'lists^all',1}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, + CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, + body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, + CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, + body=#c_literal{val=false}}, + CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, + body=match_fail(Anno, Err1)}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, + clauses = [CC1, CC2, CC3]}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, + body=#c_literal{val=true}}, + Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^all',1}}|Anno], Err2)}, + Fun = #c_fun{vars=[Xs], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}; +call(#c_call{anno=Anno}, lists, any, [Arg1,Arg2]) -> + Loop = #c_var{name={'lists^any',1}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, + CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, + body=#c_literal{val=true}}, + CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, + body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}, + CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, + body=match_fail(Anno, Err1)}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]}, + clauses = [CC1, CC2, CC3]}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, + body=#c_literal{val=false}}, + Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^any',1}}|Anno], Err2)}, + Fun = #c_fun{vars=[Xs], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}; +call(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2]) -> + Loop = #c_var{name={'lists^foreach',1}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_seq{arg=#c_apply{anno=Anno, op=F, args=[X]}, + body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, + body=#c_literal{val=ok}}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^foreach',1}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}; +call(#c_call{anno=Anno}, lists, map, [Arg1,Arg2]) -> + Loop = #c_var{name={'lists^map',1}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + H = #c_var{name='H'}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_let{vars=[H], arg=#c_apply{anno=Anno, + op=F, + args=[X]}, + body=#c_cons{hd=H, + anno=[compiler_generated], + tl=#c_apply{anno=Anno, + op=Loop, + args=[Xs]}}}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, + body=#c_literal{val=[]}}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^map',1}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}; +call(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2]) -> + Loop = #c_var{name={'lists^flatmap',1}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + H = #c_var{name='H'}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_let{vars=[H], + arg=#c_apply{anno=Anno, op=F, args=[X]}, + body=#c_call{anno=[compiler_generated|Anno], + module=#c_literal{val=erlang}, + name=#c_literal{val='++'}, + args=[H, + #c_apply{anno=Anno, + op=Loop, + args=[Xs]}]}}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, + body=#c_literal{val=[]}}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^flatmap',1}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}; +call(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2]) -> + Loop = #c_var{name={'lists^filter',1}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + B = #c_var{name='B'}, + Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]}, + CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true}, + body=#c_cons{anno=[compiler_generated], hd=X, tl=Xs}}, + CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true}, + body=Xs}, + CC3 = #c_clause{pats=[X], guard=#c_literal{val=true}, + body=match_fail(Anno, Err1)}, + Case = #c_case{arg=B, clauses = [CC1, CC2, CC3]}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_let{vars=[B], + arg=#c_apply{anno=Anno, op=F, args=[X]}, + body=#c_let{vars=[Xs], + arg=#c_apply{anno=Anno, + op=Loop, + args=[Xs]}, + body=Case}}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=1}]}, + body=#c_literal{val=[]}}, + Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, F, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^filter',1}}|Anno], Err2)}, + Fun = #c_fun{vars=[Xs], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L]}}}; +call(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3]) -> + Loop = #c_var{name={'lists^foldl',2}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + A = #c_var{name='A'}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_apply{anno=Anno, + op=Loop, + args=[Xs, #c_apply{anno=Anno, + op=F, + args=[X, A]}]}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=2}]}, + body=A}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^foldl',2}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs, A], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}}; +call(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3]) -> + Loop = #c_var{name={'lists^foldr',2}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + A = #c_var{name='A'}, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=#c_apply{anno=Anno, + op=F, + args=[X, #c_apply{anno=Anno, + op=Loop, + args=[Xs, A]}]}}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=2}]}, + body=A}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, A, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^foldr',2}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs, A], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, + body=#c_letrec{defs=[{Loop,Fun}], + body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}}; +call(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3]) -> + Loop = #c_var{name={'lists^mapfoldl',2}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + Avar = #c_var{name='A'}, + Match = + fun (A, P, E) -> + C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, + Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, + C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, + body=match_fail(Anno, Err)}, + #c_case{arg=A, clauses=[C1, C2]} + end, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, + body=Match(#c_apply{anno=Anno, op=F, args=[X, Avar]}, + #c_tuple{es=[X, Avar]}, +%%% Tuple passing version + Match(#c_apply{anno=Anno, + op=Loop, + args=[Xs, Avar]}, + #c_tuple{es=[Xs, Avar]}, + #c_tuple{anno=[compiler_generated], + es=[#c_cons{anno=[compiler_generated], + hd=X, tl=Xs}, + Avar]}) +%%% Multiple-value version +%%% #c_let{vars=[Xs,A], +%%% %% The tuple here will be optimised +%%% %% away later; no worries. +%%% arg=#c_apply{op=Loop, args=[Xs, A]}, +%%% body=#c_values{es=[#c_cons{hd=X, tl=Xs}, +%%% A]}} + )}, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=2}]}, +%%% Tuple passing version + body=#c_tuple{anno=[compiler_generated], + es=[#c_literal{val=[]}, Avar]}}, +%%% Multiple-value version +%%% body=#c_values{es=[#c_literal{val=[]}, A]}}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^mapfoldl',2}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs, Avar], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, + body=#c_letrec{defs=[{Loop,Fun}], +%%% Tuple passing version + body=#c_apply{anno=Anno, + op=Loop, + args=[L, Avar]}}}; +%%% Multiple-value version +%%% body=#c_let{vars=[Xs, A], +%%% arg=#c_apply{op=Loop, +%%% args=[L, A]}, +%%% body=#c_tuple{es=[Xs, A]}}}}; +call(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3]) -> + Loop = #c_var{name={'lists^mapfoldr',2}}, + F = #c_var{name='F'}, + Xs = #c_var{name='Xs'}, + X = #c_var{name='X'}, + Avar = #c_var{name='A'}, + Match = + fun (A, P, E) -> + C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E}, + Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]}, + C2 = #c_clause{pats=[X], guard=#c_literal{val=true}, + body=match_fail(Anno, Err)}, + #c_case{arg=A, clauses=[C1, C2]} + end, + C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true}, +%%% Tuple passing version + body=Match(#c_apply{anno=Anno, + op=Loop, + args=[Xs, Avar]}, + #c_tuple{es=[Xs, Avar]}, + Match(#c_apply{anno=Anno, op=F, args=[X, Avar]}, + #c_tuple{es=[X, Avar]}, + #c_tuple{anno=[compiler_generated], + es=[#c_cons{anno=[compiler_generated], + hd=X, tl=Xs}, Avar]})) +%%% Multiple-value version +%%% body=#c_let{vars=[Xs,A], +%%% %% The tuple will be optimised away +%%% arg=#c_apply{op=Loop, args=[Xs, A]}, +%%% body=Match(#c_apply{op=F, args=[X, A]}, +%%% #c_tuple{es=[X, A]}, +%%% #c_values{es=[#c_cons{hd=X, tl=Xs}, +%%% A]})} + }, + C2 = #c_clause{pats=[#c_literal{val=[]}], + guard=#c_call{module=#c_literal{val=erlang}, + name=#c_literal{val=is_function}, + args=[F, #c_literal{val=2}]}, +%%% Tuple passing version + body=#c_tuple{anno=[compiler_generated], + es=[#c_literal{val=[]}, Avar]}}, +%%% Multiple-value version +%%% body=#c_values{es=[#c_literal{val=[]}, A]}}, + Err = #c_tuple{es=[#c_literal{val='function_clause'}, F, Avar, Xs]}, + C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true}, + body=match_fail([{function_name,{'lists^mapfoldr',2}}|Anno], Err)}, + Fun = #c_fun{vars=[Xs, Avar], + body=#c_case{arg=Xs, clauses=[C1, C2, C3]}}, + L = #c_var{name='L'}, + #c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]}, + body=#c_letrec{defs=[{Loop,Fun}], +%%% Tuple passing version + body=#c_apply{anno=Anno, + op=Loop, + args=[L, Avar]}}}; +%%% Multiple-value version +%%% body=#c_let{vars=[Xs, A], +%%% arg=#c_apply{op=Loop, +%%% args=[L, A]}, +%%% body=#c_tuple{es=[Xs, A]}}}}; +call(_, _, _, _) -> + none. + +match_fail(Ann, Arg) -> + Name = cerl:abstract(match_fail), + Args = [Arg], + cerl:ann_c_primop(Ann, Name, Args). diff --git a/lib/compiler/src/sys_core_inline.erl b/lib/compiler/src/sys_core_inline.erl index 9f93acb666..1e3a735e9b 100644 --- a/lib/compiler/src/sys_core_inline.erl +++ b/lib/compiler/src/sys_core_inline.erl @@ -195,10 +195,10 @@ kill_id_anns(Body) -> A = kill_id_anns_1(A0), CFun#c_fun{anno=A}; (Expr) -> - %% Mark everything as compiler generated to suppress - %% bogus warnings. - A = compiler_generated(core_lib:get_anno(Expr)), - core_lib:set_anno(Expr, A) + %% Mark everything as compiler generated to + %% suppress bogus warnings. + A = compiler_generated(cerl:get_ann(Expr)), + cerl:set_ann(Expr, A) end, Body). kill_id_anns_1([{'id',_}|As]) -> diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index f0b90ff31c..9dd6b319a3 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -66,6 +66,7 @@ %% match arguments are novars %% case arguments are novars %% receive timeouts are novars +%% binaries and maps are novars %% let/set arguments are expressions %% fun is not a safe @@ -107,6 +108,7 @@ -record(ifilter, {anno=#a{},arg}). -record(igen, {anno=#a{},ceps=[],acc_pat,acc_guard, skip_pat,tail,tail_pat,arg}). +-record(isimple, {anno=#a{},term :: cerl:cerl()}). -type iapply() :: #iapply{}. -type ibinary() :: #ibinary{}. @@ -125,11 +127,12 @@ -type itry() :: #itry{}. -type ifilter() :: #ifilter{}. -type igen() :: #igen{}. +-type isimple() :: #isimple{}. -type i() :: iapply() | ibinary() | icall() | icase() | icatch() | iclause() | ifun() | iletrec() | imatch() | iprimop() | iprotect() | ireceive1() | ireceive2() | iset() | itry() - | ifilter() | igen(). + | ifilter() | igen() | isimple(). -type warning() :: {file:filename(), [{integer(), module(), term()}]}. @@ -288,13 +291,15 @@ gexpr({protect,Line,Arg}, Bools0, St0) -> {#iprotect{anno=#a{anno=Anno},body=Eps++[E]},[],Bools0,St} end; gexpr({op,L,'andalso',E1,E2}, Bools, St0) -> - {#c_var{name=V0},St} = new_var(L, St0), + Anno = lineno_anno(L, St0), + {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, False = {atom,L,false}, E = make_bool_switch_guard(L, E1, V, E2, False), gexpr(E, Bools, St); gexpr({op,L,'orelse',E1,E2}, Bools, St0) -> - {#c_var{name=V0},St} = new_var(L, St0), + Anno = lineno_anno(L, St0), + {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, True = {atom,L,true}, E = make_bool_switch_guard(L, E1, V, True, E2), @@ -383,33 +388,30 @@ gexpr_test(E0, Bools0, St0) -> Lanno = Anno#a.anno, {New,St2} = new_var(Lanno, St1), Bools = [New|Bools0], - {#icall{anno=Anno, %Must have an #a{} - module=#c_literal{anno=Lanno,val=erlang}, - name=#c_literal{anno=Lanno,val='=:='}, - args=[New,#c_literal{anno=Lanno,val=true}]}, + {icall_eq_true(New), Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools,St2} end; _ -> - Anno = get_ianno(E1), Lanno = get_lineno_anno(E1), + ACompGen = #a{anno=[compiler_generated]}, case is_simple(E1) of true -> Bools = [E1|Bools0], - {#icall{anno=Anno, %Must have an #a{} - module=#c_literal{anno=Lanno,val=erlang}, - name=#c_literal{anno=Lanno,val='=:='}, - args=[E1,#c_literal{anno=Lanno,val=true}]},Eps0,Bools,St1}; + {icall_eq_true(E1),Eps0,Bools,St1}; false -> {New,St2} = new_var(Lanno, St1), Bools = [New|Bools0], - {#icall{anno=Anno, %Must have an #a{} - module=#c_literal{anno=Lanno,val=erlang}, - name=#c_literal{anno=Lanno,val='=:='}, - args=[New,#c_literal{anno=Lanno,val=true}]}, - Eps0 ++ [#iset{anno=Anno,var=New,arg=E1}],Bools,St2} + {icall_eq_true(New), + Eps0 ++ [#iset{anno=ACompGen,var=New,arg=E1}],Bools,St2} end end. +icall_eq_true(Arg) -> + #icall{anno=#a{anno=[compiler_generated]}, + module=#c_literal{val=erlang}, + name=#c_literal{val='=:='}, + args=[Arg,#c_literal{val=true}]}. + force_booleans(Vs0, E, Eps, St) -> Vs1 = [set_anno(V, []) || V <- Vs0], Vs = unforce(E, Eps, Vs1), @@ -419,16 +421,15 @@ force_booleans_1([], E, Eps, St) -> {E,Eps,St}; force_booleans_1([V|Vs], E0, Eps0, St0) -> {E1,Eps1,St1} = force_safe(E0, St0), - Lanno = element(2, V), - Anno = #a{anno=Lanno}, - Call = #icall{anno=Anno,module=#c_literal{anno=Lanno,val=erlang}, - name=#c_literal{anno=Lanno,val=is_boolean}, + ACompGen = #a{anno=[compiler_generated]}, + Call = #icall{anno=ACompGen,module=#c_literal{val=erlang}, + name=#c_literal{val=is_boolean}, args=[V]}, - {New,St} = new_var(Lanno, St1), - Iset = #iset{anno=Anno,var=New,arg=Call}, + {New,St} = new_var([], St1), + Iset = #iset{var=New,arg=Call}, Eps = Eps0 ++ Eps1 ++ [Iset], - E = #icall{anno=Anno, - module=#c_literal{anno=Lanno,val=erlang},name=#c_literal{anno=Lanno,val='and'}, + E = #icall{anno=ACompGen, + module=#c_literal{val=erlang},name=#c_literal{val='and'}, args=[E1,New]}, force_booleans_1(Vs, E, Eps, St). @@ -530,7 +531,7 @@ expr({lc,L,E,Qs0}, St0) -> {Qs1,St1} = preprocess_quals(L, Qs0, St0), lc_tq(L, E, Qs1, #c_literal{anno=lineno_anno(L, St1),val=[]}, St1); expr({bc,L,E,Qs}, St) -> - bc_tq(L, E, Qs, {nil,L}, St); + bc_tq(L, E, Qs, St); expr({tuple,L,Es0}, St0) -> {Es1,Eps,St1} = safe_list(Es0, St0), A = record_anno(L, St1), @@ -707,13 +708,15 @@ expr({op,_,'++',{lc,Llc,E,Qs0},More}, St0) -> {Y,Yps,St} = lc_tq(Llc, E, Qs, Mc, St2), {Y,Mps++Yps,St}; expr({op,L,'andalso',E1,E2}, St0) -> - {#c_var{name=V0},St} = new_var(L, St0), + Anno = lineno_anno(L, St0), + {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, False = {atom,L,false}, E = make_bool_switch(L, E1, V, E2, False, St0), expr(E, St); expr({op,L,'orelse',E1,E2}, St0) -> - {#c_var{name=V0},St} = new_var(L, St0), + Anno = lineno_anno(L, St0), + {#c_var{name=V0},St} = new_var(Anno, St0), V = {var,L,V0}, True = {atom,L,true}, E = make_bool_switch(L, E1, V, True, E2, St0), @@ -781,15 +784,9 @@ expr_map(M0,Es0,A,St0) -> false -> throw({bad_map,bad_map}) end. -map_build_pairs(Map0, Es0, Ann, St0) -> +map_build_pairs(Map, Es0, Ann, St0) -> {Es,Pre,St1} = map_build_pairs_1(Es0, St0), - case ann_c_map(Ann, Map0, Es) of - #c_literal{}=Map -> - {Map,[],St1}; - #c_map{}=Map -> - {Var,St2} = new_var(St1), - {Var,Pre++[#iset{var=Var,arg=Map}],St2} - end. + {ann_c_map(Ann, Map, Es),Pre,St1}. map_build_pairs_1([{Op0,L,K0,V0}|Es], St0) -> {K,Pre0,St1} = safe(K0, St0), @@ -1027,7 +1024,7 @@ lc_tq(Line, E0, [], Mc0, St0) -> %% This TQ from Gustafsson ERLANG'05. %% More could be transformed before calling bc_tq. -bc_tq(Line, Exp, Qs0, _, St0) -> +bc_tq(Line, Exp, Qs0, St0) -> {BinVar,St1} = new_var(St0), {Sz,SzPre,St2} = bc_initial_size(Exp, Qs0, St1), {Qs,St3} = preprocess_quals(Line, Qs0, St2), @@ -1484,6 +1481,7 @@ force_novars(#iapply{}=App, St) -> {App,[],St}; force_novars(#icall{}=Call, St) -> {Call,[],St}; force_novars(#ifun{}=Fun, St) -> {Fun,[],St}; %These are novars too force_novars(#ibinary{}=Bin, St) -> {Bin,[],St}; +force_novars(#c_map{}=Bin, St) -> {Bin,[],St}; force_novars(Ce, St) -> force_safe(Ce, St). @@ -1763,7 +1761,7 @@ new_var_name(#core{vcount=C}=St) -> new_var(St) -> new_var([], St). -new_var(Anno, St0) -> +new_var(Anno, St0) when is_list(Anno) -> {New,St} = new_var_name(St0), {#c_var{anno=Anno,name=New},St}. @@ -1990,11 +1988,11 @@ uexpr(#ibinary{anno=A,segments=Ss}, _, St) -> uexpr(#c_literal{}=Lit, _, St) -> Anno = get_anno(Lit), {set_anno(Lit, #a{us=[],anno=Anno}),St}; -uexpr(Lit, _, St) -> - true = is_simple(Lit), %Sanity check! - Vs = lit_vars(Lit), - Anno = get_anno(Lit), - {set_anno(Lit, #a{us=Vs,anno=Anno}),St}. +uexpr(Simple, _, St) -> + true = is_simple(Simple), %Sanity check! + Vs = lit_vars(Simple), + Anno = get_anno(Simple), + {#isimple{anno=#a{us=Vs,anno=Anno},term=Simple},St}. uexpr_list(Les0, Ks, St0) -> mapfoldl(fun (Le, St) -> uexpr(Le, Ks, St) end, St0, Les0). @@ -2171,7 +2169,8 @@ cguard(Gs, St0) -> cexprs([#iset{var=#c_var{name=Name}=Var}=Iset], As, St) -> %% Make return value explicit, and make Var true top level. - cexprs([Iset,Var#c_var{anno=#a{us=[Name]}}], As, St); + Isimple = #isimple{anno=#a{us=[Name]},term=Var}, + cexprs([Iset,Isimple], As, St); cexprs([Le], As, St0) -> {Ce,Es,Us,St1} = cexpr(Le, As, St0), Exp = make_vars(As), %The export variables @@ -2286,12 +2285,9 @@ cexpr(#c_literal{}=Lit, _As, St) -> Anno = get_anno(Lit), Vs = Anno#a.us, {set_anno(Lit, Anno#a.anno),[],Vs,St}; -cexpr(Lit, _As, St) -> - true = is_simple(Lit), %Sanity check! - Anno = get_anno(Lit), - Vs = Anno#a.us, - %%Vs = lit_vars(Lit), - {set_anno(Lit, Anno#a.anno),[],Vs,St}. +cexpr(#isimple{anno=#a{us=Vs},term=Simple}, _As, St) -> + true = is_simple(Simple), %Sanity check! + {Simple,[],Vs,St}. cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) -> {Ccs,St1} = cclauses(Lcs, [], St0), %NEVER export! @@ -2314,11 +2310,6 @@ lit_vars(#c_map_pair{key=K,val=V}, Vs) -> lit_vars(K, lit_vars(V, Vs)); lit_vars(#c_var{name=V}, Vs) -> add_element(V, Vs); lit_vars(_, Vs) -> Vs. %These are atomic -% lit_bin_vars(Segs, Vs) -> -% foldl(fun (#c_bitstr{val=V,size=S}, Vs0) -> -% lit_vars(V, lit_vars(S, Vs0)) -% end, Vs, Segs). - lit_list_vars(Ls) -> lit_list_vars(Ls, []). lit_list_vars(Ls, Vs) -> diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 72e7a39333..08e84efc1b 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -131,12 +131,12 @@ module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) -> {ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas, body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}. -attributes([{#c_literal{val=Name},Val}|As]) -> +attributes([{#c_literal{val=Name},#c_literal{val=Val}}|As]) -> case include_attribute(Name) of false -> attributes(As); true -> - [{Name,core_lib:literal_value(Val)}|attributes(As)] + [{Name,Val}|attributes(As)] end; attributes([]) -> []. @@ -675,12 +675,12 @@ atomic_bin([#c_bitstr{anno=A,val=E0,size=S0,unit=U0,type=T,flags=Fs0}|Es0], {E,Ap1,St1} = atomic(E0, Sub, St0), {S1,Ap2,St2} = atomic(S0, Sub, St1), validate_bin_element_size(S1), - U1 = core_lib:literal_value(U0), - Fs1 = core_lib:literal_value(Fs0), + U1 = cerl:concrete(U0), + Fs1 = cerl:concrete(Fs0), {Es,Ap3,St3} = atomic_bin(Es0, Sub, St2), {#k_bin_seg{anno=A,size=S1, unit=U1, - type=core_lib:literal_value(T), + type=cerl:concrete(T), flags=Fs1, seg=E,next=Es}, Ap1++Ap2++Ap3,St3}; @@ -807,8 +807,8 @@ pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0], %% problems. #k_atom{val=bad_size} end, - U0 = core_lib:literal_value(U), - Fs0 = core_lib:literal_value(Fs), + U0 = cerl:concrete(U), + Fs0 = cerl:concrete(Fs), %%ok= io:fwrite("~w: ~p~n", [?LINE,{B0,S,U0,Fs0}]), {E,Osub1,St2} = pattern(E0, Isub0, Osub0, St1), Isub1 = case E0 of @@ -819,7 +819,7 @@ pattern_bin_1([#c_bitstr{anno=A,val=E0,size=S0,unit=U,type=T,flags=Fs}|Es0], {Es,{Isub,Osub},St3} = pattern_bin_1(Es0, Isub1, Osub1, St2), {#k_bin_seg{anno=A,size=S, unit=U0, - type=core_lib:literal_value(T), + type=cerl:concrete(T), flags=Fs0, seg=E,next=Es}, {Isub,Osub},St3}; diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl index 22aa19522d..3199440d84 100644 --- a/lib/compiler/test/andor_SUITE.erl +++ b/lib/compiler/test/andor_SUITE.erl @@ -173,7 +173,13 @@ t_and_or(Config) when is_list(Config) -> true = (fun (X = true) when X or true or X -> true end)(True), - ok. + Tuple = id({a,b}), + case Tuple of + {_,_} -> + {'EXIT',{badarg,_}} = (catch true and Tuple) + end, + + ok. t_andalso(Config) when is_list(Config) -> Bs = [true,false], diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 27979647c6..c441f9f284 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -21,16 +21,17 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, - beam_files/1,compiler_bug/1,stupid_but_valid/1, + compiler_bug/1,stupid_but_valid/1, xrange/1,yrange/1,stack/1,call_last/1,merge_undefined/1, uninit/1,unsafe_catch/1, - dead_code/1,mult_labels/1, + dead_code/1, overwrite_catchtag/1,overwrite_trytag/1,accessing_tags/1,bad_catch_try/1, cons_guard/1, freg_range/1,freg_uninit/1,freg_state/1, - bin_match/1,bad_bin_match/1,bin_aligned/1,bad_dsetel/1, + bad_bin_match/1,bin_aligned/1,bad_dsetel/1, state_after_fault_in_catch/1,no_exception_in_catch/1, - undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1]). + undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1, + map_field_lists/1]). -include_lib("test_server/include/test_server.hrl"). @@ -47,18 +48,19 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [beam_files,{group,p}]. + [{group,p}]. groups() -> [{p,test_lib:parallel(), [compiler_bug,stupid_but_valid,xrange, yrange,stack,call_last,merge_undefined,uninit, - unsafe_catch,dead_code,mult_labels, + unsafe_catch,dead_code, overwrite_catchtag,overwrite_trytag,accessing_tags, bad_catch_try,cons_guard,freg_range,freg_uninit, - freg_state,bin_match,bad_bin_match,bin_aligned,bad_dsetel, + freg_state,bad_bin_match,bin_aligned,bad_dsetel, state_after_fault_in_catch,no_exception_in_catch, - undef_label,illegal_instruction,failing_gc_guard_bif]}]. + undef_label,illegal_instruction,failing_gc_guard_bif, + map_field_lists]}]. init_per_suite(Config) -> Config. @@ -72,27 +74,6 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. - -beam_files(Config) when is_list(Config) -> - ?line DataDir = proplists:get_value(data_dir, Config), - ?line Wc = filename:join([DataDir,"..","..","*","*.beam"]), - %% Must have at least two files here, or there will be - %% a grammatical error in the output of the io:format/2 call below. ;-) - ?line [_,_|_] = Fs = filelib:wildcard(Wc), - ?line io:format("~p files\n", [length(Fs)]), - test_lib:p_run(fun do_beam_file/1, Fs). - - -do_beam_file(F) -> - case beam_validator:file(F) of - ok -> - ok; - {error,Es} -> - io:format("File: ~s", [F]), - io:format("Error: ~p\n", [Es]), - error - end. - compiler_bug(Config) when is_list(Config) -> %% Check that the compiler returns an error if we try to %% assemble one of the bad '.S' files. @@ -152,14 +133,14 @@ yrange(Config) when is_list(Config) -> stack(Config) when is_list(Config) -> Errors = do_val(stack, Config), - ?line [{{t,a,2},{return,11,{stack_frame,2}}}, - {{t,b,2},{{deallocate,2},4,{allocated,none}}}, - {{t,c,2},{{deallocate,2},12,{allocated,none}}}, - {{t,d,2}, - {{allocate,2,2},5,{existing_stack_frame,{size,2}}}}, - {{t,e,2},{{deallocate,5},6,{allocated,2}}}, - {{t,bad_1,0},{{allocate_zero,2,10},4,{{x,9},not_live}}}, - {{t,bad_2,0},{{move,{y,0},{x,0}},5,{unassigned,{y,0}}}}] = Errors, + [{{t,a,2},{return,11,{stack_frame,2}}}, + {{t,b,2},{{deallocate,2},4,{allocated,none}}}, + {{t,bad_1,0},{{allocate_zero,2,10},4,{{x,9},not_live}}}, + {{t,bad_2,0},{{move,{y,0},{x,0}},5,{unassigned,{y,0}}}}, + {{t,c,2},{{deallocate,2},12,{allocated,none}}}, + {{t,d,2}, + {{allocate,2,2},5,{existing_stack_frame,{size,2}}}}, + {{t,e,2},{{deallocate,5},6,{allocated,2}}}] = Errors, ok. call_last(Config) when is_list(Config) -> @@ -173,10 +154,10 @@ call_last(Config) when is_list(Config) -> merge_undefined(Config) when is_list(Config) -> Errors = do_val(merge_undefined, Config), - ?line [{{t,handle_call,2}, - {{call_ext,2,{extfunc,debug,filter,2}}, - 22, - {uninitialized_reg,{y,0}}}}] = Errors, + [{{t,handle_call,2}, + {{call_ext,2,{extfunc,debug,filter,2}}, + 23, + {uninitialized_reg,{y,0}}}}] = Errors, ok. uninit(Config) when is_list(Config) -> @@ -185,7 +166,7 @@ uninit(Config) when is_list(Config) -> [{{t,sum_1,2}, {{move,{y,0},{x,0}},5,{uninitialized_reg,{y,0}}}}, {{t,sum_2,2}, - {{call,1,{f,10}},6,{uninitialized_reg,{y,0}}}}, + {{call,1,{f,8}},6,{uninitialized_reg,{y,0}}}}, {{t,sum_3,2}, {{bif,'+',{f,0},[{x,0},{y,0}],{x,0}}, 7, @@ -206,10 +187,6 @@ dead_code(Config) when is_list(Config) -> [] = do_val(dead_code, Config), ok. -mult_labels(Config) when is_list(Config) -> - [] = do_val(erl_prim_loader, Config, ".beam"), - ok. - overwrite_catchtag(Config) when is_list(Config) -> Errors = do_val(overwrite_catchtag, Config), ?line @@ -226,11 +203,10 @@ overwrite_trytag(Config) when is_list(Config) -> accessing_tags(Config) when is_list(Config) -> Errors = do_val(accessing_tags, Config), - ?line - [{{accessing_tags,foo,1}, - {{move,{y,0},{x,0}},6,{catchtag,_}}}, - {{accessing_tags,bar,1}, - {{move,{y,0},{x,0}},6,{trytag,_}}}] = Errors, + [{{accessing_tags,bar,1}, + {{move,{y,0},{x,0}},6,{trytag,_}}}, + {{accessing_tags,foo,1}, + {{move,{y,0},{x,0}},6,{catchtag,_}}}] = Errors, ok. bad_catch_try(Config) when is_list(Config) -> @@ -317,13 +293,6 @@ freg_state(Config) when is_list(Config) -> {fclearerror,5,{bad_floating_point_state,cleared}}}] = Errors, ok. -bin_match(Config) when is_list(Config) -> - Errors = do_val(bin_match, Config), - ?line - [{{t,t,1},{{bs_save,0},4,no_bs_match_state}}, - {{t,x,1},{{bs_restore,1},16,{no_save_point,1}}}] = Errors, - ok. - bad_bin_match(Config) when is_list(Config) -> [{{t,t,1},{return,5,{match_context,{x,0}}}}] = do_val(bad_bin_match, Config), @@ -347,20 +316,20 @@ bad_dsetel(Config) when is_list(Config) -> ?line [{{t,t,1}, {{set_tuple_element,{x,1},{x,0},1}, - 15, + 17, illegal_context_for_set_tuple_element}}] = Errors, ok. state_after_fault_in_catch(Config) when is_list(Config) -> Errors = do_val(state_after_fault_in_catch, Config), - [{{t,foo,1}, - {{move,{x,1},{x,0}},10,{uninitialized_reg,{x,1}}}}, - {{state_after_fault_in_catch,if_end,1}, + [{{state_after_fault_in_catch,badmatch,1}, {{move,{x,1},{x,0}},9,{uninitialized_reg,{x,1}}}}, {{state_after_fault_in_catch,case_end,1}, {{move,{x,1},{x,0}},9,{uninitialized_reg,{x,1}}}}, - {{state_after_fault_in_catch,badmatch,1}, - {{move,{x,1},{x,0}},9,{uninitialized_reg,{x,1}}}}] = Errors, + {{state_after_fault_in_catch,if_end,1}, + {{move,{x,1},{x,0}},9,{uninitialized_reg,{x,1}}}}, + {{t,foo,1}, + {{move,{x,1},{x,0}},10,{uninitialized_reg,{x,1}}}}] = Errors, ok. no_exception_in_catch(Config) when is_list(Config) -> @@ -370,13 +339,46 @@ no_exception_in_catch(Config) when is_list(Config) -> ok. undef_label(Config) when is_list(Config) -> - Errors = do_val(undef_label, Config), + M = {undef_label, + [{t,1}], + [], + [{function,t,1,2, + [{label,1}, + {func_info,{atom,undef_label},{atom,t},1}, + {label,2}, + {test,is_eq_exact,{f,42},[{x,0},{atom,x}]}, + {move,{atom,ok},{x,0}}, + return]}, + {function,x,1,17, + [{label,3}, + {func_info,{atom,undef_label},{atom,x},1}, + {label,4}, + return]}], + 5}, + Errors = beam_val(M), [{{undef_label,t,1},{undef_labels,[42]}}, {{undef_label,x,1},{return,4,no_entry_label}}] = Errors, ok. illegal_instruction(Config) when is_list(Config) -> - Errors = do_val(illegal_instruction, Config), + M = {illegal_instruction, + [{t,1},{x,1},{y,0}], + [], + [{function,t,1,2, + [{label,1}, + {func_info,{atom,illegal_instruction},{atom,t},1}, + {label,2}, + {my_illegal_instruction,{x,0}}, + return]}, + {function,x,1,4, + [{label,3}, + bad_func_info, + {label,4}, + {my_illegal_instruction,{x,0}}, + return]}, + {function,y,0,17,[]}], + 5}, + Errors = beam_val(M), [{{illegal_instruction,t,1}, {{my_illegal_instruction,{x,0}},4,unknown_instruction}}, {{'_',x,1},{bad_func_info,1,illegal_instruction}}, @@ -414,19 +416,40 @@ process_request_foo(_) -> process_request_bar(Pid, [Response]) when is_pid(Pid) -> Response. +map_field_lists(Config) -> + Errors = do_val(map_field_lists, Config), + [{{map_field_lists,x,1}, + {{test,has_map_fields,{f,1},{x,0}, + {list,[{atom,z},{atom,a}]}}, + 5, + not_strict_order}}, + {{map_field_lists,y,1}, + {{test,has_map_fields,{f,3},{x,0},{list,[]}}, + 5, + empty_field_list}} + ] = Errors. %%%------------------------------------------------------------------------- -do_val(Name, Config) -> - do_val(Name, Config, ".S"). - -do_val(Name, Config, Type) -> - ?line Data = ?config(data_dir, Config), - ?line File = filename:join(Data, atom_to_list(Name)++Type), - ?line case beam_validator:file(File) of - {error,Errors} -> - ?line io:format("~p:~n~s", - [File,beam_validator:format_error(Errors)]), - Errors; - ok -> [] - end. +do_val(Mod, Config) -> + Data = ?config(data_dir, Config), + Base = atom_to_list(Mod), + File = filename:join(Data, Base), + case compile:file(File, [from_asm,no_postopt,return_errors]) of + {error,L,[]} -> + [{Base,Errors0}] = L, + Errors = [E || {beam_validator,E} <- Errors0], + _ = [io:put_chars(beam_validator:format_error(E)) || + E <- Errors], + Errors; + {ok,Mod} -> + [] + end. + +beam_val(M) -> + Name = atom_to_list(element(1, M)), + {error,[{Name,Errors0}]} = beam_validator:module(M, []), + Errors = [E || {beam_validator,E} <- Errors0], + _ = [io:put_chars(beam_validator:format_error(E)) || + E <- Errors], + Errors. diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_dsetel.S b/lib/compiler/test/beam_validator_SUITE_data/bad_dsetel.S index 279b2fa97f..9630d73a93 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/bad_dsetel.S +++ b/lib/compiler/test/beam_validator_SUITE_data/bad_dsetel.S @@ -1,4 +1,4 @@ -{module, t}. %% version = 0 +{module, bad_dsetel}. %% version = 0 {exports, [{module_info,0},{module_info,1},{t,1}]}. @@ -21,7 +21,9 @@ {move,{integer,3},{x,0}}. {call_ext,3,{extfunc,erlang,setelement,3}}. {test_heap,6,1}. - {put_string,3,{string,"abc"},{x,1}}. + {put_list,{integer,99},nil,{x,1}}. + {put_list,{integer,98},{x,1},{x,1}}. + {put_list,{integer,97},{x,1},{x,1}}. {set_tuple_element,{x,1},{x,0},1}. {'%live',1}. {deallocate,0}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S b/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S index 2f353fbd25..a59f7ccc03 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S +++ b/lib/compiler/test/beam_validator_SUITE_data/bin_aligned.S @@ -1,4 +1,4 @@ -{module, t}. %% version = 0 +{module, bin_aligned}. %% version = 0 {exports, [{decode,1},{module_info,0},{module_info,1}]}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/bin_match.S b/lib/compiler/test/beam_validator_SUITE_data/bin_match.S deleted file mode 100644 index 96df0f7933..0000000000 --- a/lib/compiler/test/beam_validator_SUITE_data/bin_match.S +++ /dev/null @@ -1,64 +0,0 @@ -{module, bin_match}. %% version = 0 - -{exports, [{t,1}]}. - -{attributes, []}. - -{labels, 8}. - - -{function, t, 1, 2}. - {label,1}. - {func_info,{atom,t},{atom,t},1}. - {label,2}. -%% {test,bs_start_match,{f,1},[{x,0}]}. - {bs_save,0}. - {test,bs_get_integer, - {f,3}, - [{integer,8},1,{field_flags,[aligned,unsigned,big]},{x,1}]}. - {test,bs_get_integer, - {f,3}, - [{integer,8},1,{field_flags,[aligned,unsigned,big]},{x,2}]}. - {test,bs_test_tail,{f,3},[0]}. - {test_heap,3,3}. - {put_tuple,2,{x,0}}. - {put,{x,1}}. - {put,{x,2}}. - {'%live',1}. - return. - {label,3}. - {bs_restore,0}. - {test,bs_get_integer, - {f,1}, - [{integer,32},1,{field_flags,[aligned,unsigned,big]},{x,1}]}. - {test,bs_test_tail,{f,1},[0]}. - {move,{x,1},{x,0}}. - return. - -{function, x, 1, 5}. - {label,4}. - {func_info,{atom,t},{atom,x},1}. - {label,5}. - {test,bs_start_match,{f,4},[{x,0}]}. - {bs_save,0}. - {test,bs_get_integer, - {f,6}, - [{integer,8},1,{field_flags,[aligned,unsigned,big]},{x,1}]}. - {test,bs_get_integer, - {f,6}, - [{integer,8},1,{field_flags,[aligned,unsigned,big]},{x,2}]}. - {test,bs_test_tail,{f,6},[0]}. - {test_heap,3,3}. - {put_tuple,2,{x,0}}. - {put,{x,1}}. - {put,{x,2}}. - {'%live',1}. - return. - {label,6}. - {bs_restore,1}. - {test,bs_get_integer, - {f,4}, - [{integer,32},1,{field_flags,[aligned,unsigned,big]},{x,1}]}. - {test,bs_test_tail,{f,4},[0]}. - {move,{x,1},{x,0}}. - return. diff --git a/lib/compiler/test/beam_validator_SUITE_data/dead_code.S b/lib/compiler/test/beam_validator_SUITE_data/dead_code.S index f964f98fba..c114664ba0 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/dead_code.S +++ b/lib/compiler/test/beam_validator_SUITE_data/dead_code.S @@ -1,10 +1,10 @@ {module, dead_code}. %% version = 0 -{exports, [{execute,0},{module_info,0},{module_info,1}]}. +{exports, [{execute,0}]}. {attributes, []}. -{labels, 10}. +{labels, 6}. {function, execute, 0, 2}. @@ -12,7 +12,6 @@ {func_info,{atom,dead_code},{atom,execute},0}. {label,2}. {allocate,0,0}. - {'%live',0}. {call_ext,0,{extfunc,foo,fie,0}}. {test,is_ne,{f,4},[{x,0},{integer,0}]}. {test,is_ne,{f,4},[{x,0},{integer,1}]}. @@ -22,27 +21,7 @@ {case_end,{x,0}}. {label,4}. {move,{atom,ok},{x,0}}. - {'%live',1}. {deallocate,0}. return. - {'%','Moved code'}. {label,5}. {case_end,{x,0}}. - - -{function, module_info, 0, 7}. - {label,6}. - {func_info,{atom,dead_code},{atom,module_info},0}. - {label,7}. - {move,nil,{x,0}}. - {'%live',1}. - return. - - -{function, module_info, 1, 9}. - {label,8}. - {func_info,{atom,dead_code},{atom,module_info},1}. - {label,9}. - {move,nil,{x,0}}. - {'%live',1}. - return. diff --git a/lib/compiler/test/beam_validator_SUITE_data/erl_prim_loader.beam b/lib/compiler/test/beam_validator_SUITE_data/erl_prim_loader.beam Binary files differdeleted file mode 100644 index dd58a88e42..0000000000 --- a/lib/compiler/test/beam_validator_SUITE_data/erl_prim_loader.beam +++ /dev/null diff --git a/lib/compiler/test/beam_validator_SUITE_data/freg_range.S b/lib/compiler/test/beam_validator_SUITE_data/freg_range.S index ee583a923e..b3ebff3ade 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/freg_range.S +++ b/lib/compiler/test/beam_validator_SUITE_data/freg_range.S @@ -1,10 +1,10 @@ {module, freg_range}. %% version = 0 -{exports, [{module_info,0},{module_info,1},{prod,2},{sum,2},{sum_prod,3}]}. +{exports, [{sum_1,2},{sum_2,2},{sum_3,2},{sum_4,2}]}. {attributes, []}. -{labels, 8}. +{labels, 9}. {function, sum_1, 2, 2}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/freg_state.S b/lib/compiler/test/beam_validator_SUITE_data/freg_state.S index ff4d7548ae..7466763482 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/freg_state.S +++ b/lib/compiler/test/beam_validator_SUITE_data/freg_state.S @@ -1,6 +1,6 @@ {module, freg_state}. %% version = 0 -{exports, []}. +{exports, [{sum_1,2},{sum_2,2},{sum_3,2},{sum_4,2},{sum_5,2}]}. {attributes, []}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S b/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S index f8d805d9ec..71e833446a 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S +++ b/lib/compiler/test/beam_validator_SUITE_data/freg_uninit.S @@ -1,10 +1,10 @@ {module, freg_uninit}. %% version = 0 -{exports, []}. +{exports, [{sum_1,2},{sum_2,2}]}. {attributes, []}. -{labels, 8}. +{labels, 7}. {function, sum_1, 2, 2}. @@ -14,7 +14,6 @@ {fconv,{x,0},{fr,0}}. fclearerror. {bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,0}}. - {'%live',1}. return. @@ -26,7 +25,12 @@ {fconv,{x,1},{fr,1}}. fclearerror. {fcheckerror,{f,0}}. - {call,2,{f,8}}. + {call,2,{f,6}}. {bif,fadd,{f,0},[{fr,0},{fr,1}],{fr,0}}. - {'%live',1}. + return. + +{function, foo, 2, 6}. + {label,5}. + {func_info,{atom,t},{atom,foo},2}. + {label,6}. return. diff --git a/lib/compiler/test/beam_validator_SUITE_data/illegal_instruction.S b/lib/compiler/test/beam_validator_SUITE_data/illegal_instruction.S deleted file mode 100644 index d6e92abc71..0000000000 --- a/lib/compiler/test/beam_validator_SUITE_data/illegal_instruction.S +++ /dev/null @@ -1,26 +0,0 @@ -{module, illegal_instruction}. %% version = 0 - -{exports, []}. - -{attributes, []}. - -{labels, 7}. - - -{function, t, 1, 2}. - {label,1}. - {func_info,{atom,illegal_instruction},{atom,t},1}. - {label,2}. - {my_illegal_instruction,{x,0}}. - return. - - -{function, x, 1, 4}. - {label,3}. - bad_func_info. - {label,4}. - {my_illegal_instruction,{x,0}}. - return. - -{function, y, 0, 17}. -
\ No newline at end of file diff --git a/lib/compiler/test/beam_validator_SUITE_data/map_field_lists.S b/lib/compiler/test/beam_validator_SUITE_data/map_field_lists.S new file mode 100644 index 0000000000..9af68c82d4 --- /dev/null +++ b/lib/compiler/test/beam_validator_SUITE_data/map_field_lists.S @@ -0,0 +1,29 @@ +{module, map_field_lists}. %% version = 0 + +{exports, [{x,1},{y,1}]}. + +{attributes, []}. + +{labels, 5}. + + +{function, x, 1, 2}. + {label,1}. + {line,[{location,"map_field_lists.erl",4}]}. + {func_info,{atom,map_field_lists},{atom,x},1}. + {label,2}. + {test,is_map,{f,1},[{x,0}]}. + {test,has_map_fields,{f,1},{x,0},{list,[{atom,z},{atom,a}]}}. + {move,{atom,ok},{x,0}}. + return. + + +{function, y, 1, 4}. + {label,3}. + {line,[{location,"map_field_lists.erl",7}]}. + {func_info,{atom,map_field_lists},{atom,y},1}. + {label,4}. + {test,is_map,{f,3},[{x,0}]}. + {test,has_map_fields,{f,3},{x,0},{list,[]}}. + {move,{atom,ok},{x,0}}. + return. diff --git a/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S b/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S index 3d76127824..481d55045d 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S +++ b/lib/compiler/test/beam_validator_SUITE_data/merge_undefined.S @@ -22,7 +22,8 @@ {label,4}. {allocate_heap,1,6,2}. {move,{x,1},{y,0}}. - {put_string,2,{string,"~p"},{x,0}}. + {put_list,{integer,112},nil,{x,0}}. + {put_list,{integer,126},{x,0},{x,0}}. {put_list,{y,0},nil,{x,1}}. {'%live',2}. {call_ext,2,{extfunc,io,format,2}}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/no_exception_in_catch.S b/lib/compiler/test/beam_validator_SUITE_data/no_exception_in_catch.S index e08a718a39..1a5b417a5f 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/no_exception_in_catch.S +++ b/lib/compiler/test/beam_validator_SUITE_data/no_exception_in_catch.S @@ -26,7 +26,7 @@ {call_ext,1,{extfunc,erlang,erase,1}}. {move,{atom,nested},{x,0}}. {call_ext,1,{extfunc,erlang,erase,1}}. - {bif,self,nofail,[],{x,0}}. + {bif,self,{f,0},[],{x,0}}. {'try',{y,8},{f,13}}. {'try',{y,7},{f,11}}. {'try',{y,6},{f,9}}. @@ -34,7 +34,7 @@ %% Because the following instructions can't possible throw an exception, %% label 7 used to get no state. Now the try_end itself will save the state. {move,{x,0},{y,4}}. - {bif,self,nofail,[],{x,0}}. + {bif,self,{f,0},[],{x,0}}. {'%live',1}. {try_end,{y,5}}. {test,is_eq_exact,{f,15},[{x,0},{y,4}]}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/stack.S b/lib/compiler/test/beam_validator_SUITE_data/stack.S index 244c22a2f9..e4356a9d00 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/stack.S +++ b/lib/compiler/test/beam_validator_SUITE_data/stack.S @@ -1,10 +1,10 @@ {module, stack}. %% version = 0 -{exports, [{a,2},{b,2},{c,2},{d,2},{e,2}]}. +{exports, [{a,2},{b,2},{c,2},{d,2},{e,2},{bad_1,0},{bad_2,0},{foo,0}]}. {attributes, []}. -{labels, 21}. +{labels, 17}. {function, a, 2, 2}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/undef_label.S b/lib/compiler/test/beam_validator_SUITE_data/undef_label.S deleted file mode 100644 index dd29066bf4..0000000000 --- a/lib/compiler/test/beam_validator_SUITE_data/undef_label.S +++ /dev/null @@ -1,22 +0,0 @@ -{module, undef_label}. %% version = 0 - -{exports, []}. - -{attributes, []}. - -{labels, 7}. - - -{function, t, 1, 2}. - {label,1}. - {func_info,{atom,undef_label},{atom,t},1}. - {label,2}. - {test,is_eq_exact,{f,42},[{x,0},{atom,x}]}. - {move,{atom,ok},{x,0}}. - return. - -{function, x, 1, 17}. - {label,3}. - {func_info,{atom,undef_label},{atom,x},1}. - {label,4}. - return. diff --git a/lib/compiler/test/beam_validator_SUITE_data/uninit.S b/lib/compiler/test/beam_validator_SUITE_data/uninit.S index 1a45c31411..9a66f4f7d6 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/uninit.S +++ b/lib/compiler/test/beam_validator_SUITE_data/uninit.S @@ -1,9 +1,11 @@ {module, uninit}. %% version = 0 -{exports, []}. +{exports, [{sum_1,2},{sum_2,2},{sum_3,2}]}. {attributes, []}. +{labels, 9}. + {function, sum_1, 2, 2}. {label,1}. {func_info,{atom,t},{atom,sum_1},2}. @@ -11,7 +13,7 @@ {allocate,1,2}. {move,{y,0},{x,0}}. {'%live',1}. - {call,1,{f,10}}. + {call,1,{f,8}}. {bif,'+',{f,0},[{x,0},{y,0}],{x,0}}. {'%live',1}. {deallocate,1}. @@ -23,7 +25,7 @@ {label,4}. {allocate,1,2}. {'%live',1}. - {call,1,{f,10}}. + {call,1,{f,8}}. {bif,'+',{f,0},[{x,0},{y,0}],{x,0}}. {'%live',1}. {deallocate,1}. @@ -35,14 +37,14 @@ {label,6}. {allocate_zero,1,2}. {'%live',1}. - {call,1,{f,10}}. + {call,1,{f,8}}. {bif,'+',{f,0},[{x,0},{y,0}],{x,0}}. {'%live',1}. {deallocate,1}. return. -{function, id, 1, 10}. - {label,9}. +{function, id, 1, 8}. + {label,7}. {func_info,{atom,t},{atom,id},1}. - {label,10}. + {label,8}. return. diff --git a/lib/compiler/test/beam_validator_SUITE_data/xrange.S b/lib/compiler/test/beam_validator_SUITE_data/xrange.S index 3abbdffbc2..c6f20288f7 100644 --- a/lib/compiler/test/beam_validator_SUITE_data/xrange.S +++ b/lib/compiler/test/beam_validator_SUITE_data/xrange.S @@ -1,10 +1,10 @@ {module, xrange}. %% version = 0 -{exports, [{module_info,0},{module_info,1},{prod,2},{sum,2},{sum_prod,3}]}. +{exports, [{sum_1,2},{sum_2,2},{sum_3,2},{sum_4,2}]}. {attributes, []}. -{labels, 8}. +{labels, 9}. {function, sum_1, 2, 2}. diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 40a5ba2b17..512aada203 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -197,7 +197,10 @@ foo(A, B, C) -> A + B + C. bifs(Config) when is_list(Config) -> - ?line <<1,2,3,4>> = id(list_to_binary([1,2,3,4])), + <<1,2,3,4>> = id(list_to_binary([1,2,3,4])), + K = {a,key}, + V = {a,value}, + {ok,#{K:=V}} = id(list_to_tuple([ok,#{K=>V}])), ok. -define(CMP_SAME(A0, B), (fun(A) -> true = A == B, false = A /= B end)(id(A0))). @@ -280,6 +283,12 @@ coverage(Config) when is_list(Config) -> error = bsm_an_inlined(<<1,2,3>>, Config), error = bsm_an_inlined([], Config), + %% Cover eval_rel_op/4. + Tuple = id({a,b}), + false = case Tuple of + {_,_} -> + Tuple =:= true + end, ok. cover_will_match_list_type(A) -> diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index bc5ae803c6..cfa8262701 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -641,6 +641,7 @@ t_build_and_match_nil(Config) when is_list(Config) -> "treat" => V2, [] => V1 }), #{ [] := V3, [] := V3 } = id(#{ [] => V1, [] => V3 }), + #{ <<1>> := V3, [] := V1 } = id(#{ [] => V1, <<1>> => V3 }), ok. t_build_and_match_structure(Config) when is_list(Config) -> diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index d721a86f5a..68a31f14d5 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -280,6 +280,14 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, expect_error(fun() -> beam_z:module(BeamZInput, []) end), + %% beam_validator. + BeamValInput = {?MODULE,[{foo,0}],[], + [{function,foo,0,2, + [{label,1}, + {func_info,{atom,?MODULE},{atom,foo},0}, + {label,2}|non_proper_list]}],99}, + expect_error(fun() -> beam_validator:module(BeamValInput, []) end), + ok. expect_error(Fun) -> diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl index f736e14bf6..8cc90026ec 100644 --- a/lib/compiler/test/record_SUITE.erl +++ b/lib/compiler/test/record_SUITE.erl @@ -246,6 +246,14 @@ record_test_2(Config) when is_list(Config) -> ?line Barf = update_barf(Barf0), ?line #barf{a="abc",b=1} = id(Barf), + %% Test optimization of is_record/3. + false = case id({a,b}) of + {_,_}=Tuple -> is_record(Tuple, foo) + end, + false = case id(true) of + true=Bool -> is_record(Bool, foo) + end, + ok. record_test_3(Config) when is_list(Config) -> diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index e8f469c5b4..a5e2855f8c 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -18,7 +18,7 @@ %% -module(test_lib). --include("test_server.hrl"). +-include_lib("test_server/include/test_server.hrl"). -compile({no_auto_import,[binary_part/2]}). -export([id/1,recompile/1,parallel/0,uniq/0,opt_opts/1,get_data_dir/1, smoke_disasm/1,p_run/2,binary_part/2]). diff --git a/lib/dialyzer/test/small_SUITE_data/src/maps_redef2.erl b/lib/dialyzer/test/small_SUITE_data/src/maps_redef2.erl new file mode 100644 index 0000000000..945b2a9144 --- /dev/null +++ b/lib/dialyzer/test/small_SUITE_data/src/maps_redef2.erl @@ -0,0 +1,23 @@ +%% In 17, the linter says that map(A) redefines 'type map', which is +%% allowed until next release. However, Dialyzer used to replace +%% map(A) with #{}, which resulted in warnings. + +-module(maps_redef2). + +-export([t/0]). + +-type map(_A) :: integer(). + +t() -> + M = new(), + t1(M). + +-spec t1(map(_)) -> map(_). + +t1(A) -> + A + A. + +-spec new() -> map(_). + +new() -> + 3. diff --git a/lib/eldap/src/eldap.erl b/lib/eldap/src/eldap.erl index 977f7d2809..ae47c815c9 100644 --- a/lib/eldap/src/eldap.erl +++ b/lib/eldap/src/eldap.erl @@ -413,7 +413,7 @@ parse_args([{port, Port}|T], Cpid, Data) when is_integer(Port) -> parse_args([{timeout, Timeout}|T], Cpid, Data) when is_integer(Timeout),Timeout>0 -> parse_args(T, Cpid, Data#eldap{timeout = Timeout}); parse_args([{anon_auth, true}|T], Cpid, Data) -> - parse_args(T, Cpid, Data#eldap{anon_auth = false}); + parse_args(T, Cpid, Data#eldap{anon_auth = true}); parse_args([{anon_auth, _}|T], Cpid, Data) -> parse_args(T, Cpid, Data); parse_args([{ssl, true}|T], Cpid, Data) -> diff --git a/lib/kernel/src/gen_udp.erl b/lib/kernel/src/gen_udp.erl index 70dceb3679..860eec10a0 100644 --- a/lib/kernel/src/gen_udp.erl +++ b/lib/kernel/src/gen_udp.erl @@ -78,7 +78,7 @@ ipv6_v6only. -type socket() :: port(). --export_type([option/0, option_name/0]). +-export_type([option/0, option_name/0, socket/0]). -spec open(Port) -> {ok, Socket} | {error, Reason} when Port :: inet:port_number(), diff --git a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc index 65b950bd46..127c23e0f7 100644 --- a/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc +++ b/lib/mnesia/doc/src/Mnesia_chap5.xmlsrc @@ -867,6 +867,7 @@ ok </section> <section> + <marker id="event_handling"></marker> <title>Mnesia Event Handling</title> <p>System events and table events are the two categories of events that Mnesia will generate in various situations. diff --git a/lib/mnesia/doc/src/mnesia.xml b/lib/mnesia/doc/src/mnesia.xml index 3eeb6f0247..856a7594a7 100644 --- a/lib/mnesia/doc/src/mnesia.xml +++ b/lib/mnesia/doc/src/mnesia.xml @@ -863,7 +863,7 @@ mnesia:create_table(person, {attributes, record_info(fields,person)}]). </code> <p>The specification of <c>index</c> and <c>attributes</c> may be - hard coded as <c>{index, [2]}</c> and + hard coded as <c>{index, [4]}</c> and <c>{attributes, [name, age, address, salary, children]}</c> respectively. </p> @@ -2188,12 +2188,13 @@ mnesia:create_table(employee, </desc> </func> <func> - <name>subscribe(EventCategory)</name> + <name>subscribe(EventCategory) -> {ok, Node} | {error, Reason} </name> <fsummary>Subscribe to events of type <c>EventCategory</c>.</fsummary> <desc> <p>Ensures that a copy of all events of type <c>EventCategory</c> are sent to the caller. The event - types available are described in the Mnesia User's Guide.</p> + types available are described in the Mnesia User's Guide at <seealso marker="Mnesia_chap5#event_handling">Mnesia Event Handling</seealso>.</p> + <p><c>Node</c> is the local node. For table events to be subscribed, mnesia must have a readable local copy of the table on the node.</p> </desc> </func> <func> @@ -2861,11 +2862,12 @@ raise(Name, Amount) -> </desc> </func> <func> - <name>unsubscribe(EventCategory)</name> + <name>unsubscribe(EventCategory) -> {ok, Node} | {error, Reason} </name> <fsummary>Subscribe to events of type <c>EventCategory</c>.</fsummary> <desc> <p>Stops sending events of type <c>EventCategory</c> to the caller.</p> + <p><c>Node</c> is the local node.</p> </desc> </func> <func> diff --git a/lib/observer/doc/src/observer_ug.xml b/lib/observer/doc/src/observer_ug.xml index 62f99c5210..fcb42f6c31 100644 --- a/lib/observer/doc/src/observer_ug.xml +++ b/lib/observer/doc/src/observer_ug.xml @@ -104,6 +104,29 @@ <note> <p><em>Reds</em> can be presented as accumulated values or as values since last update.</p> </note> + <p><c>Process info</c> open a detailed information window on the selected process. + <taglist> + <tag>Process Information</tag> + <item>Shows the process information.</item> + <tag>Messages</tag> + <item>Shows the process messages.</item> + <tag>Dictionary</tag> + <item>Shows the process dictionary.</item> + <tag>Stack Trace</tag> + <item>Shows the process current stack trace.</item> + <tag>State</tag> + <item>Show the process state.</item> + <tag>Log</tag> + <item>If enabled and available, show the process SASL log entries.</item> + </taglist> + <note> + <p><c>Log</c> needs SASL application to be started on the observed node, with log_mf_h as log handler. + The Observed node must be R16B02 or higher. + <c>rb</c> server must not be started on the observed node when clicking on menu 'Log/Toggle log view'. + <c>rb</c> server will be stopped on the observed node when exiting or changing observed node. + </p> + </note> + </p> <p><c>Trace Processes</c> will add the selected process identifiers to the <c>Trace Overview</c> view and the node the processes reside on will be added as well. <c>Trace Named Processes</c> will add the registered name of processes. This can be useful diff --git a/lib/observer/src/observer_html_lib.erl b/lib/observer/src/observer_html_lib.erl index c279218707..53197078cf 100644 --- a/lib/observer/src/observer_html_lib.erl +++ b/lib/observer/src/observer_html_lib.erl @@ -60,7 +60,8 @@ expandable_term_body(Heading,[],_Tab) -> "StackDump" -> "No stack dump was found"; "Dictionary" -> "No dictionary was found"; "ProcState" -> "Information could not be retrieved," - " system messages may not be handled by this process." + " system messages may not be handled by this process."; + "SaslLog" -> "No log entry was found" end]; expandable_term_body(Heading,Expanded,Tab) -> Attr = "BORDER=0 CELLPADDING=0 CELLSPACING=1 WIDTH=100%", @@ -102,7 +103,10 @@ expandable_term_body(Heading,Expanded,Tab) -> element(1, lists:mapfoldl(fun(Entry, Even) -> {proc_state(Tab, Entry,Even), not Even} - end, true, Expanded))]); + end, true, Expanded))]); + "SaslLog" -> + table(Attr, + [tr("BGCOLOR=white",[td("ALIGN=left", pre(href_proc_port(Expanded)))])]) ; _ -> table(Attr, [tr( diff --git a/lib/observer/src/observer_procinfo.erl b/lib/observer/src/observer_procinfo.erl index 8e8a37fc93..a8512894f9 100644 --- a/lib/observer/src/observer_procinfo.erl +++ b/lib/observer/src/observer_procinfo.erl @@ -43,6 +43,8 @@ -record(worker, {panel, callback}). +-record(io, {rdata=""}). + start(Process, ParentFrame, Parent) -> wx_object:start_link(?MODULE, [Process, ParentFrame, Parent], []). @@ -69,6 +71,10 @@ init([Pid, ParentFrame, Parent]) -> DictPage = init_panel(Notebook, "Dictionary", [Pid,Table], fun init_dict_page/3), StackPage = init_panel(Notebook, "Stack Trace", [Pid], fun init_stack_page/2), StatePage = init_panel(Notebook, "State", [Pid,Table], fun init_state_page/3), + Ps = case gen_server:call(observer, log_status) of + true -> [init_panel(Notebook, "Log", [Pid,Table], fun init_log_page/3)]; + false -> [] + end, wxFrame:connect(Frame, close_window), wxMenu:connect(Frame, command_menu_selected), @@ -78,7 +84,7 @@ init([Pid, ParentFrame, Parent]) -> pid=Pid, frame=Frame, notebook=Notebook, - pages=[ProcessPage,MessagePage,DictPage,StackPage,StatePage], + pages=[ProcessPage,MessagePage,DictPage,StackPage,StatePage|Ps], expand_table=Table }} catch error:{badrpc, _} -> @@ -327,6 +333,26 @@ fetch_state_info2(Pid, M) -> {badrpc,{'EXIT',{timeout, _}}} -> [] end. +init_log_page(Parent, Pid, Table) -> + Win = observer_lib:html_window(Parent), + Update = fun() -> + Fd = spawn_link(fun() -> io_server() end), + rpc:call(node(Pid), rb, rescan, [[{start_log, Fd}]]), + rpc:call(node(Pid), rb , grep, [local_pid_str(Pid)]), + Logs = io_get_data(Fd), + %% Replace remote local pid notation to global notation + Pref = global_pid_node_pref(Pid), + ExpPid = re:replace(Logs,"<0\.","<" ++ Pref ++ ".",[global, {return, list}]), + %% Try to keep same look by removing blanks at right of rewritten PID + NbBlanks = length(Pref) - 1, + Re = "(<" ++ Pref ++ "\.[^>]{1,}>)[ ]{"++ integer_to_list(NbBlanks) ++ "}", + Look = re:replace(ExpPid, Re, "\\1", [global, {return, list}]), + Html = observer_html_lib:expandable_term("SaslLog", Look, Table), + wxHtmlWindow:setPage(Win, Html) + end, + Update(), + {Win, Update}. + create_menus(MenuBar) -> Menus = [{"File", [#create_menu{id=?wxID_CLOSE, text="Close"}]}, {"View", [#create_menu{id=?REFRESH, text="Refresh\tCtrl-R"}]}], @@ -409,3 +435,55 @@ filter_monitor_info() -> Ms = proplists:get_value(monitors, Data), [Pid || {process, Pid} <- Ms] end. + +local_pid_str(Pid) -> + %% observer can observe remote nodes + %% There is no function to get the local + %% pid from the remote pid ... + %% So grep will fail to find remote pid in remote local log. + %% i.e. <4589.42.1> will not be found, but <0.42.1> will + %% Let's replace first integer by zero + "<0" ++ re:replace(pid_to_list(Pid),"\<([0-9]{1,})","",[{return, list}]). + +global_pid_node_pref(Pid) -> + %% Global PID node prefix : X of <X.Y.Z> + string:strip(string:sub_word(pid_to_list(Pid),1,$.),left,$<). + + +io_get_data(Pid) -> + Pid ! {self(), get_data_and_close}, + receive + {Pid, data, Data} -> lists:flatten(Data) + end. + +io_server() -> + io_server(#io{}). + +io_server(State) -> + receive + {io_request, From, ReplyAs, Request} -> + case io_request(Request,State) of + {Tag, Reply, NewState} when Tag =:= ok; Tag =:= error -> + From ! {io_reply, ReplyAs, Reply}, + io_server(NewState); + {stop, Reply, _NewState} -> + From ! {io_reply, ReplyAs, Reply}, + exit(Reply) + end; + {Pid, get_data_and_close} -> + Pid ! {self(), data, lists:reverse(State#io.rdata)}, + normal; + _Unknown -> + io:format("~p: Unknown msg: ~p ~n",[?LINE, _Unknown]), + io_server(State) + end. + +io_request({put_chars, _Encoding, Chars}, State = #io{rdata=Data}) -> + {ok, ok, State#io{rdata=[Chars|Data]}}; +io_request({put_chars, Encoding, Module, Function, Args}, State) -> + try io_request({put_chars, Encoding, apply(Module, Function, Args)}, State) + catch _:_ -> {error, {error,Function}, State} + end; +io_request(Req, State) -> + io:format("~p: Unknown req: ~p ~n",[?LINE, Req]), + State. diff --git a/lib/observer/src/observer_wx.erl b/lib/observer/src/observer_wx.erl index c86f5ea916..54c4092a78 100644 --- a/lib/observer/src/observer_wx.erl +++ b/lib/observer/src/observer_wx.erl @@ -37,6 +37,7 @@ -define(ID_CONNECT, 2). -define(ID_NOTEBOOK, 3). -define(ID_CDV, 4). +-define(ID_LOGVIEW, 5). -define(FIRST_NODES_MENU_ID, 1000). -define(LAST_NODES_MENU_ID, 2000). @@ -60,7 +61,8 @@ active_tab, node, nodes, - prev_node="" + prev_node="", + log = false }). start() -> @@ -215,14 +217,17 @@ handle_event(#wx{event=#wxNotebook{type=command_notebook_page_changing}}, {noreply, State#state{active_tab=Pid}} end; -handle_event(#wx{event = #wxClose{}}, State) -> - {stop, normal, State}; - handle_event(#wx{id = ?ID_CDV, event = #wxCommand{type = command_menu_selected}}, State) -> spawn(crashdump_viewer, start, []), {noreply, State}; -handle_event(#wx{id = ?wxID_EXIT, event = #wxCommand{type = command_menu_selected}}, State) -> +handle_event(#wx{event = #wxClose{}}, #state{log=LogOn} = State) -> + LogOn andalso rpc:block_call(State#state.node, rb, stop, []), + {stop, normal, State}; + +handle_event(#wx{id = ?wxID_EXIT, event = #wxCommand{type = command_menu_selected}}, + #state{log=LogOn} = State) -> + LogOn andalso rpc:block_call(State#state.node, rb, stop, []), {stop, normal, State}; handle_event(#wx{id = ?wxID_HELP, event = #wxCommand{type = command_menu_selected}}, State) -> @@ -300,12 +305,42 @@ handle_event(#wx{id = ?ID_PING, event = #wxCommand{type = command_menu_selected} end, {noreply, UpdState}; -handle_event(#wx{id = Id, event = #wxCommand{type = command_menu_selected}}, State) - when Id > ?FIRST_NODES_MENU_ID, Id < ?LAST_NODES_MENU_ID -> +handle_event(#wx{id = ?ID_LOGVIEW, event = #wxCommand{type = command_menu_selected}}, + #state{frame = Frame, log = PrevLog, node = Node} = State) -> + try + ok = ensure_sasl_started(Node), + ok = ensure_mf_h_handler_used(Node), + ok = ensure_rb_mode(Node, PrevLog), + case PrevLog of + false -> + rpc:block_call(Node, rb, start, []), + set_status("Observer - " ++ atom_to_list(Node) ++ " (rb_server started)"), + {noreply, State#state{log=true}}; + true -> + rpc:block_call(Node, rb, stop, []), + set_status("Observer - " ++ atom_to_list(Node) ++ " (rb_server stopped)"), + {noreply, State#state{log=false}} + end + catch + throw:Reason -> + create_txt_dialog(Frame, Reason, "Log view status", ?wxICON_ERROR), + {noreply, State} + end; - Node = lists:nth(Id - ?FIRST_NODES_MENU_ID, State#state.nodes), - UpdState = change_node_view(Node, State), - {noreply, UpdState}; +handle_event(#wx{id = Id, event = #wxCommand{type = command_menu_selected}}, + #state{nodes= Ns , node = PrevNode, log = PrevLog} = State) + when Id > ?FIRST_NODES_MENU_ID, Id < ?LAST_NODES_MENU_ID -> + Node = lists:nth(Id - ?FIRST_NODES_MENU_ID, Ns), + %% Close rb_server only if another node than current one selected + LState = case PrevLog of + true -> case Node == PrevNode of + false -> rpc:block_call(PrevNode, rb, stop, []), + State#state{log=false} ; + true -> State + end; + false -> State + end, + {noreply, change_node_view(Node, LState)}; handle_event(Event, State) -> Pid = get_active_pid(State), @@ -340,6 +375,9 @@ handle_call(stop, _, State = #state{frame = Frame}) -> wxFrame:destroy(Frame), {stop, normal, ok, State}; +handle_call(log_status, _From, State) -> + {reply, State#state.log, State}; + handle_call(_Msg, _From, State) -> {reply, ok, State}. @@ -422,8 +460,7 @@ return_to_localnode(Frame, Node) -> end. create_txt_dialog(Frame, Msg, Title, Style) -> - MD = wxMessageDialog:new(Frame, Msg, [{style, Style}]), - wxMessageDialog:setTitle(MD, Title), + MD = wxMessageDialog:new(Frame, Msg, [{style, Style}, {caption,Title}]), wxDialog:showModal(MD), wxDialog:destroy(MD). @@ -569,17 +606,19 @@ default_menus(NodesMenuItems) -> false -> {"Nodes", NodesMenuItems ++ [#create_menu{id = ?ID_CONNECT, text = "Enable distribution"}]} end, + LogMenu = {"Log", [#create_menu{id = ?ID_LOGVIEW, text = "Toggle log view"}]}, case os:type() =:= {unix, darwin} of false -> FileMenu = {"File", [CDV, Quit]}, HelpMenu = {"Help", [About,Help]}, - [FileMenu, NodeMenu, HelpMenu]; + [FileMenu, NodeMenu, LogMenu, HelpMenu]; true -> %% On Mac quit and about will be moved to the "default' place %% automagicly, so just add them to a menu that always exist. %% But not to the help menu for some reason - {Tag, Menus} = FileMenu, - [{Tag, Menus ++ [About]}, NodeMenu, {"&Help", [Help]}] + + {Tag, Menus} = NodeMenu, + [{Tag, Menus ++ [Quit,About]}, LogMenu, {"&Help", [Help]}] end. clean_menus(Menus, MenuBar) -> @@ -658,3 +697,59 @@ update_node_list(State = #state{menubar=MenuBar}) -> end, observer_lib:create_menu_item(Dist, NodeMenu, Index), State#state{nodes = Nodes}. + +ensure_sasl_started(Node) -> + %% is sasl started ? + Apps = rpc:block_call(Node, application, which_applications, []), + case lists:keyfind(sasl, 1, Apps) of + false -> throw("Error: sasl application not started."), + error; + {sasl, _, _} -> ok + end. + +ensure_mf_h_handler_used(Node) -> + %% is log_mf_h used ? + Handlers = rpc:block_call(Node, gen_event, which_handlers, [error_logger]), + case lists:any(fun(L)-> L == log_mf_h end, Handlers) of + false -> throw("Error: log_mf_h handler not used in sasl."), + error; + true -> ok + end. + +ensure_rb_mode(Node, PrevLog) -> + ok = ensure_rb_module_loaded(Node), + ok = is_rb_compatible(Node), + ok = is_rb_server_running(Node, PrevLog), + ok. + + +ensure_rb_module_loaded(Node) -> + %% Need to ensure that module is loaded in order to detect exported + %% functions on interactive nodes + case rpc:block_call(Node, code, ensure_loaded, [rb]) of + {badrpc, Reason} -> + throw("Error: badrpc - " ++ io_lib:format("~tp",[Reason])); + {error, Reason} -> + throw("Error: rb module load error - " ++ io_lib:format("~tp",[Reason])); + {module,rb} -> + ok + end. + +is_rb_compatible(Node) -> + %% Simply test that rb:log_list/0 is exported + case rpc:block_call(Node, erlang, function_exported, [rb, log_list, 0]) of + false -> throw("Error: Node's Erlang release must be at least R16B02."); + true -> ok + end. + +is_rb_server_running(Node, LogState) -> + %% If already started, somebody else may use it. + %% We can not use it too, as far log file would be overriden. Not fair. + case rpc:block_call(Node, erlang, whereis, [rb_server]) of + Pid when is_pid(Pid), (LogState == false) -> + throw("Error: rb_server is already started and maybe used by someone."); + Pid when is_pid(Pid) -> + ok; + undefined -> + ok + end. diff --git a/lib/observer/test/observer_SUITE.erl b/lib/observer/test/observer_SUITE.erl index 5cf719acb1..c69fdf4bdf 100644 --- a/lib/observer/test/observer_SUITE.erl +++ b/lib/observer/test/observer_SUITE.erl @@ -22,6 +22,8 @@ -include_lib("wx/include/wx.hrl"). -include_lib("observer/src/observer_tv.hrl"). +-define(ID_LOGVIEW, 5). + %% Test server specific exports -export([all/0, suite/0,groups/0]). -export([init_per_testcase/2, end_per_testcase/2, @@ -44,8 +46,9 @@ all() -> groups() -> [{gui, [], - [basic - , process_win, table_win + [basic, + process_win, + table_win ] }]. @@ -107,7 +110,7 @@ appup_file(Config) when is_list(Config) -> basic(suite) -> []; basic(doc) -> [""]; basic(Config) when is_list(Config) -> - timer:send_after(100, "foobar"), %% Otherwise the timer sever gets added to procs + timer:send_after(100, "foobar"), %% Otherwise the timer server gets added to procs ProcsBefore = processes(), NumProcsBefore = length(ProcsBefore), @@ -126,7 +129,7 @@ basic(Config) when is_list(Config) -> timer:sleep(200), ok = wxNotebook:advanceSelection(Notebook) end, - %% Just verify that we can toogle trough all pages + %% Just verify that we can toggle through all pages [_|_] = [Check(N, false) || N <- lists:seq(1, Count)], %% Cause it to resize Frame = get_top_level_parent(Notebook), @@ -214,10 +217,27 @@ test_page(Title, Window) -> process_win(suite) -> []; process_win(doc) -> [""]; process_win(Config) when is_list(Config) -> + % Stop SASL if already started + SaslStart = case whereis(sasl_sup) of + undefined -> false; + _ -> application:stop(sasl), + true + end, + % Define custom sasl and log_mf_h app vars + Privdir=?config(priv_dir,Config), + application:set_env(sasl, sasl_error_logger, tty), + application:set_env(sasl, error_logger_mf_dir, Privdir), + application:set_env(sasl, error_logger_mf_maxbytes, 1000), + application:set_env(sasl, error_logger_mf_maxfiles, 5), + application:start(sasl), ok = observer:start(), ObserverNB = setup_whitebox_testing(), Parent = get_top_level_parent(ObserverNB), - Frame = observer_procinfo:start(self(), Parent, self()), + % Activate log view + whereis(observer) ! #wx{id = ?ID_LOGVIEW, event = #wxCommand{type = command_menu_selected}}, + timer:sleep(1000), + % Process window tests (use sasl_sup for a non empty Log tab) + Frame = observer_procinfo:start(whereis(sasl_sup), Parent, self()), PIPid = wx_object:get_pid(Frame), PIPid ! {get_debug_info, self()}, Notebook = receive {procinfo_debug, NB} -> NB end, @@ -229,6 +249,11 @@ process_win(Config) when is_list(Config) -> [_|_] = [Check(N) || N <- lists:seq(1, Count)], PIPid ! #wx{event=#wxClose{type=close_window}}, observer:stop(), + application:stop(sasl), + case SaslStart of + true -> application:start(sasl); + false -> ok + end, ok. table_win(suite) -> []; diff --git a/lib/sasl/test/release_handler_SUITE.erl b/lib/sasl/test/release_handler_SUITE.erl index bd7414fbb4..b7c5f34f58 100644 --- a/lib/sasl/test/release_handler_SUITE.erl +++ b/lib/sasl/test/release_handler_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011-2014. All Rights Reserved. +%% Copyright Ericsson AB 2011-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -1802,11 +1802,17 @@ upgrade_gg(cleanup,Config) -> %%%----------------------------------------------------------------- %%% OTP-10463, Bug - release_handler could not handle regexp in appup %%% files. -otp_10463_upgrade_script_regexp(_Config) -> - %% Assuming that kernel always has a regexp in it's appup - KernelVsn = vsn(kernel,current), - {ok,KernelVsn,_} = - release_handler:upgrade_script(kernel,code:lib_dir(kernel)), +otp_10463_upgrade_script_regexp(Config) -> + DataDir = ?config(data_dir,Config), + code:add_path(filename:join([DataDir,regexp_appup,app1,ebin])), + application:start(app1), + {ok,"1.1",_} = release_handler:upgrade_script(app1,code:lib_dir(app1)), + ok. + +otp_10463_upgrade_script_regexp(cleanup,Config) -> + DataDir = ?config(data_dir,Config), + application:stop(app1), + code:del_path(filename:join([DataDir,regexp_appup,app1,ebin])), ok. no_dot_erlang(Conf) -> diff --git a/lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.app b/lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.app new file mode 100644 index 0000000000..ba6d09cd42 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.app @@ -0,0 +1,29 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%% This is an -*- erlang -*- file. +%% +{application, app1, + [ + {description, "Test that release_handler can read appup with regexp"}, + {vsn, "1.1"}, + {modules, []}, + {registered, []}, + {applications, []} + ] +}. diff --git a/lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.appup b/lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.appup new file mode 100644 index 0000000000..9c657232d0 --- /dev/null +++ b/lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.appup @@ -0,0 +1,23 @@ +%% -*- erlang -*- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +{"1.1", + %% Up from + [{<<"1(\\.[0-9]+)*">>,[{restart_application,app1}]}], + %% Down to + [{<<"1(\\.[0-9]+)*">>,[{restart_application,app1}]}] +}. diff --git a/lib/ssl/src/ssl.appup.src b/lib/ssl/src/ssl.appup.src index 7986722094..1476336039 100644 --- a/lib/ssl/src/ssl.appup.src +++ b/lib/ssl/src/ssl.appup.src @@ -1,14 +1,14 @@ %% -*- erlang -*- {"%VSN%", [ - {<<"5\\.3\\.[1-7]($|\\..*)">>, [{restart_application, ssl}]}, - {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, + {<<"6\\..*">>, [{restart_application, ssl}]}, + {<<"5\\..*">>, [{restart_application, ssl}]}, {<<"4\\..*">>, [{restart_application, ssl}]}, {<<"3\\..*">>, [{restart_application, ssl}]} ], [ - {<<"5\\.3\\.[1-7]($|\\..*)">>, [{restart_application, ssl}]}, - {<<"5\\.[0-2]($|\\..*)">>, [{restart_application, ssl}]}, + {<<"6\\..*">>, [{restart_application, ssl}]}, + {<<"5\\..*">>, [{restart_application, ssl}]}, {<<"4\\..*">>, [{restart_application, ssl}]}, {<<"3\\..*">>, [{restart_application, ssl}]} ] diff --git a/lib/ssl/test/Makefile b/lib/ssl/test/Makefile index 90a6c3aa42..09cc5981e7 100644 --- a/lib/ssl/test/Makefile +++ b/lib/ssl/test/Makefile @@ -51,6 +51,7 @@ MODULES = \ ssl_session_cache_SUITE \ ssl_to_openssl_SUITE \ ssl_ECC_SUITE \ + ssl_upgrade_SUITE\ make_certs\ erl_make_certs diff --git a/lib/ssl/test/ssl_pem_cache_SUITE.erl b/lib/ssl/test/ssl_pem_cache_SUITE.erl index 36c2a17a50..843079e2fe 100644 --- a/lib/ssl/test/ssl_pem_cache_SUITE.erl +++ b/lib/ssl/test/ssl_pem_cache_SUITE.erl @@ -121,7 +121,7 @@ get_pem_cache() -> end. later()-> - DateTime = calendar:now_to_local_time(erlang:timestamp()), + DateTime = calendar:now_to_local_time(os:timestamp()), Gregorian = calendar:datetime_to_gregorian_seconds(DateTime), calendar:gregorian_seconds_to_datetime(Gregorian + (2 * ?CLEANUP_INTERVAL)). diff --git a/lib/ssl/test/ssl_upgrade_SUITE.erl b/lib/ssl/test/ssl_upgrade_SUITE.erl new file mode 100644 index 0000000000..6a6a1b4a7a --- /dev/null +++ b/lib/ssl/test/ssl_upgrade_SUITE.erl @@ -0,0 +1,162 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2014-2015. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/.2 +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +-module(ssl_upgrade_SUITE). + +%% Note: This directive should only be used in test suites. +-compile(export_all). + +-include_lib("common_test/include/ct.hrl"). + +-record(state, { + config, + server, + client, + soft + }). + +all() -> + [ + minor_upgrade, + major_upgrade + ]. + +init_per_suite(Config0) -> + catch crypto:stop(), + try crypto:start() of + ok -> + case ct_release_test:init(Config0) of + {skip, Reason} -> + {skip, Reason}; + Config -> + Result = + (catch make_certs:all(?config(data_dir, Config), + ?config(priv_dir, Config))), + ct:log("Make certs ~p~n", [Result]), + ssl_test_lib:cert_options(Config) + end + catch _:_ -> + {skip, "Crypto did not start"} + end. + +end_per_suite(Config) -> + ct_release_test:cleanup(Config), + crypto:stop(). + +init_per_testcase(_TestCase, Config) -> + Config. +end_per_testcase(_TestCase, Config) -> + Config. + +major_upgrade(Config) when is_list(Config) -> + ct_release_test:upgrade(ssl, major,{?MODULE, #state{config = Config}}, Config). + +minor_upgrade(Config) when is_list(Config) -> + ct_release_test:upgrade(ssl, minor,{?MODULE, #state{config = Config}}, Config). + +upgrade_init(CTData, #state{config = Config} = State) -> + {ok, {_, _, Up, _Down}} = ct_release_test:get_appup(CTData, ssl), + ct:pal("Up: ~p", [Up]), + Soft = is_soft(Up), %% It is symmetrical, if upgrade is soft so is downgrade + case Soft of + true -> + {Server, Client} = soft_start_connection(Config), + State#state{server = Server, client = Client, + soft = Soft}; + false -> + State#state{soft = Soft} + end. + +upgrade_upgraded(_, #state{soft = false, config = Config} = State) -> + {Server, Client} = restart_start_connection(Config), + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client), + State; + +upgrade_upgraded(_, #state{server = Server0, client = Client0, + config = Config, soft = true} = State) -> + Server0 ! changed_version, + Client0 ! changed_version, + ssl_test_lib:check_result(Server0, ok, Client0, ok), + ssl_test_lib:close(Server0), + ssl_test_lib:close(Client0), + {Server, Client} = soft_start_connection(Config), + State#state{server = Server, client = Client}. + +upgrade_downgraded(_, #state{soft = false, config = Config} = State) -> + {Server, Client} = restart_start_connection(Config), + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client), + State; + +upgrade_downgraded(_, #state{server = Server, client = Client, soft = true} = State) -> + Server ! changed_version, + Client ! changed_version, + ssl_test_lib:check_result(Server, ok, Client, ok), + ssl_test_lib:close(Server), + ssl_test_lib:close(Client), + State. + +use_connection(Socket) -> + ssl_test_lib:send_recv_result_active(Socket), + receive + changed_version -> + ssl_test_lib:send_recv_result_active(Socket) + end. + +soft_start_connection(Config) -> + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {?MODULE, use_connection, []}}, + {options, ServerOpts}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {?MODULE, use_connection, []}}, + {options, ClientOpts}]), + {Server, Client}. + +restart_start_connection(Config) -> + ClientOpts = ?config(client_verification_opts, Config), + ServerOpts = ?config(server_verification_opts, Config), + {ClientNode, ServerNode, Hostname} = ssl_test_lib:run_where(Config), + Server = ssl_test_lib:start_server([{node, ServerNode}, {port, 0}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ServerOpts}]), + + Port = ssl_test_lib:inet_port(Server), + Client = ssl_test_lib:start_client([{node, ClientNode}, {port, Port}, + {host, Hostname}, + {from, self()}, + {mfa, {ssl_test_lib, send_recv_result_active, []}}, + {options, ClientOpts}]), + {Server, Client}. + +is_soft([{restart_application, ssl}]) -> + false; +is_soft(_) -> + true. + diff --git a/lib/ssl/vsn.mk b/lib/ssl/vsn.mk index bda974da0e..171147adf2 100644 --- a/lib/ssl/vsn.mk +++ b/lib/ssl/vsn.mk @@ -1 +1 @@ -SSL_VSN = 5.3.8 +SSL_VSN = 7.0 diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl index c2256c0cf9..9860adf04d 100644 --- a/lib/stdlib/src/c.erl +++ b/lib/stdlib/src/c.erl @@ -509,9 +509,12 @@ m(M) -> {exports,E} = lists:keyfind(exports, 1, L), Time = get_compile_time(L), COpts = get_compile_options(L), - format("Module ~w compiled: ",[M]), print_time(Time), - format("Compiler options: ~p~n", [COpts]), + format("Module: ~w~n", [M]), + print_md5(L), + format("Compiled: "), + print_time(Time), print_object_file(M), + format("Compiler options: ~p~n", [COpts]), format("Exports: ~n",[]), print_exports(keysort(1, E)). print_object_file(Mod) -> @@ -522,6 +525,12 @@ print_object_file(Mod) -> ignore end. +print_md5(L) -> + case lists:keyfind(md5, 1, L) of + {md5,<<MD5:128>>} -> io:format("MD5: ~.16b~n",[MD5]); + _ -> ok + end. + get_compile_time(L) -> case get_compile_info(L, time) of {ok,Val} -> Val; @@ -569,8 +578,8 @@ split_print_exports([{F1, A1}|T1], [{F2, A2} | T2]) -> split_print_exports([], []) -> ok. print_time({Year,Month,Day,Hour,Min,_Secs}) -> - format("Date: ~s ~w ~w, ", [month(Month),Day,Year]), - format("Time: ~.2.0w.~.2.0w~n", [Hour,Min]); + format("~s ~w ~w, ", [month(Month),Day,Year]), + format("~.2.0w:~.2.0w~n", [Hour,Min]); print_time(notime) -> format("No compile time info available~n",[]). diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl index 0ace87ef5c..4a338798d0 100644 --- a/lib/stdlib/src/otp_internal.erl +++ b/lib/stdlib/src/otp_internal.erl @@ -578,6 +578,19 @@ obsolete_1(asn1rt, utf8_binary_to_list, 1) -> obsolete_1(asn1rt, utf8_list_to_binary, 1) -> {deprecated,{unicode,characters_to_binary,1}}; +%% Added in OTP 18. +obsolete_1(core_lib, get_anno, 1) -> + {deprecated,{cerl,get_ann,1}}; +obsolete_1(core_lib, set_anno, 2) -> + {deprecated,{cerl,set_ann,2}}; +obsolete_1(core_lib, is_literal, 1) -> + {deprecated,{cerl,is_literal,1}}; +obsolete_1(core_lib, is_literal_list, 1) -> + {deprecated,"deprecated; use lists:all(fun cerl:is_literal/1, L)" + " instead"}; +obsolete_1(core_lib, literal_value, 1) -> + {deprecated,{core_lib,concrete,1}}; + obsolete_1(_, _, _) -> no. diff --git a/lib/stdlib/src/string.erl b/lib/stdlib/src/string.erl index f9b083a56d..f6903d1c3d 100644 --- a/lib/stdlib/src/string.erl +++ b/lib/stdlib/src/string.erl @@ -221,23 +221,47 @@ substr2([_|String], S) -> substr2(String, S-1). Tokens :: [Token :: nonempty_string()]. tokens(S, Seps) -> - tokens1(S, Seps, []). + case Seps of + [] -> + case S of + [] -> []; + [_|_] -> [S] + end; + [C] -> + tokens_single_1(reverse(S), C, []); + [_|_] -> + tokens_multiple_1(reverse(S), Seps, []) + end. -tokens1([C|S], Seps, Toks) -> +tokens_single_1([Sep|S], Sep, Toks) -> + tokens_single_1(S, Sep, Toks); +tokens_single_1([C|S], Sep, Toks) -> + tokens_single_2(S, Sep, Toks, [C]); +tokens_single_1([], _, Toks) -> + Toks. + +tokens_single_2([Sep|S], Sep, Toks, Tok) -> + tokens_single_1(S, Sep, [Tok|Toks]); +tokens_single_2([C|S], Sep, Toks, Tok) -> + tokens_single_2(S, Sep, Toks, [C|Tok]); +tokens_single_2([], _Sep, Toks, Tok) -> + [Tok|Toks]. + +tokens_multiple_1([C|S], Seps, Toks) -> case member(C, Seps) of - true -> tokens1(S, Seps, Toks); - false -> tokens2(S, Seps, Toks, [C]) + true -> tokens_multiple_1(S, Seps, Toks); + false -> tokens_multiple_2(S, Seps, Toks, [C]) end; -tokens1([], _Seps, Toks) -> - reverse(Toks). +tokens_multiple_1([], _Seps, Toks) -> + Toks. -tokens2([C|S], Seps, Toks, Cs) -> +tokens_multiple_2([C|S], Seps, Toks, Tok) -> case member(C, Seps) of - true -> tokens1(S, Seps, [reverse(Cs)|Toks]); - false -> tokens2(S, Seps, Toks, [C|Cs]) + true -> tokens_multiple_1(S, Seps, [Tok|Toks]); + false -> tokens_multiple_2(S, Seps, Toks, [C|Tok]) end; -tokens2([], _Seps, Toks, Cs) -> - reverse([reverse(Cs)|Toks]). +tokens_multiple_2([], _Seps, Toks, Tok) -> + [Tok|Toks]. -spec chars(Character, Number) -> String when Character :: char(), diff --git a/lib/stdlib/test/stdlib_SUITE.erl b/lib/stdlib/test/stdlib_SUITE.erl index 6669a21b9c..206eb4fd74 100644 --- a/lib/stdlib/test/stdlib_SUITE.erl +++ b/lib/stdlib/test/stdlib_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2014. All Rights Reserved. +%% Copyright Ericsson AB 1997-2015. All Rights Reserved. %% %% The contents of this file are subject to the Erlang Public License, %% Version 1.1, (the "License"); you may not use this file except in @@ -172,9 +172,16 @@ major_upgrade(Config) -> %% Version numbers are checked by ct_release_test, so there is nothing %% more to check here... -upgrade_init(State) -> +upgrade_init(CtData,State) -> + {ok,{FromVsn,ToVsn}} = ct_release_test:get_app_vsns(CtData,stdlib), + case ct_release_test:get_appup(CtData,stdlib) of + {ok,{FromVsn,ToVsn,[restart_new_emulator],[restart_new_emulator]}} -> + io:format("Upgrade/downgrade ~p <--> ~p",[FromVsn,ToVsn]); + {error,{vsn_not_found,_}} when FromVsn==ToVsn -> + io:format("No upgrade test for stdlib, same version") + end, State. -upgrade_upgraded(State) -> +upgrade_upgraded(_CtData,State) -> State. -upgrade_downgraded(State) -> +upgrade_downgraded(_CtData,State) -> State. diff --git a/lib/stdlib/test/string_SUITE.erl b/lib/stdlib/test/string_SUITE.erl index fccd1bef95..a55c710d50 100644 --- a/lib/stdlib/test/string_SUITE.erl +++ b/lib/stdlib/test/string_SUITE.erl @@ -217,21 +217,39 @@ substr(Config) when is_list(Config) -> ?line {'EXIT',_} = (catch string:substr("1234", "1")), ok. -tokens(suite) -> - []; -tokens(doc) -> - []; tokens(Config) when is_list(Config) -> - ?line [] = string:tokens("",""), - ?line [] = string:tokens("abc","abc"), - ?line ["abc"] = string:tokens("abc", ""), - ?line ["1","2 34","4","5"] = string:tokens("1,2 34,4;5", ";,"), - %% invalid arg type - ?line {'EXIT',_} = (catch string:tokens('x,y', ",")), + [] = string:tokens("",""), + [] = string:tokens("abc","abc"), + ["abc"] = string:tokens("abc", ""), + ["1","2 34","45","5","6","7"] = do_tokens("1,2 34,45;5,;6;,7", ";,"), + %% invalid arg type - ?line {'EXIT',_} = (catch string:tokens("x,y", ',')), + {'EXIT',_} = (catch string:tokens('x,y', ",")), + {'EXIT',_} = (catch string:tokens("x,y", ',')), ok. +do_tokens(S0, Sep0) -> + [H|T] = Sep0, + S = [replace_sep(C, T, H) || C <- S0], + Sep = [H], + io:format("~p ~p\n", [S0,Sep0]), + io:format("~p ~p\n", [S,Sep]), + + Res = string:tokens(S0, Sep0), + Res = string:tokens(Sep0++S0, Sep0), + Res = string:tokens(S0++Sep0, Sep0), + + Res = string:tokens(S, Sep), + Res = string:tokens(Sep++S, Sep), + Res = string:tokens(S++Sep, Sep), + + Res. + +replace_sep(C, Seps, New) -> + case lists:member(C, Seps) of + true -> New; + false -> C + end. chars(suite) -> []; |