Merge branch 'siri/reltool/unicode/OTP-10781'

* siri/reltool/unicode/OTP-10781:
  [reltool] Improve stability of tests
  [reltool] Make escript test work with hipe and smp
  [reltool] Add unicode test
  [reltool] Change ~s to ~ts and ~p to ~tp when appropriate
  [reltool] Add unicode option to re:compile to allow unicode filenames
  [reltool] Fix reconstruct source from debug_info to handle unicode
  [reltool] Honour encoding in reltool_utils:prim_consult

1 files changed, 137 insertions, 28 deletions

diff --git a/lib/reltool/test/reltool_server_SUITE.erl b/lib/reltool/test/reltool_server_SUITE.erl
index 8d71865508..23338d9ecd 100644
--- a/lib/reltool/test/reltool_server_SUITE.erl
+++ b/lib/reltool/test/reltool_server_SUITE.erl
@@ -1,7 +1,8 @@
+%% -*- coding: utf-8 -*-
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2009-2012. All Rights Reserved.
+%% Copyright Ericsson AB 2009-2013. 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
@@ -42,6 +43,11 @@ end_per_suite(Config) ->
     reltool_test_lib:end_per_suite(Config).
 
 init_per_testcase(Func,Config) ->
+    Node = full_node_name(?NODE_NAME),
+    case net_adm:ping(Node) of
+	pong -> stop_node(Node);
+	pang -> ok
+    end,
     reltool_test_lib:init_per_testcase(Func,Config).
 end_per_testcase(Func,Config) -> 
     reltool_test_lib:end_per_testcase(Func,Config).
@@ -60,6 +66,7 @@ all() ->
      create_script,
      create_script_sort,
      create_target,
+     create_target_unicode,
      create_embedded,
      create_standalone,
      create_standalone_beam,
@@ -750,6 +757,72 @@ create_target(_Config) ->
     ok.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% Generate target system
+
+create_target_unicode(Config) ->
+    DataDir = ?config(data_dir,Config),
+
+    %% If file name translation mode is unicode, then use unicode
+    %% characters release name (which will be used as file name for
+    %% .rel, .script and .boot)
+    RelNamePrefix =
+	case file:native_name_encoding() of
+	    utf8 ->
+		"Unicode test αβ";
+	    latin1 ->
+		"Unicode test"
+	end,
+
+    %% Configure the server
+    RelName1 = RelNamePrefix,
+    RelName2 = RelNamePrefix ++ " with SASL",
+    RelVsn = "1.0",
+    Sys =
+        {sys,
+         [
+          {root_dir, code:root_dir()},
+          {lib_dirs, [filename:join(DataDir,"unicode")]},
+	  {app_file, all},
+	  {incl_cond,exclude},
+	  {boot_rel, RelName2},
+          {rel, RelName1, RelVsn, [stdlib, kernel, ua]},
+          {rel, RelName2, RelVsn, [sasl, stdlib, kernel, ua]},
+          {app, kernel, [{incl_cond, include}]},
+          {app, stdlib, [{incl_cond, include}]},
+          {app, sasl, [{incl_cond, include}]},
+          {app, ua, [{incl_cond, include}]}
+         ]},
+
+    %% Generate target file
+    TargetDir = filename:join([?WORK_DIR, "target_unicode"]),
+    ?m(ok, reltool_utils:recursive_delete(TargetDir)),
+    ?m(ok, file:make_dir(TargetDir)),
+    ?log("SPEC: ~p\n", [reltool:get_target_spec([{config, Sys}])]),
+    ok = ?m(ok, reltool:create_target([{config, Sys}], TargetDir)),
+
+    %% Start a node
+    Erl = filename:join([TargetDir, "bin", "erl"]),
+    {ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl)),
+
+
+    %% The ua application has a unicode string as description - check
+    %% that it is translated correctly.
+    wait_for_app(Node,ua,50),
+    Apps = rpc:call(Node,application,which_applications,[]),
+    ?m({ua,"Application for testing unicode in reltool - αβ","1.0"},
+       lists:keyfind(ua,1,Apps)),
+
+    %% Check that the release name is correct (really only
+    %% insteresting if file name translation mode is utf8)
+    [{RelName,_,_,_}] =
+	?msym([{_,_,_,_}],rpc:call(Node,release_handler,which_releases,[])),
+    ?m(true,lists:prefix(RelNamePrefix,RelName)),
+
+    ?msym(ok, stop_node(Node)),
+
+    ok.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% Generate embedded target system
 
 create_embedded(_Config) ->
