File 2105-Add-code-module_status-1-and-modified_modules-0.patch of Package erlang
From 86fa667f9731c790d6575f31efa156c02cb7984b Mon Sep 17 00:00:00 2001
From: Richard Carlsson <richardc@klarna.com>
Date: Thu, 19 May 2016 20:29:45 +0200
Subject: [PATCH 5/7] Add code:module_status/1 and modified_modules/0
These functions use the MD5 beam/native checksum to determine whether the
code for a module has changed on disk and is a candidate for loading.
---
lib/kernel/doc/src/code.xml | 42 ++++++++++
lib/kernel/src/code.erl | 98 +++++++++++++++++++++-
lib/kernel/test/code_SUITE.erl | 180 +++++++++++++++++++++++++++++++++++++++++
3 files changed, 319 insertions(+), 1 deletion(-)
diff --git a/lib/kernel/doc/src/code.xml b/lib/kernel/doc/src/code.xml
index 3143cdc..f881fd7 100644
--- a/lib/kernel/doc/src/code.xml
+++ b/lib/kernel/doc/src/code.xml
@@ -899,6 +899,48 @@ rpc:call(Node, code, load_binary, [Module, Filename, Binary]),
</desc>
</func>
<func>
+ <name name="module_status" arity="1"/>
+ <fsummary>Return the status of the module in relation to object file on disk.</fsummary>
+ <desc>
+ <p>Returns:</p>
+ <taglist>
+ <tag><c>not_loaded</c></tag>
+ <item><p>If <c><anno>Module</anno></c> is not currently loaded.</p></item>
+ <tag><c>loaded</c></tag>
+ <item><p>If <c><anno>Module</anno></c> is loaded and the object file
+ exists and contains the same code.</p></item>
+ <tag><c>removed</c></tag>
+ <item><p>If <c><anno>Module</anno></c> is loaded but no
+ corresponding object file can be found in the code path.</p></item>
+ <tag><c>modified</c></tag>
+ <item><p>If <c><anno>Module</anno></c> is loaded but the object file
+ contains code with a different MD5 checksum.</p></item>
+ </taglist>
+ <p>Preloaded modules are always reported as <c>loaded</c>, without
+ inspecting the contents on disk. Cover compiled modules will always
+ be reported as <c>modified</c> if an object file exists, or as
+ <c>removed</c> otherwise. Modules whose load path is an empty string
+ (which is the convention for auto-generated code) will only be
+ reported as <c>loaded</c> or <c>not_loaded</c>.</p>
+ <p>For modules that have native code loaded (see
+ <seealso marker="#is_module_native/1"><c>is_module_native/1</c></seealso>),
+ the MD5 sum of the native code in the object file is used for the
+ comparison, if it exists; the Beam code in the file is ignored.
+ Reversely, for modules that do not currently have native code
+ loaded, any native code in the file will be ignored.</p>
+ <p>See also <seealso marker="#modified_modules/0"><c>modified_modules/0</c></seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="modified_modules" arity="0"/>
+ <fsummary>Return a list of all modules modified on disk.</fsummary>
+ <desc>
+ <p>Returns the list of all currently loaded modules for which
+ <seealso marker="#module_status/1"><c>module_status/1</c></seealso>
+ returns <c>modified</c>. See also <seealso marker="#all_loaded/0"><c>all_loaded/0</c></seealso>.</p>
+ </desc>
+ </func>
+ <func>
<name name="is_module_native" arity="1"/>
<fsummary>Test if a module has native code.</fsummary>
<desc>
diff --git a/lib/kernel/src/code.erl b/lib/kernel/src/code.erl
index 0ad0676..5a7ca49 100644
--- a/lib/kernel/src/code.erl
+++ b/lib/kernel/src/code.erl
@@ -70,7 +70,9 @@
where_is_file/2,
set_primary_archive/4,
clash/0,
- get_mode/0]).
+ module_status/1,
+ modified_modules/0,
+ get_mode/0]).
-deprecated({rehash,0,next_major_release}).
@@ -895,3 +897,97 @@ load_all_native_1([{Mod,BeamFilename}|T], ChunkTag) ->
load_all_native_1(T, ChunkTag);
load_all_native_1([], _) ->
ok.
+
+%% Returns the status of the module in relation to object file on disk.
+-spec module_status(Module :: module()) -> not_loaded | loaded | modified | removed.
+module_status(Module) ->
+ module_status(Module, code:get_path()).
+
+%% Note that we don't want to go via which/1, since it doesn't look at the
+%% disk contents at all if the module is already loaded.
+module_status(Module, PathFiles) ->
+ case code:is_loaded(Module) of
+ false -> not_loaded;
+ {file, preloaded} -> loaded;
+ {file, cover_compiled} ->
+ %% cover compilation loads directly to memory and does not
+ %% create a beam file, so report 'modified' if a file exists
+ case which(Module, PathFiles) of
+ non_existing -> removed;
+ _File -> modified
+ end;
+ {file, []} -> loaded; % no beam file - generated code
+ {file, OldFile} when is_list(OldFile) ->
+ %% we don't care whether or not the file is in the same location
+ %% as when last loaded, as long as it can be found in the path
+ case which(Module, PathFiles) of
+ non_existing -> removed;
+ Path ->
+ case module_changed_on_disk(Module, Path) of
+ true -> modified;
+ false -> loaded
+ end
+ end
+ end.
+
+%% Detects actual code changes only, e.g. to decide whether a module should
+%% be reloaded; does not care about file timestamps or compilation time
+module_changed_on_disk(Module, Path) ->
+ MD5 = erlang:get_module_info(Module, md5),
+ case erlang:system_info(hipe_architecture) of
+ undefined ->
+ %% straightforward, since native is not supported
+ MD5 =/= beam_file_md5(Path);
+ Architecture ->
+ case code:is_module_native(Module) of
+ true ->
+ %% MD5 is for native code, so we check only the native
+ %% code on disk, ignoring the beam code
+ MD5 =/= beam_file_native_md5(Path, Architecture);
+ _ ->
+ %% MD5 is for beam code, so check only the beam code on
+ %% disk, even if the file contains native code as well
+ MD5 =/= beam_file_md5(Path)
+ end
+ end.
+
+beam_file_md5(Path) ->
+ case beam_lib:md5(Path) of
+ {ok,{_Mod,MD5}} -> MD5;
+ _ -> undefined
+ end.
+
+beam_file_native_md5(Path, Architecture) ->
+ try
+ get_beam_chunk(Path, hipe_unified_loader:chunk_name(Architecture))
+ of
+ NativeCode when is_binary(NativeCode) ->
+ erlang:md5(NativeCode)
+ catch
+ _:_ -> undefined
+ end.
+
+get_beam_chunk(Path, Chunk) ->
+ {ok, {_, [{_, Bin}]}} = beam_lib:chunks(Path, [Chunk]),
+ Bin.
+
+%% Returns a list of all modules modified on disk.
+-spec modified_modules() -> [module()].
+modified_modules() ->
+ PathFiles = path_files(),
+ [M || {M, _} <- code:all_loaded(),
+ module_status(M, PathFiles) =:= modified].
+
+%% prefetch the directory contents of code path directories
+path_files() ->
+ path_files(code:get_path()).
+
+path_files([]) ->
+ [];
+path_files([Path|Tail]) ->
+ case erl_prim_loader:list_dir(Path) of
+ {ok, Files} ->
+ [{Path,Files} | path_files(Tail)];
+ _Error ->
+ path_files(Tail)
+ end.
diff --git a/lib/kernel/test/code_SUITE.erl b/lib/kernel/test/code_SUITE.erl
index 29b3f7c..4914ce9 100644
--- a/lib/kernel/test/code_SUITE.erl
+++ b/lib/kernel/test/code_SUITE.erl
@@ -38,6 +38,7 @@
on_load_purge/1, on_load_self_call/1, on_load_pending/1,
on_load_deleted/1,
big_boot_embedded/1,
+ module_status/1,
native_early_modules/1, get_mode/1,
normalized_paths/1]).
@@ -68,6 +69,7 @@ all() ->
on_load_binary, on_load_embedded, on_load_errors, on_load_update,
on_load_purge, on_load_self_call, on_load_pending,
on_load_deleted,
+ module_status,
big_boot_embedded, native_early_modules, get_mode, normalized_paths].
groups() ->
@@ -93,6 +95,11 @@ init_per_suite(Config) ->
end_per_suite(Config) ->
Config.
+-define(TESTMOD, test_dummy).
+-define(TESTMODSTR, "test_dummy").
+-define(TESTMODSRC, ?TESTMODSTR ".erl").
+-define(TESTMODOBJ, ?TESTMODSTR ".beam").
+
init_per_testcase(big_boot_embedded, Config) ->
case catch crypto:start() of
ok ->
@@ -104,6 +111,13 @@ init_per_testcase(_Func, Config) ->
P = code:get_path(),
[{code_path, P}|Config].
+end_per_testcase(module_status, Config) ->
+ code:purge(?TESTMOD),
+ code:delete(?TESTMOD),
+ code:purge(?TESTMOD),
+ file:delete(?TESTMODOBJ),
+ file:delete(?TESTMODSRC),
+ end_per_testcase(Config);
end_per_testcase(TC, Config) when TC == mult_lib_roots;
TC == big_boot_embedded ->
{ok, HostName} = inet:gethostname(),
@@ -1757,6 +1771,172 @@ do_normalized_paths([M|Ms]) ->
do_normalized_paths([]) ->
ok.
+%% Test that module_status/1 behaves as expected
+module_status(_Config) ->
+ %% basics
+ not_loaded = code:module_status(fubar), % nonexisting
+ {file, preloaded} = code:is_loaded(erlang),
+ loaded = code:module_status(erlang), % preloaded
+ loaded = code:module_status(?MODULE), % normal known loaded
+
+ non_existing = code:which(?TESTMOD), % verify dummy name not in path
+ code:purge(?TESTMOD), % ensure no previous version in memory
+ code:delete(?TESTMOD),
+ code:purge(?TESTMOD),
+
+ %% generated code is detected as such
+ {ok,?TESTMOD,Bin} = compile:forms(dummy_ast(), []),
+ {module,?TESTMOD} = code:load_binary(?TESTMOD,"",Bin), % no source file
+ ok = ?TESTMOD:f(),
+ "" = code:which(?TESTMOD), % verify empty string for source file
+ loaded = code:module_status(?TESTMOD),
+
+ %% deleting generated code
+ true = code:delete(?TESTMOD),
+ non_existing = code:which(?TESTMOD), % verify still not in path
+ not_loaded = code:module_status(?TESTMOD),
+
+ %% beam file exists but not loaded
+ make_source_file(<<"0">>),
+ compile_beam(0),
+ true = (non_existing =/= code:which(?TESTMOD)), % verify in path
+ not_loaded = code:module_status(?TESTMOD),
+
+ %% loading code from disk makes it loaded
+ load_code(),
+ loaded = code:module_status(?TESTMOD), % loaded
+
+ %% cover compiling a module
+ {ok,?TESTMOD} = cover:compile(?TESTMOD),
+ {file, cover_compiled} = code:is_loaded(?TESTMOD), % verify cover compiled
+ modified = code:module_status(?TESTMOD), % loaded cover code but file exists
+ remove_code(),
+ removed = code:module_status(?TESTMOD), % removed
+ compile_beam(0),
+ modified = code:module_status(?TESTMOD), % recreated
+ load_code(),
+ loaded = code:module_status(?TESTMOD), % loading removes cover status
+ code:purge(?TESTMOD),
+ true = code:delete(?TESTMOD),
+ not_loaded = code:module_status(?TESTMOD), % deleted
+
+ %% recompilation ignores timestamps, only md5 matters
+ load_code(),
+ compile_beam(1100),
+ loaded = code:module_status(?TESTMOD),
+
+ %% modifying module detects different md5
+ make_source_file(<<"1">>),
+ compile_beam(0),
+ modified = code:module_status(?TESTMOD),
+
+ %% loading the modified code from disk makes it loaded
+ load_code(),
+ loaded = code:module_status(?TESTMOD),
+
+ %% removing and recreating a module with same md5
+ remove_code(),
+ removed = code:module_status(?TESTMOD),
+ compile_beam(0),
+ loaded = code:module_status(?TESTMOD),
+
+ case erlang:system_info(hipe_architecture) of
+ undefined ->
+ %% no native support
+ ok;
+ _ ->
+ %% native chunk is ignored if beam code is already loaded
+ load_code(),
+ loaded = code:module_status(?TESTMOD),
+ false = has_native(?TESTMOD),
+ compile_native(0),
+ BeamMD5 = erlang:get_module_info(?TESTMOD, md5),
+ {ok,{?TESTMOD,BeamMD5}} = beam_lib:md5(?TESTMODOBJ), % beam md5 unchanged
+ loaded = code:module_status(?TESTMOD),
+
+ %% native code reported as loaded, though different md5 from beam
+ load_code(),
+ true = has_native(?TESTMOD),
+ NativeMD5 = erlang:get_module_info(?TESTMOD, md5),
+ true = (BeamMD5 =/= NativeMD5),
+ loaded = code:module_status(?TESTMOD),
+
+ %% recompilation ignores timestamps, only md5 matters
+ compile_native(1100), % later timestamp
+ loaded = code:module_status(?TESTMOD),
+
+ %% modifying native module detects different md5
+ make_source_file(<<"2">>),
+ compile_native(0),
+ modified = code:module_status(?TESTMOD),
+
+ %% loading the modified native code from disk makes it loaded
+ load_code(),
+ true = has_native(?TESTMOD),
+ NativeMD5_2 = erlang:get_module_info(?TESTMOD, md5),
+ true = (NativeMD5 =/= NativeMD5_2), % verify native md5 changed
+ {ok,{?TESTMOD,BeamMD5_2}} = beam_lib:md5(?TESTMODOBJ),
+ true = (BeamMD5_2 =/= NativeMD5_2), % verify md5 differs from beam
+ loaded = code:module_status(?TESTMOD),
+
+ %% removing and recreating a native module with same md5
+ remove_code(),
+ removed = code:module_status(?TESTMOD),
+ compile_native(0),
+ loaded = code:module_status(?TESTMOD),
+
+ %% purging/deleting native module
+ code:purge(?TESTMOD),
+ true = code:delete(?TESTMOD),
+ not_loaded = code:module_status(?TESTMOD)
+ end,
+ ok.
+
+compile_beam(Sleep) ->
+ compile(Sleep, []).
+
+compile_native(Sleep) ->
+ compile(Sleep, [native]).
+
+compile(Sleep, Opts) ->
+ timer:sleep(Sleep), % increment compilation timestamp
+ {ok,?TESTMOD} = compile:file(?TESTMODSRC, Opts).
+
+load_code() ->
+ code:purge(?TESTMOD),
+ {module,?TESTMOD} = code:load_file(?TESTMOD).
+
+remove_code() ->
+ ok = file:delete(?TESTMODOBJ).
+
+has_native(Module) ->
+ case erlang:get_module_info(Module, native_addresses) of
+ [] -> false;
+ [_|_] -> true
+ end.
+
+make_source_file(Body) ->
+ ok = file:write_file(?TESTMODSRC, dummy_source(Body)).
+
+dummy_source(Body) ->
+ [<<"-module(" ?TESTMODSTR ").\n"
+ "-export([f/0]).\n"
+ "f() -> ">>, Body, <<".\n">>].
+
+dummy_ast() ->
+ dummy_ast(?TESTMODSTR).
+
+dummy_ast(Mod) when is_atom(Mod) ->
+ dummy_ast(atom_to_list(Mod));
+dummy_ast(ModStr) ->
+ [scan_form("-module(" ++ ModStr ++ ")."),
+ scan_form("-export([f/0])."),
+ scan_form("f() -> ok.")].
+
+scan_form(String) ->
+ {ok,Ts,_} = erl_scan:string(String),
+ {ok,F} = erl_parse:parse_form(Ts),
+ F.
%%-----------------------------------------------------------------
%% error_logger handler.
--
2.10.2
