Merge branch 'rc/robustify-module_info/OTP-12820'

* rc/robustify-module_info/OTP-12820:
  erts: Add test for module_info on purged modules
  erts: Remove ?line macros from module_info_SUITE
  Fix segfault in module_info for deleted modules

3 files changed, 140 insertions, 149 deletions

diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c
index 0d40201934..41ce1659d4 100644
--- a/erts/emulator/beam/beam_load.c
+++ b/erts/emulator/beam/beam_load.c
@@ -525,13 +525,16 @@ static void new_literal_patch(LoaderState* stp, int pos);
 static void new_string_patch(LoaderState* stp, int pos);
 static Uint new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size);
 static int genopargcompare(GenOpArg* a, GenOpArg* b);
-static Eterm exported_from_module(Process* p, Eterm mod);
-static Eterm functions_in_module(Process* p, Eterm mod);
-static Eterm attributes_for_module(Process* p, Eterm mod);
-static Eterm compilation_info_for_module(Process* p, Eterm mod);
-static Eterm md5_of_module(Process* p, Eterm mod);
-static Eterm has_native(Process* p, Eterm mod);
-static Eterm native_addresses(Process* p, Eterm mod);
+static Eterm get_module_info(Process* p, ErtsCodeIndex code_ix,
+                             BeamInstr* code, Eterm module, Eterm what);
+static Eterm exported_from_module(Process* p, ErtsCodeIndex code_ix,
+                                  Eterm mod);
+static Eterm functions_in_module(Process* p, BeamInstr* code);
+static Eterm attributes_for_module(Process* p, BeamInstr* code);
+static Eterm compilation_info_for_module(Process* p, BeamInstr* code);
+static Eterm md5_of_module(Process* p, BeamInstr* code);
+static Eterm has_native(BeamInstr* code);
+static Eterm native_addresses(Process* p, BeamInstr* code);
 int patch_funentries(Eterm Patchlist);
 int patch(Eterm Addresses, Uint fe);
 static int safe_mul(UWord a, UWord b, UWord* resp);
@@ -5389,6 +5392,9 @@ new_literal(LoaderState* stp, Eterm** hpp, Uint heap_size)
 Eterm
 erts_module_info_0(Process* p, Eterm module)
 {
+    Module* modp;
+    ErtsCodeIndex code_ix = erts_active_code_ix();
+    BeamInstr* code;
     Eterm *hp;
     Eterm list = NIL;
     Eterm tup;
@@ -5397,12 +5403,18 @@ erts_module_info_0(Process* p, Eterm module)
 	return THE_NON_VALUE;
     }
 