@@ -810,11 +883,11 @@ create_standalone(_Config) ->
     ?msym(ok, stop_node(Node)),
     
     %% Execute escript
-    Expected =  iolist_to_binary(["Root dir: ", RootDir, "\n"
-				  "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n",
-				  "Smp: false\n",
-				  "ExitCode:0"]),
-    io:format("Expected: ~s\n", [Expected]),
+    Expected =  s2b(["Root dir: ", RootDir, "\n"
+		     "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n",
+		     "Emuarg: [\"emuvalue\"]\n",
+		     "ExitCode:0"]),
+    io:format("Expected: ~ts\n", [Expected]),
     ?m(Expected, run(BinDir, EscriptName, "-arg1 arg2 arg3")),
     
     ok.
@@ -857,10 +930,11 @@ create_standalone_beam(Config) ->
     ?msym(ok, stop_node(Node)),
 
     %% Execute escript
-    Expected =  iolist_to_binary(["Root dir: ", RootDir, "\n"
-				  "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n",
-				  "ExitCode:0"]),
-    io:format("Expected: ~s\n", [Expected]),
+    Expected =  s2b(["Module: mymod\n"
+		     "Root dir: ", RootDir, "\n"
+		     "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n",
+		     "ExitCode:0"]),
+    io:format("Expected: ~ts\n", [Expected]),
     ?m(Expected, run(BinDir, EscriptName, "-arg1 arg2 arg3")),
 
     ok.
@@ -909,10 +983,11 @@ create_standalone_app(Config) ->
     ?msym(ok, stop_node(Node)),
 
     %% Execute escript
-    Expected =  iolist_to_binary(["Root dir: ", RootDir, "\n"
-				  "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n",
-				  "ExitCode:0"]),
-    io:format("Expected: ~s\n", [Expected]),
+    Expected =  s2b(["Module: mymod\n"
+		     "Root dir: ", RootDir, "\n"
+		     "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n",
+		     "ExitCode:0"]),
+    io:format("Expected: ~ts\n", [Expected]),
     ?m(Expected, run(BinDir, EscriptName, "-arg1 arg2 arg3")),
 
     ok.
@@ -995,19 +1070,20 @@ create_multiple_standalone(Config) ->
     ?msym(ok, stop_node(Node)),
 
     %% Execute escript1
-    Expected1 =  iolist_to_binary(["Root dir: ", RootDir, "\n"
-				  "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n",
-				  "Smp: false\n",
-				  "ExitCode:0"]),
-    io:format("Expected1: ~s\n", [Expected1]),
+    Expected1 =  s2b(["Root dir: ", RootDir, "\n"
+		      "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n",
+		      "Emuarg: [\"emuvalue\"]\n",
+		      "ExitCode:0"]),
+    io:format("Expected1: ~ts\n", [Expected1]),
     ?m(Expected1, run(BinDir, EscriptName1, "-arg1 arg2 arg3")),
 
 
     %% Execute escript2
