aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/common_test/src/ct_cover.erl127
-rw-r--r--lib/common_test/src/ct_release_test.erl137
-rw-r--r--lib/common_test/test/ct_cover_SUITE.erl79
-rw-r--r--lib/common_test/test/ct_cover_SUITE_data/cover_SUITE.erl4
-rw-r--r--lib/compiler/src/Makefile2
-rw-r--r--lib/compiler/src/cerl.erl17
-rw-r--r--lib/compiler/src/compiler.app.src1
-rw-r--r--lib/compiler/src/core_lib.erl50
-rw-r--r--lib/compiler/src/core_lint.erl2
-rw-r--r--lib/compiler/src/core_parse.yrl12
-rw-r--r--lib/compiler/src/core_pp.erl6
-rw-r--r--lib/compiler/src/sys_core_fold.erl723
-rw-r--r--lib/compiler/src/sys_core_fold_lists.erl386
-rw-r--r--lib/compiler/src/sys_core_inline.erl8
-rw-r--r--lib/compiler/src/v3_core.erl101
-rw-r--r--lib/compiler/src/v3_kernel.erl16
-rw-r--r--lib/compiler/test/andor_SUITE.erl8
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl11
-rw-r--r--lib/compiler/test/record_SUITE.erl8
-rw-r--r--lib/compiler/test/test_lib.erl2
-rw-r--r--lib/dialyzer/test/small_SUITE_data/src/maps_redef2.erl23
-rw-r--r--lib/eldap/src/eldap.erl2
-rw-r--r--lib/mnesia/doc/src/Mnesia_chap5.xmlsrc1
-rw-r--r--lib/mnesia/doc/src/mnesia.xml16
-rw-r--r--lib/mnesia/src/mnesia_controller.erl29
-rw-r--r--lib/mnesia/src/mnesia_dumper.erl60
-rw-r--r--lib/mnesia/src/mnesia_loader.erl7
-rw-r--r--lib/mnesia/src/mnesia_monitor.erl4
-rw-r--r--lib/sasl/test/release_handler_SUITE.erl18
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.app29
-rw-r--r--lib/sasl/test/release_handler_SUITE_data/regexp_appup/app1/ebin/app1.appup23
-rw-r--r--lib/ssl/src/ssl.appup.src8
-rw-r--r--lib/ssl/test/Makefile1
-rw-r--r--lib/ssl/test/ssl_pem_cache_SUITE.erl2
-rw-r--r--lib/ssl/test/ssl_upgrade_SUITE.erl162
-rw-r--r--lib/ssl/vsn.mk2
-rw-r--r--lib/stdlib/src/c.erl17
-rw-r--r--lib/stdlib/src/otp_internal.erl13
-rw-r--r--lib/stdlib/src/string.erl46
-rw-r--r--lib/stdlib/test/stdlib_SUITE.erl15
-rw-r--r--lib/stdlib/test/string_SUITE.erl40
41 files changed, 1399 insertions, 819 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/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/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/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/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 c23c2cb226..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>
@@ -3017,6 +3019,12 @@ raise(Name, Amount) ->
totally unpredictable.</p>
</item>
<item>
+ <p><c>-mnesia dump_disc_copies_at_startup true | false</c>.
+ If set to false, this disables the dumping of <c>disc_copies</c>
+ tables during startup while tables are being loaded. The default
+ is true.</p>
+ </item>
+ <item>
<p><c>-mnesia dump_log_load_regulation true | false</c>.
Controls if the log dumps should be performed as fast as
possible or if the dumper should do its own load
diff --git a/lib/mnesia/src/mnesia_controller.erl b/lib/mnesia/src/mnesia_controller.erl
index 5a9bae54da..aa72de7594 100644
--- a/lib/mnesia/src/mnesia_controller.erl
+++ b/lib/mnesia/src/mnesia_controller.erl
@@ -51,6 +51,7 @@
force_load_table/1,
async_dump_log/1,
sync_dump_log/1,
+ snapshot_dcd/1,
connect_nodes/1,
connect_nodes/2,
wait_for_schema_commit_lock/0,
@@ -139,7 +140,8 @@ max_loaders() ->
-record(block_controller, {owner}).
-record(dump_log, {initiated_by,
- opt_reply_to
+ opt_reply_to,
+ operation = dump_log
}).
-record(net_load, {table,
@@ -201,6 +203,15 @@ async_dump_log(InitBy) ->
?SERVER_NAME ! {async_dump_log, InitBy},
ok.
+snapshot_dcd(Tables) when is_list(Tables) ->
+ case [T || T <- Tables,
+ mnesia_lib:storage_type_at_node(node(), T) =/= disc_copies] of
+ [] ->
+ call({snapshot_dcd, Tables});
+ BadTabs ->
+ {error, {not_disc_copies, BadTabs}}
+ end.
+
%% Wait for tables to be active
%% If needed, we will wait for Mnesia to start
%% If Mnesia stops, we will wait for Mnesia to restart
@@ -646,6 +657,15 @@ handle_call({sync_dump_log, InitBy}, From, State) ->
State2 = add_worker(Worker, State),
noreply(State2);
+handle_call({snapshot_dcd, Tables}, From, State) ->
+ Worker = #dump_log{initiated_by = user,
+ opt_reply_to = From,
+ operation = fun() ->
+ mnesia_dumper:snapshot_dcd(Tables)
+ end},
+ State2 = add_worker(Worker, State),
+ noreply(State2);
+
handle_call(wait_for_schema_commit_lock, From, State) ->
Worker = #schema_commit_lock{owner = From},
State2 = add_worker(Worker, State),
@@ -2089,7 +2109,12 @@ start_remote_sender(Node, Tab, Receiver, Storage) ->
dump_and_reply(ReplyTo, Worker) ->
%% No trap_exit, die intentionally instead
- Res = mnesia_dumper:opt_dump_log(Worker#dump_log.initiated_by),
+ Res = case Worker#dump_log.operation of
+ dump_log ->
+ mnesia_dumper:opt_dump_log(Worker#dump_log.initiated_by);
+ F when is_function(F, 0) ->
+ F()
+ end,
ReplyTo ! #dumper_done{worker_pid = self(),
worker_res = Res},
unlink(ReplyTo),
diff --git a/lib/mnesia/src/mnesia_dumper.erl b/lib/mnesia/src/mnesia_dumper.erl
index 14665797a0..509b765dee 100644
--- a/lib/mnesia/src/mnesia_dumper.erl
+++ b/lib/mnesia/src/mnesia_dumper.erl
@@ -34,11 +34,13 @@
-export([
get_log_writes/0,
incr_log_writes/0,
+ needs_dump_ets/1,
raw_dump_table/2,
raw_named_dump_table/2,
start_regulator/0,
opt_dump_log/1,
- update/3
+ update/3,
+ snapshot_dcd/1
]).
%% Internal stuff
@@ -99,6 +101,19 @@ opt_dump_log(InitBy) ->
end,
perform_dump(InitBy, Reg).
+snapshot_dcd(Tables) ->
+ lists:foreach(
+ fun(Tab) ->
+ case mnesia_lib:storage_type_at_node(node(), Tab) of
+ disc_copies ->
+ mnesia_log:ets2dcd(Tab);
+ _ ->
+ %% Storage type was checked before queueing the op, though
+ skip
+ end
+ end, Tables),
+ dumped.
+
%% Scan for decisions
perform_dump(InitBy, Regulator) when InitBy == scan_decisions ->
?eval_debug_fun({?MODULE, perform_dump}, [InitBy]),
@@ -981,28 +996,10 @@ open_files(_Tab, _Storage, _UpdateInPlace, _InitBy) ->
false.
open_disc_copies(Tab, InitBy) ->
- DclF = mnesia_lib:tab2dcl(Tab),
- DumpEts =
- case file:read_file_info(DclF) of
- {error, enoent} ->
- false;
- {ok, DclInfo} ->
- DcdF = mnesia_lib:tab2dcd(Tab),
- case file:read_file_info(DcdF) of
- {error, Reason} ->
- mnesia_lib:dbg_out("File ~p info_error ~p ~n",
- [DcdF, Reason]),
- true;
- {ok, DcdInfo} ->
- Mul = case ?catch_val(dc_dump_limit) of
- {'EXIT', _} -> ?DumpToEtsMultiplier;
- Val -> Val
- end,
- DcdInfo#file_info.size =< (DclInfo#file_info.size * Mul)
- end
- end,
+ DumpEts = needs_dump_ets(Tab),
if
DumpEts == false; InitBy == startup ->
+ DclF = mnesia_lib:tab2dcl(Tab),
mnesia_log:open_log({?MODULE,Tab},
mnesia_log:dcl_log_header(),
DclF,
@@ -1017,6 +1014,27 @@ open_disc_copies(Tab, InitBy) ->
false
end.
+needs_dump_ets(Tab) ->
+ DclF = mnesia_lib:tab2dcl(Tab),
+ case file:read_file_info(DclF) of
+ {error, enoent} ->
+ false;
+ {ok, DclInfo} ->
+ DcdF = mnesia_lib:tab2dcd(Tab),
+ case file:read_file_info(DcdF) of
+ {error, Reason} ->
+ mnesia_lib:dbg_out("File ~p info_error ~p ~n",
+ [DcdF, Reason]),
+ true;
+ {ok, DcdInfo} ->
+ Mul = case ?catch_val(dc_dump_limit) of
+ {'EXIT', _} -> ?DumpToEtsMultiplier;
+ Val -> Val
+ end,
+ DcdInfo#file_info.size =< (DclInfo#file_info.size * Mul)
+ end
+ end.
+
%% Always opens the dcl file for writing overriding already_dumped
%% mechanismen, used for schema transactions.
open_dcl(Tab) ->
diff --git a/lib/mnesia/src/mnesia_loader.erl b/lib/mnesia/src/mnesia_loader.erl
index 530317bcdd..cbb3d7e430 100644
--- a/lib/mnesia/src/mnesia_loader.erl
+++ b/lib/mnesia/src/mnesia_loader.erl
@@ -69,9 +69,10 @@ do_get_disc_copy2(Tab, Reason, Storage, Type) when Storage == disc_copies ->
ignore;
_ ->
mnesia_monitor:mktab(Tab, Args),
- Count = mnesia_log:dcd2ets(Tab, Repair),
- case ets:info(Tab, size) of
- X when X < Count * 4 ->
+ _Count = mnesia_log:dcd2ets(Tab, Repair),
+ case mnesia_monitor:get_env(dump_disc_copies_at_startup)
+ andalso mnesia_dumper:needs_dump_ets(Tab) of
+ true ->
ok = mnesia_log:ets2dcd(Tab);
_ ->
ignore
diff --git a/lib/mnesia/src/mnesia_monitor.erl b/lib/mnesia/src/mnesia_monitor.erl
index 6fc1a394a6..a0e0e630ec 100644
--- a/lib/mnesia/src/mnesia_monitor.erl
+++ b/lib/mnesia/src/mnesia_monitor.erl
@@ -664,6 +664,7 @@ env() ->
backup_module,
debug,
dir,
+ dump_disc_copies_at_startup,
dump_log_load_regulation,
dump_log_time_threshold,
dump_log_update_in_place,
@@ -692,6 +693,8 @@ default_env(debug) ->
default_env(dir) ->
Name = lists:concat(["Mnesia.", node()]),
filename:absname(Name);
+default_env(dump_disc_copies_at_startup) ->
+ true;
default_env(dump_log_load_regulation) ->
false;
default_env(dump_log_time_threshold) ->
@@ -741,6 +744,7 @@ do_check_type(debug, trace) -> trace;
do_check_type(debug, true) -> debug;
do_check_type(debug, verbose) -> verbose;
do_check_type(dir, V) -> filename:absname(V);
+do_check_type(dump_disc_copies_at_startup, B) -> bool(B);
do_check_type(dump_log_load_regulation, B) -> bool(B);
do_check_type(dump_log_time_threshold, I) when is_integer(I), I > 0 -> I;
do_check_type(dump_log_update_in_place, B) -> bool(B);
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) ->
[];