-    if (erts_get_module(module, erts_active_code_ix()) == NULL) {
+    modp = erts_get_module(module, code_ix);
+    if (modp == NULL) {
 	return THE_NON_VALUE;
     }
 
+    code = modp->curr.code;
+    if (code == NULL) {
+        return THE_NON_VALUE;
+    }
+
 #define BUILD_INFO(What) \
-    tup = erts_module_info_1(p, module, What); \
+    tup = get_module_info(p, code_ix, code, module, What); \
     hp = HAlloc(p, 5); \
     tup = TUPLE2(hp, What, tup); \
     hp += 3; \
@@ -5423,22 +5435,47 @@ erts_module_info_0(Process* p, Eterm module)
 Eterm
 erts_module_info_1(Process* p, Eterm module, Eterm what)
 {
+    Module* modp;
+    ErtsCodeIndex code_ix = erts_active_code_ix();
+    BeamInstr* code;
+
+    if (is_not_atom(module)) {
+        return THE_NON_VALUE;
+    }
+
+    modp = erts_get_module(module, code_ix);
+    if (modp == NULL) {
+        return THE_NON_VALUE;
+    }
+
+    code = modp->curr.code;
+    if (code == NULL) {
+        return THE_NON_VALUE;
+    }
+
+    return get_module_info(p, code_ix, code, module, what);
+}
+
+static Eterm
+get_module_info(Process* p, ErtsCodeIndex code_ix, BeamInstr* code,
+                Eterm module, Eterm what)
+{
     if (what == am_module) {
 	return module;
     } else if (what == am_md5) {
-	return md5_of_module(p, module);
+	return md5_of_module(p, code);
     } else if (what == am_exports) {
-	return exported_from_module(p, module);
+	return exported_from_module(p, code_ix, module);
     } else if (what == am_functions) {
-	return functions_in_module(p, module);
+	return functions_in_module(p, code);
     } else if (what == am_attributes) {
-	return attributes_for_module(p, module);
+	return attributes_for_module(p, code);
     } else if (what == am_compile) {
-	return compilation_info_for_module(p, module);
+	return compilation_info_for_module(p, code);
     } else if (what == am_native_addresses) {
-	return native_addresses(p, module);
+	return native_addresses(p, code);
     } else if (what == am_native) {
-	return has_native(p, module);
+	return has_native(code);
     }
     return THE_NON_VALUE;
 }
@@ -5446,16 +5483,12 @@ erts_module_info_1(Process* p, Eterm module, Eterm what)
 /*
  * Builds a list of all functions in the given module:
  *     [{Name, Arity},...]
- *
- * Returns a tagged term, or 0 on error.
  */
 
 Eterm
 functions_in_module(Process* p, /* Process whose heap to use. */
-		     Eterm mod) /* Tagged atom for module. */
+		    BeamInstr* code)
 {
-    Module* modp;
-    BeamInstr* code;
     int i;
     Uint num_functions;
     Uint need;
@@ -5463,15 +5496,6 @@ functions_in_module(Process* p, /* Process whose heap to use. */
     Eterm* hp_end;
     Eterm result = NIL;
 
-    if (is_not_atom(mod)) {
-	return THE_NON_VALUE;
-    }
-
-    modp = erts_get_module(mod, erts_active_code_ix());
-    if (modp == NULL) {
-	return THE_NON_VALUE;
-    }
-    code = modp->curr.code;
     num_functions = code[MI_NUM_FUNCTIONS];
     need = 5*num_functions;
     hp = HAlloc(p, need);
@@ -5503,23 +5527,12 @@ functions_in_module(Process* p, /* Process whose heap to use. */
  */
 
 static Eterm
-has_native(Process* p, Eterm mod)
+has_native(BeamInstr *code)
 {
     Eterm result = am_false;
 #ifdef HIPE
-    Module* modp;
-
-    if (is_not_atom(mod)) {
-        return THE_NON_VALUE;
-    }
-
-    modp = erts_get_module(mod, erts_active_code_ix());
-    if (modp == NULL) {
-        return THE_NON_VALUE;
-    }
-
-    if (erts_is_module_native(modp->curr.code)) {
-      result = am_true;
+    if (erts_is_module_native(code)) {
+        result = am_true;
     }
 #endif
     return result;
@@ -5548,15 +5561,11 @@ erts_is_module_native(BeamInstr* code)
 /*
  * Builds a list of all functions including native addresses.
  *     [{Name,Arity,NativeAddress},...]
- *
- * Returns a tagged term, or 0 on error.
  */
 
 static Eterm
-native_addresses(Process* p, Eterm mod)
+native_addresses(Process* p, BeamInstr* code)
 {
-    Module* modp;
-    BeamInstr* code;
     int i;
     Eterm* hp;
     Uint num_functions;
@@ -5564,16 +5573,6 @@ native_addresses(Process* p, Eterm mod)
     Eterm* hp_end;
     Eterm result = NIL;
 
-    if (is_not_atom(mod)) {
-	return THE_NON_VALUE;
-    }
-
-    modp = erts_get_module(mod, erts_active_code_ix());
-    if (modp == NULL) {
-	return THE_NON_VALUE;
-    }
-
-    code = modp->curr.code;
     num_functions = code[MI_NUM_FUNCTIONS];
     need = (6+BIG_UINT_HEAP_SIZE)*num_functions;
     hp = HAlloc(p, need);
@@ -5600,25 +5599,18 @@ native_addresses(Process* p, Eterm mod)
 /*
  * Builds a list of all exported functions in the given module:
  *     [{Name, Arity},...]
- *
- * Returns a tagged term, or 0 on error.
  */
 
 Eterm
 exported_from_module(Process* p, /* Process whose heap to use. */
+                     ErtsCodeIndex code_ix,
 		     Eterm mod) /* Tagged atom for module. */
 {
     int i;
     Eterm* hp = NULL;
     Eterm* hend = NULL;
     Eterm result = NIL;
-    ErtsCodeIndex code_ix;
-
-    if (is_not_atom(mod)) {
-	return THE_NON_VALUE;
-    }
 
-    code_ix = erts_active_code_ix();
     for (i = 0; i < export_list_size(code_ix); i++) {
 	Export* ep = export_list(i,code_ix);
 	
@@ -5648,31 +5640,17 @@ exported_from_module(Process* p, /* Process whose heap to use. */
 
 /*
  * Returns a list of all attributes for the module.
- *
- * Returns a tagged term, or 0 on error.
  */
 
 Eterm
 attributes_for_module(Process* p, /* Process whose heap to use. */
-		      Eterm mod) /* Tagged atom for module. */
-
+                      BeamInstr* code)
 {
-    Module* modp;
-    BeamInstr* code;
     Eterm* hp;
     byte* ext;
     Eterm result = NIL;
     Eterm* end;
 
-    if (is_not_atom(mod)) {
-	return THE_NON_VALUE;
-    }
-
-    modp = erts_get_module(mod, erts_active_code_ix());
-    if (modp == NULL) {
-	return THE_NON_VALUE;
-    }
-    code = modp->curr.code;
     ext = (byte *) code[MI_ATTR_PTR];
     if (ext != NULL) {
 	hp = HAlloc(p, code[MI_ATTR_SIZE_ON_HEAP]);
@@ -5688,30 +5666,17 @@ attributes_for_module(Process* p, /* Process whose heap to use. */
 
 /*
  * Returns a list containing compilation information.
- *
- * Returns a tagged term, or 0 on error.
  */
 
 Eterm
 compilation_info_for_module(Process* p, /* Process whose heap to use. */
-			    Eterm mod) /* Tagged atom for module. */
+                            BeamInstr* code)
 {
-    Module* modp;
-    BeamInstr* code;
     Eterm* hp;
     byte* ext;
     Eterm result = NIL;
     Eterm* end;
 
-    if (is_not_atom(mod)) {
-	return THE_NON_VALUE;
-    }
-
-    modp = erts_get_module(mod, erts_active_code_ix());
-    if (modp == NULL) {
-	return THE_NON_VALUE;
-    }
-    code = modp->curr.code;
     ext = (byte *) code[MI_COMPILE_PTR];
     if (ext != NULL) {
 	hp = HAlloc(p, code[MI_COMPILE_SIZE_ON_HEAP]);
@@ -5727,33 +5692,13 @@ compilation_info_for_module(Process* p, /* Process whose heap to use. */
 
 /*
  * Returns the MD5 checksum for a module
- *
- * Returns a tagged term, or 0 on error.
  */
 
 Eterm
 md5_of_module(Process* p, /* Process whose heap to use. */
-              Eterm mod) /* Tagged atom for module. */
+              BeamInstr* code)
 {
-    Module* modp;
-    BeamInstr* code;
-    Eterm res = NIL;
-
-    if (is_not_atom(mod)) {
-	return THE_NON_VALUE;
-    }
-
-    modp = erts_get_module(mod, erts_active_code_ix());
-    if (modp == NULL) {
-	return THE_NON_VALUE;
-    }
-    code = modp->curr.code;
-    if (code[MI_MD5_PTR] != 0) {
-      res = new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE);
-    } else {
-      res = am_undefined;
-    }
-    return res;
+    return new_binary(p, (byte *) code[MI_MD5_PTR], MD5_SIZE);
 }
 
 /*
diff --git a/erts/emulator/test/module_info_SUITE.erl b/erts/emulator/test/module_info_SUITE.erl
index 1125cf3072..25ba6d1787 100644
--- a/erts/emulator/test/module_info_SUITE.erl
+++ b/erts/emulator/test/module_info_SUITE.erl
@@ -24,7 +24,7 @@
 -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, 
 	 init_per_group/2,end_per_group/2,
 	 init_per_testcase/2,end_per_testcase/2,
-	 exports/1,functions/1,native/1,info/1]).
+	 exports/1,functions/1,deleted/1,native/1,info/1]).
 
 %%-compile(native).
 
@@ -51,9 +51,8 @@ init_per_group(_GroupName, Config) ->
 end_per_group(_GroupName, Config) ->
     Config.
 
-
 modules() ->
-    [exports, functions, native, info].
+    [exports, functions, deleted, native, info].
 
 init_per_testcase(Func, Config) when is_atom(Func), is_list(Config) ->
     Dog = ?t:timetrap(?t:minutes(3)),
@@ -81,43 +80,66 @@ all_functions() ->
 
 %% Test that the list of exported functions from this module is correct.
 exports(Config) when is_list(Config) ->
-    ?line All = all_exported(),
-    ?line All = lists:sort(?MODULE:module_info(exports)),
-    ?line (catch ?MODULE:foo()),
-    ?line All = lists:sort(?MODULE:module_info(exports)),
+    All = all_exported(),
+    All = lists:sort(?MODULE:module_info(exports)),
+    (catch ?MODULE:foo()),
+    All = lists:sort(?MODULE:module_info(exports)),
     ok.
 
 %% Test that the list of exported functions from this module is correct.
 functions(Config) when is_list(Config) ->
-    ?line All = all_functions(),
-    ?line All = lists:sort(?MODULE:module_info(functions)),
+    All = all_functions(),
+    All = lists:sort(?MODULE:module_info(functions)),
+    ok.
+
+%% Test that deleted modules cause badarg
+deleted(Config) when is_list(Config) ->
+    Data = ?config(data_dir, Config),
+    File = filename:join(Data, "module_info_test"),
+    {ok,module_info_test,Code} = compile:file(File, [binary]),
+    {module,module_info_test} = erlang:load_module(module_info_test, Code),
+    17 = module_info_test:f(),
+    [_|_] = erlang:get_module_info(module_info_test, attributes),
+    [_|_] = erlang:get_module_info(module_info_test),
+
+    %% first delete it
+    true = erlang:delete_module(module_info_test),
+    {'EXIT',{undef, _}} = (catch module_info_test:f()),
+    {'EXIT',{badarg, _}} = (catch erlang:get_module_info(module_info_test,attributes)),
+    {'EXIT',{badarg, _}} = (catch erlang:get_module_info(module_info_test)),
+
+    %% then purge it
+    true = erlang:purge_module(module_info_test),
+    {'EXIT',{undef, _}} = (catch module_info_test:f()),
+    {'EXIT',{badarg, _}} = (catch erlang:get_module_info(module_info_test,attributes)),
+    {'EXIT',{badarg, _}} = (catch erlang:get_module_info(module_info_test)),
     ok.
 
 %% Test that the list of exported functions from this module is correct.
 %% Verify that module_info(native) works.
 native(Config) when is_list(Config) ->
-    ?line All = all_functions(),
-    ?line case ?MODULE:module_info(native_addresses) of
-	      [] ->
-                  ?line false = ?MODULE:module_info(native),
-		  {comment,"no native functions"};
-	      L ->
-                  ?line true = ?MODULE:module_info(native),
-		  %% Verify that all functions have unique addresses.
-		  ?line S0 = sofs:set(L, [{name,arity,addr}]),
-		  ?line S1 = sofs:projection({external,fun ?MODULE:native_proj/1}, S0),
-		  ?line S2 = sofs:relation_to_family(S1),
-		  ?line S3 = sofs:family_specification(fun ?MODULE:native_filter/1, S2),
-		  ?line 0 = sofs:no_elements(S3),
-		  ?line S4 = sofs:range(S1),
-
-		  %% Verify that the set of function with native addresses
-		  %% is a subset of all functions in the module.
-		  ?line AllSet = sofs:set(All, [{name,arity}]),
-		  ?line true = sofs:is_subset(S4, AllSet),
-		  
-		  {comment,integer_to_list(sofs:no_elements(S0))++" native functions"}
-	  end.
+    All = all_functions(),
+    case ?MODULE:module_info(native_addresses) of
+        [] ->
+            false = ?MODULE:module_info(native),
+            {comment,"no native functions"};
+        L ->
+            true = ?MODULE:module_info(native),
+            %% Verify that all functions have unique addresses.
+            S0 = sofs:set(L, [{name,arity,addr}]),
+            S1 = sofs:projection({external,fun ?MODULE:native_proj/1}, S0),
+            S2 = sofs:relation_to_family(S1),
+            S3 = sofs:family_specification(fun ?MODULE:native_filter/1, S2),
+            0 = sofs:no_elements(S3),
+            S4 = sofs:range(S1),
+
+            %% Verify that the set of function with native addresses
+            %% is a subset of all functions in the module.
+            AllSet = sofs:set(All, [{name,arity}]),
+            true = sofs:is_subset(S4, AllSet),
+
+            {comment,integer_to_list(sofs:no_elements(S0))++" native functions"}
+    end.
 
 native_proj({Name,Arity,Addr}) ->
     {Addr,{Name,Arity}}.
diff --git a/erts/emulator/test/module_info_SUITE_data/module_info_test.erl b/erts/emulator/test/module_info_SUITE_data/module_info_test.erl
new file mode 100644
index 0000000000..f045f38464
--- /dev/null
+++ b/erts/emulator/test/module_info_SUITE_data/module_info_test.erl
@@ -0,0 +1,24 @@
+%%
+%% %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%
+%%
+
+-module(module_info_test).
+-export([f/0]).
+
+f() ->
+    17.