-    Expected2 =  iolist_to_binary(["Root dir: ", RootDir, "\n"
-				  "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n",
-				  "ExitCode:0"]),
-    io:format("Expected2: ~s\n", [Expected2]),
+    Expected2 =  s2b(["Module: mymod\n"
+		      "Root dir: ", RootDir, "\n"
+		      "Script args: [\"-arg1\",\"arg2\",\"arg3\"]\n",
+		      "ExitCode:0"]),
+    io:format("Expected2: ~ts\n", [Expected2]),
     ?m(Expected2, run(BinDir, EscriptName2, "-arg1 arg2 arg3")),
 
     ok.
@@ -1094,6 +1170,7 @@ create_slim(Config) ->
 	    "-sasl", "releases_dir", EscapedQuote++TargetRelDir++EscapedQuote],
     {ok, Node} = ?msym({ok, _}, start_node(?NODE_NAME, Erl, Args)),
     ?msym(RootDir, rpc:call(Node, code, root_dir, [])),
+    wait_for_app(Node,sasl,50),
     ?msym([{RelName,RelVsn,_,permanent}],
 	  rpc:call(Node,release_handler,which_releases,[])),
     ?msym(ok, stop_node(Node)),
@@ -2420,7 +2497,7 @@ start_node(Name, ErlPath) ->
 start_node(Name, ErlPath, Args0) ->
     FullName = full_node_name(Name),
     Args = mk_node_args(Name, Args0),
-    io:format("Starting node ~p: ~s~n",
+    io:format("Starting node ~p: ~ts~n",
 	      [FullName, lists:flatten([[X," "] || X <- [ErlPath|Args]])]),
     %io:format("open_port({spawn_executable, ~p}, [{args,~p}])~n",[ErlPath,Args]),
     case open_port({spawn_executable, ErlPath}, [{args,Args}]) of
@@ -2436,9 +2513,19 @@ start_node(Name, ErlPath, Args0) ->
     end.
 
 stop_node(Node) ->
-    monitor_node(Node, true),
-    spawn(Node, fun () -> halt() end),
-    receive {nodedown, Node} -> ok end.
+    rpc:call(Node,erlang,halt,[]),
+    wait_for_node_down(Node,50).
+
+wait_for_node_down(Node,0) ->
+    test_server:fail({cant_terminate_node,Node});
+wait_for_node_down(Node,N) ->
+    case net_adm:ping(Node) of
+	pong ->
+	    timer:sleep(1000),
+	    wait_for_node_down(Node,N-1);
+	pang ->
+	    ok
+    end.
 
 mk_node_args(Name, Args) ->
     Pa = filename:dirname(code:which(?MODULE)),
@@ -2485,6 +2572,22 @@ wait_for_process(Node, Name, N) when is_integer(N), N > 0 ->
 	    ok
     end.
 
+wait_for_app(_Node, Name, 0) ->
+    {error, Name};
+wait_for_app(Node, Name, N) when is_integer(N), N > 0 ->
+    case rpc:call(Node,application,which_applications,[]) of
+	{badrpc,Reason} ->
+	    test_server:fail({failed_to_get_applications,Reason});
+	Apps ->
+	    case lists:member(Name,Apps) of
+		false ->
+		    timer:sleep(1000),
+		    wait_for_app(Node, Name, N-1);
+		true ->
+		    ok
+	    end
+    end.
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% Run escript
 
@@ -2513,7 +2616,7 @@ do_run(Dir, Cmd) ->
     Res = get_data(Port, []),
     receive
         {Port,{exit_status,ExitCode}} ->
-            iolist_to_binary([Res,"ExitCode:"++integer_to_list(ExitCode)])
+            s2b([Res,"ExitCode:"++integer_to_list(ExitCode)])
     end.
 
 get_data(Port, SoFar) ->
@@ -2537,3 +2640,9 @@ expected_output([], _) ->
     [];
 expected_output(Bin, _) when is_binary(Bin) -> 
     Bin.
+
+%% Convert the given list to a binary with the same encoding as the
+%% file name translation mode
+s2b(List) ->
+    Enc = file:native_name_encoding(),
+    unicode:characters_to_binary(List,Enc,Enc).