Merge pull request #1477 from bjorng/bjorn/compiler/fix-native-from-core/ERL-417

Correct handling of module name in compile:forms/1,2

OTP-14408

3 files changed, 77 insertions, 7 deletions

diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index b3c8c42af7..c6e61d543e 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -467,8 +467,10 @@ mpf(Ms) ->
 passes(Type, Opts) ->
     {Ext,Passes0} = passes_1(Opts),
     Passes1 = case Type of
-		  file -> Passes0;
-		  forms -> tl(Passes0)
+		  file ->
+                      Passes0;
+		  forms ->
+                      fix_first_pass(Passes0)
 	      end,
     Passes = select_passes(Passes1, Opts),
 
@@ -505,6 +507,22 @@ pass(from_beam) ->
     {".beam",[?pass(read_beam_file)|binary_passes()]};
 pass(_) -> none.
 
+%% For compilation from forms, replace the first pass with a pass
+%% that retrieves the module name. The module name is needed for
+%% proper diagnostics and for compilation to native code.
+
+fix_first_pass([{parse_core,_}|Passes]) ->
+    [?pass(get_module_name_from_core)|Passes];
+fix_first_pass([{beam_consult_asm,_}|Passes]) ->
+    [?pass(get_module_name_from_asm)|Passes];
+fix_first_pass([{read_beam_file,_}|Passes]) ->
+    [?pass(get_module_name_from_beam)|Passes];
+fix_first_pass([_|Passes]) ->
+    %% When compiling from abstract code, the module name
+    %% will be set after running the v3_core pass.
+    Passes.
+
+
 %% select_passes([Command], Opts) -> [{Name,Function}]
 %%  Interpret the lists of commands to return a pure list of passes.
 %%
@@ -836,6 +854,12 @@ beam_consult_asm(_Code, St) ->
 	    {error,St#compile{errors=St#compile.errors ++ Es}}
     end.
 
+get_module_name_from_asm({Mod,_,_,_,_}=Asm, St) ->
+    {ok,Asm,St#compile{module=Mod}};
+get_module_name_from_asm(Asm, St) ->
+    %% Invalid Beam assembly code. Let it crash in a later pass.
+    {ok,Asm,St}.
+
 read_beam_file(_Code, St) ->
     case file:read_file(St#compile.ifile) of
 	{ok,Beam} ->
@@ -853,6 +877,16 @@ read_beam_file(_Code, St) ->
 	    {error,St#compile{errors=St#compile.errors ++ Es}}
     end.
 
+get_module_name_from_beam(Beam, St) ->
+    case beam_lib:info(Beam) of
+        {error,beam_lib,Error} ->
+	    Es = [{"((forms))",[{none,beam_lib,Error}]}],
+            {error,St#compile{errors=St#compile.errors ++ Es}};
+        Info ->
+            {module,Mod} = keyfind(module, 1, Info),
+            {ok,Beam,St#compile{module=Mod}}
+    end.
+
 no_native_compilation(BeamFile, #compile{options=Opts0}) ->
     case beam_lib:chunks(BeamFile, ["CInf"]) of
 	{ok,{_,[{"CInf",Term0}]}} ->
@@ -940,6 +974,16 @@ parse_core(_Code, St) ->
 	    {error,St#compile{errors=St#compile.errors ++ Es}}
     end.
 
+get_module_name_from_core(Core, St) ->
+    try
+        Mod = cerl:concrete(cerl:module_name(Core)),
+        {ok,Core,St#compile{module=Mod}}
+    catch
+        _:_ ->
+            %% Invalid Core Erlang code. Let it crash in a later pass.
+            {ok,Core,St}
+    end.
+
 compile_options([{attribute,_L,compile,C}|Fs]) when is_list(C) ->
     C ++ compile_options(Fs);
 compile_options([{attribute,_L,compile,C}|Fs]) ->
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index ca85eef688..75bfbf68cc 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -446,7 +446,7 @@ do_bin_opt(Mod, Asm) ->
 do_bin_opt(Transform, Mod, Asm0) ->
     Asm = Transform(Asm0),
     case compile:forms(Asm, [from_asm,no_postopt,return]) of
-	{ok,[],Code,_Warnings} when is_binary(Code) ->
+	{ok,Mod,Code,_Warnings} when is_binary(Code) ->
 	    ok;
 	{error,Errors0,_} ->
 	    %% beam_validator must return errors, not simply crash,
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index f5e904a50a..4e2753ba5f 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -163,6 +163,24 @@ forms_2(Config) when is_list(Config) ->
 	    ok
     end,
 
+    {ok,simple,Core} = compile:forms(SimpleCode, [to_core0,binary]),
+    forms_compile_and_load(Core, [from_core]),
+    forms_compile_and_load(Core, [from_core,native]),
+
+    {ok,simple,Asm} = compile:forms(SimpleCode, [to_asm,binary]),
+    forms_compile_and_load(Asm, [from_asm]),
+    forms_compile_and_load(Asm, [from_asm,native]),
+
+    {ok,simple,Beam} = compile:forms(SimpleCode, []),
+    forms_compile_and_load(Beam, [from_beam]),
+    forms_compile_and_load(Beam, [from_beam,native]),
+
+    %% Cover the error handling code.
+    error = compile:forms(bad_core, [from_core,report]),
+    error = compile:forms(bad_asm, [from_asm,report]),
+    error = compile:forms(<<"bad_beam">>, [from_beam,report]),
+    error = compile:forms(<<"bad_beam">>, [from_beam,native,report]),
+
     ok.
 
 
@@ -180,6 +198,14 @@ forms_load_code(Mod, Src, Bin) ->
 
     SourceOption.
 
+forms_compile_and_load(Code, Opts) ->
+    Mod = simple,
+    {ok,Mod,Bin} = compile:forms(Code, Opts),
+    {module,Mod} = code:load_binary(Mod, "ignore", Bin),
+    _ = Mod:module_info(),
+    true = code:delete(simple),
+    false = code:purge(simple),
+    ok.
 
 module_mismatch(Config) when is_list(Config) ->
     DataDir = proplists:get_value(data_dir, Config),
@@ -835,7 +861,7 @@ do_core_pp_1(M, A, Outdir) ->
     ok = file:delete(CoreFile),
 
     %% Compile as usual (including optimizations).
-    compile_forms(Core, [clint,from_core,binary]),
+    compile_forms(M, Core, [clint,from_core,binary]),
 
     %% Don't optimize to test that we are not dependent
     %% on the Core Erlang optmimization passes.
@@ -844,13 +870,13 @@ do_core_pp_1(M, A, Outdir) ->
     %% records; if sys_core_fold was run it would fix
     %% that; if sys_core_fold was not run v3_kernel would
     %% crash.)
-    compile_forms(Core, [clint,from_core,no_copt,binary]),
+    compile_forms(M, Core, [clint,from_core,no_copt,binary]),
 
     ok.
 
-compile_forms(Forms, Opts) ->
+compile_forms(Mod, Forms, Opts) ->
     case compile:forms(Forms, [report_errors|Opts]) of
-	{ok,[],_} ->  ok;
+	{ok,Mod,_} ->  ok;
 	Other -> throw({error,Other})
     end.