Merge tag 'OTP-20.0' into sverker/20/binary_to_atom-utf8-crash/ERL-474/OTP-14590

1 files changed, 133 insertions, 62 deletions

diff --git a/lib/common_test/src/ct_logs.erl b/lib/common_test/src/ct_logs.erl
index 53245c596a..ba7660fe6a 100644
--- a/lib/common_test/src/ct_logs.erl
+++ b/lib/common_test/src/ct_logs.erl
@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2003-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2003-2017. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -32,7 +32,7 @@
 -export([init/2, close/2, init_tc/1, end_tc/1]).
 -export([register_groupleader/2, unregister_groupleader/1]).
 -export([get_log_dir/0, get_log_dir/1]).
--export([log/3, start_log/1, cont_log/2, end_log/0]).
+-export([log/3, start_log/1, cont_log/2, cont_log_no_timestamp/2, end_log/0]).
 -export([set_stylesheet/2, clear_stylesheet/1]).
 -export([add_external_logs/1, add_link/3]).
 -export([make_last_run_index/0]).
@@ -41,12 +41,13 @@
 -export([xhtml/2, locate_priv_file/1, make_relative/1]).
 -export([insert_javascript/1]).
 -export([uri/1]).
+-export([parse_keep_logs/1]).
 
 %% Logging stuff directly from testcase
 -export([tc_log/3, tc_log/4, tc_log/5, tc_log/6,
 	 tc_log_async/3, tc_log_async/5,
-	 tc_print/3, tc_print/4,
-	 tc_pal/3, tc_pal/4, ct_log/3,
+	 tc_print/3, tc_print/4, tc_print/5,
+	 tc_pal/3, tc_pal/4, tc_pal/5, ct_log/3,
 	 basic_html/0]).
 
 %% Simulate logger process for use without ct environment running
@@ -138,7 +139,7 @@ close(Info, StartDir) ->
     LogCacheBin = 
 	case make_last_run_index() of
 	    {error, Reason} ->  % log server not responding
-		io:format("Warning! ct_logs not responding: ~p~n", [Reason]),
+		io:format("Warning! ct_logs not responding: ~tp~n", [Reason]),
 		undefined;
 	    LCB ->
 		LCB
@@ -174,7 +175,7 @@ close(Info, StartDir) ->
 		ok ->
 		    ok;
 		Error ->
-		    io:format("Warning! Cleanup failed: ~p~n", [Error])
+		    io:format("Warning! Cleanup failed: ~tp~n", [Error])
 	    end,
 	    _ = make_all_suites_index(stop),
 	    make_all_runs_index(stop),
@@ -373,6 +374,20 @@ cont_log(Format,Args) ->
     ok.
 
 %%%-----------------------------------------------------------------
+%%% @spec cont_log_no_timestamp(Format,Args) -> ok
+%%% 
+%%% @doc Adds information about an activity (tool-internal use only).
+%%%
+%%% @see start_log/1
+%%% @see end_log/0
+cont_log_no_timestamp([],[]) ->
+    ok;
+cont_log_no_timestamp(Format,Args) ->
+    cast({log,sync,self(),group_leader(),ct_internal,?MAX_IMPORTANCE,
+	  [{Format,Args}],true}),
+    ok.
+
+%%%-----------------------------------------------------------------
 %%% @spec end_log() -> ok
 %%% 
 %%% @doc Ends the logging of an activity (tool-internal use only).
@@ -410,7 +425,7 @@ add_external_logs(Logs) ->
 %%% @doc Print a link to a given file stored in the priv_dir of the
 %%% calling test suite.
 add_link(Heading,File,Type) ->
-    log(Heading,"<a href=\"~ts\" type=~p>~ts</a>\n",
+    log(Heading,"<a href=\"~ts\" type=~tp>~ts</a>\n",
 	[uri(filename:join("log_private",File)),Type,File]).
 
 
@@ -433,10 +448,10 @@ tc_log(Category,Importance,Format,Args,Opts) ->
     tc_log(Category,Importance,"User",Format,Args,Opts).
 
 %%%-----------------------------------------------------------------
-%%% @spec tc_log(Category,Importance,Printer,Format,Args,Opts) -> ok
+%%% @spec tc_log(Category,Importance,Heading,Format,Args,Opts) -> ok
 %%%      Category = atom()
 %%%      Importance = integer()
-%%%      Printer = string()
+%%%      Heading = string()
 %%%      Format = string()
 %%%      Args = list()
 %%%      Opts = list()
@@ -446,13 +461,18 @@ tc_log(Category,Importance,Format,Args,Opts) ->
 %%% <p>This function is called by <code>ct</code> when logging
 %%% stuff directly from a testcase (i.e. not from within the CT
 %%% framework).</p>
-tc_log(Category,Importance,Printer,Format,Args,Opts) ->
+tc_log(Category,Importance,Heading,Format,Args,Opts) ->
     Data = 
 	case lists:member(no_css, Opts) of
 	    true ->
 		[{Format,Args}];
 	    false ->
-		[{hd,div_header(Category,Printer),[]},
+                Heading1 =
+                    case proplists:get_value(heading, Opts) of
+                        undefined -> Heading;
+                        Str       -> Str
+                    end,
+		[{hd,div_header(Category,Heading1),[]},
 		 {Format,Args},
 		 {ft,div_footer(),[]}]
 	end,
@@ -470,7 +490,7 @@ tc_log_async(Category,Format,Args) ->
 %%% @spec tc_log_async(Category,Importance,Format,Args) -> ok
 %%%      Category = atom()
 %%%      Importance = integer()
-%%%      Printer = string()
+%%%      Heading = string()
 %%%      Format = string()
 %%%      Args = list()
 %%%
@@ -481,31 +501,38 @@ tc_log_async(Category,Format,Args) ->
 %%% to avoid deadlocks when e.g. the hook that handles SASL printouts
 %%% prints to the test case log file at the same time test server
 %%% asks ct_logs for an html wrapper.</p>
-tc_log_async(Category,Importance,Printer,Format,Args) ->
+tc_log_async(Category,Importance,Heading,Format,Args) ->
     cast({log,async,self(),group_leader(),Category,Importance,
-	  [{hd,div_header(Category,Printer),[]},
+	  [{hd,div_header(Category,Heading),[]},
 	   {Format,Args},
 	   {ft,div_footer(),[]}],
 	  true}),
     ok.
 %%%-----------------------------------------------------------------
 %%% @spec tc_print(Category,Format,Args)
-%%% @equiv tc_print(Category,?STD_IMPORTANCE,Format,Args)
+%%% @equiv tc_print(Category,?STD_IMPORTANCE,Format,Args,[])
 tc_print(Category,Format,Args) ->
-    tc_print(Category,?STD_IMPORTANCE,Format,Args).
+    tc_print(Category,?STD_IMPORTANCE,Format,Args,[]).
 
 %%%-----------------------------------------------------------------
-%%% @spec tc_print(Category,Importance,Format,Args) -> ok
+%%% @spec tc_print(Category,Importance,Format,Args)
+%%% @equiv tc_print(Category,Importance,Format,Args,[])
+tc_print(Category,Importance,Format,Args) ->
+    tc_print(Category,Importance,Format,Args,[]).
+
+%%%-----------------------------------------------------------------
+%%% @spec tc_print(Category,Importance,Format,Args,Opts) -> ok
 %%%      Category = atom()
 %%%      Importance = integer()
 %%%      Format = string()
 %%%      Args = list()
+%%%      Opts = list()
 %%%
 %%% @doc Console printout from a testcase. 
 %%%
 %%% <p>This function is called by <code>ct</code> when printing
 %%% stuff from a testcase on the user console.</p>
-tc_print(Category,Importance,Format,Args) ->
+tc_print(Category,Importance,Format,Args,Opts) ->
     VLvl = case ct_util:get_verbosity(Category) of
 	       undefined -> 
 		   ct_util:get_verbosity('$unspecified');
@@ -517,50 +544,61 @@ tc_print(Category,Importance,Format,Args) ->
 		   Val
 	   end,
     if Importance >= (100-VLvl) ->
-	    Head = get_heading(Category),
-	    io:format(user, lists:concat([Head,Format,"\n\n"]), Args),
+            Heading =
+                case proplists:get_value(heading, Opts) of
+                    undefined -> atom_to_list(Category);
+                    Hd        -> Hd
+                end,
+            Str = lists:concat([get_header(Heading),Format,"\n\n"]),
+            try
+                io:format(?def_gl, Str, Args)
+            catch
+                %% default group leader probably not started, or has stopped
+                _:_ -> io:format(user, Str, Args)
+            end,
 	    ok;
        true ->
 	    ok
     end.
 
-get_heading(default) ->
+get_header("default") ->
     io_lib:format("\n-----------------------------"
 		  "-----------------------\n~s\n",
 		  [log_timestamp(?now)]);
-get_heading(Category) ->
+get_header(Heading) ->
     io_lib:format("\n-----------------------------"
-		  "-----------------------\n~s  ~w\n",
-		  [log_timestamp(?now),Category]).    
+		  "-----------------------\n~ts ~s\n",
+		  [Heading,log_timestamp(?now)]).    
     
 
 %%%-----------------------------------------------------------------
 %%% @spec tc_pal(Category,Format,Args) -> ok
-%%% @equiv tc_pal(Category,?STD_IMPORTANCE,Format,Args) -> ok
+%%% @equiv tc_pal(Category,?STD_IMPORTANCE,Format,Args,[]) -> ok
 tc_pal(Category,Format,Args) ->
-    tc_pal(Category,?STD_IMPORTANCE,Format,Args).
+    tc_pal(Category,?STD_IMPORTANCE,Format,Args,[]).
 
 %%%-----------------------------------------------------------------
 %%% @spec tc_pal(Category,Importance,Format,Args) -> ok
+%%% @equiv tc_pal(Category,Importance,Format,Args,[]) -> ok
+tc_pal(Category,Importance,Format,Args) ->
+    tc_pal(Category,Importance,Format,Args,[]).
+
+%%%-----------------------------------------------------------------
+%%% @spec tc_pal(Category,Importance,Format,Args,Opts) -> ok
 %%%      Category = atom()
 %%%      Importance = integer()
 %%%      Format = string()
 %%%      Args = list()
+%%%      Opts = list()
 %%%
 %%% @doc Print and log from a testcase. 
 %%%
 %%% <p>This function is called by <code>ct</code> when logging
 %%% stuff directly from a testcase. The info is written both in the
 %%% log and on the console.</p>
-tc_pal(Category,Importance,Format,Args) ->
-    tc_print(Category,Importance,Format,Args),
-    cast({log,sync,self(),group_leader(),Category,Importance,
-	  [{hd,div_header(Category),[]},
-	   {Format,Args},
-	   {ft,div_footer(),[]}],
-	  true}),
-    ok.
-
+tc_pal(Category,Importance,Format,Args,Opts) ->
+    tc_print(Category,Importance,Format,Args,Opts),
+    tc_log(Category,Importance,"User",Format,Args,[esc_chars|Opts]).
 
 %%%-----------------------------------------------------------------
 %%% @spec ct_log(Category,Format,Args) -> ok
@@ -589,13 +627,12 @@ int_footer() ->
 
 div_header(Class) ->
     div_header(Class,"User").
-div_header(Class,Printer) ->
+div_header(Class,Heading) ->
     "\n</pre>\n<div class=\"" ++ atom_to_list(Class) ++ "\"><pre><b>*** "
-	++ Printer ++ " " ++ log_timestamp(?now) ++ " ***</b>".
+	++ Heading ++ " " ++ log_timestamp(?now) ++ " ***</b>".
 div_footer() ->
     "</pre></div>\n<pre>".
 
-
 maybe_log_timestamp() ->
     {MS,S,US} = ?now,
     case get(log_timestamp) of
@@ -666,18 +703,18 @@ logger(Parent, Mode, Verbosity) ->
 	    PrivFilesDestRun = [filename:join(AbsDir, F) || F <- PrivFiles],
 	    case copy_priv_files(PrivFilesSrc, PrivFilesDestTop) of
 		{error,Src1,Dest1,Reason1} ->
-		    io:format(user, "ERROR! "++
-				  "Priv file ~p could not be copied to ~p. "++
-				  "Reason: ~p~n",
+		    io:format(?def_gl, "ERROR! "++
+				  "Priv file ~tp could not be copied to ~tp. "++
+				  "Reason: ~tp~n",
 			      [Src1,Dest1,Reason1]),
 		    exit({priv_file_error,Dest1});
 		ok ->
 		    case copy_priv_files(PrivFilesSrc, PrivFilesDestRun) of
 			{error,Src2,Dest2,Reason2} ->
-			    io:format(user,
+			    io:format(?def_gl,
 				      "ERROR! "++
-				      "Priv file ~p could not be copied to ~p. "
-				      ++"Reason: ~p~n",
+				      "Priv file ~tp could not be copied to ~tp. "
+				      ++"Reason: ~tp~n",
 				      [Src2,Dest2,Reason2]),
 			    exit({priv_file_error,Dest2});
 			ok ->
@@ -854,7 +891,7 @@ logger_loop(State) ->
 	    logger_loop(State);
 	{set_stylesheet,TC,SSFile} ->
 	    Fd = State#logger_state.ct_log_fd,
-	    io:format(Fd, "~p loading external style sheet: ~ts~n",
+	    io:format(Fd, "~tp loading external style sheet: ~ts~n",
 		      [TC,SSFile]),
 	    logger_loop(State#logger_state{stylesheet = SSFile});
 	{clear_stylesheet,_} when State#logger_state.stylesheet == undefined ->
@@ -915,7 +952,7 @@ create_io_fun(FromPid, CtLogFd, EscChars) ->
 		    [IoList,"\n",IoStr]
 	    catch
 		_:_Reason ->
-		    io:format(CtLogFd, "Logging fails! Str: ~p, Args: ~p~n",
+		    io:format(CtLogFd, "Logging fails! Str: ~tp, Args: ~tp~n",
 			      [Str,Args]),
 		    %% stop the testcase, we need to see the fault
 		    exit(FromPid, {log_printout_error,Str,Args}),
@@ -1114,7 +1151,7 @@ open_ctlog(MiscIoName) ->
 	    Dir = filename:dirname(Cwd),
 	    Variables = ct_run:variables_file_name(Dir),
 	    io:format(Fd,
-		      "Can not read the file \'~ts\' Reason: ~w\n"
+		      "Can not read the file \'~ts\' Reason: ~tw\n"
 		      "No configuration found for test!!\n",
 		      [Variables,Reason])
     end,
@@ -1176,7 +1213,7 @@ print_style(Fd, IoFormat, StyleSheet) ->
     end.
 
 print_style_error(Fd, IoFormat, StyleSheet, Reason) ->
-    IO = io_lib:format("\n<!-- Failed to load stylesheet ~ts: ~p -->\n",
+    IO = io_lib:format("\n<!-- Failed to load stylesheet ~ts: ~tp -->\n",
 		       [StyleSheet,Reason]),
     IoFormat(Fd, IO, []),
     print_style(Fd, IoFormat, undefined).
@@ -1219,11 +1256,11 @@ make_last_run_index(StartTime) ->
 	case catch make_last_run_index1(StartTime,IndexName) of
 	    {'EXIT', Reason} ->
 		io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"),
-		io:format("~p~n", [Reason]),
+		io:format("~tp~n", [Reason]),
 		{error, Reason};
 	    {error, Reason} ->
 		io:put_chars("FAILED while updating " ++ AbsIndexName ++ "\n"),
-		io:format("~p~n", [Reason]),
+		io:format("~tp~n", [Reason]),
 		{error, Reason};
 	    ok ->
 		ok;
@@ -1524,7 +1561,7 @@ get_missing_suites(_,_) ->
     [].
 
 term_to_text(Term) ->
-    lists:flatten(io_lib:format("~p.\n", [Term])).
+    lists:flatten(io_lib:format("~tp.\n", [Term])).
 
 
 %%% Headers and footers.
@@ -1792,7 +1829,7 @@ count_cases(Dir) ->
 			    Summary
 		    end;
 		{error, Reason} ->
-		    io:format("\nFailed to read ~p: ~p (skipped)\n",
+		    io:format("\nFailed to read ~tp: ~tp (skipped)\n",
 			      [LogFile,Reason]),
 		    error
 	    end
@@ -1874,10 +1911,10 @@ config_table_header() ->
 
 config_table1([{Key,Value}|Vars]) ->
     [xhtml(["<tr><td>", atom_to_list(Key), "</td>\n",
-	   "<td><pre>",io_lib:format("~p",[Value]),"</pre></td></tr>\n"],
+	   "<td><pre>",io_lib:format("~tp",[Value]),"</pre></td></tr>\n"],
 	   ["<tr class=\"", odd_or_even(), "\">\n",
 	    "<td>", atom_to_list(Key), "</td>\n",
-	    "<td>", io_lib:format("~p",[Value]), "</td>\n</tr>\n"]) |
+	    "<td>", io_lib:format("~tp",[Value]), "</td>\n</tr>\n"]) |
      config_table1(Vars)];
 config_table1([]) ->
     [xhtml("","</tbody>\n"),"</table>\n"].
@@ -1910,7 +1947,11 @@ make_all_runs_index(When) ->
 	end,	
 
     Dirs = filelib:wildcard(logdir_prefix()++"*.*"),
-    DirsSorted = (catch sort_all_runs(Dirs)),
+    DirsSorted0 = (catch sort_all_runs(Dirs)),
+    DirsSorted =
+        if When == start -> DirsSorted0;
+           true -> maybe_delete_old_dirs(DirsSorted0)
+        end,
 
     LogCacheInfo = get_cache_data(UseCache),
 	
@@ -2028,6 +2069,36 @@ sort_ct_runs(Dirs) ->
 	      {DateHH1,MM1,SS1} =< {DateHH2,MM2,SS2}
       end, Dirs).
 
+parse_keep_logs([Str="all"]) ->
+    parse_keep_logs(list_to_atom(Str));
+parse_keep_logs([NStr]) ->
+    parse_keep_logs(list_to_integer(NStr));
+parse_keep_logs(all) ->
+    all;
+parse_keep_logs(N) when is_integer(N), N>0 ->
+    N.
+
+maybe_delete_old_dirs(Sorted) ->
+    {Keep,Delete} =
+        case application:get_env(common_test, keep_logs) of
+            {ok,MaxN} when is_integer(MaxN), length(Sorted)>MaxN ->
+                lists:split(MaxN,Sorted);
+            _ ->
+                {Sorted,[]}
+        end,
+    delete_old_dirs(Delete),
+    Keep.
+
+delete_old_dirs([]) ->
+    ok;
+delete_old_dirs(Dirs) ->
+    io:put_chars("\n  Removing old test directories:\n"),
+    [begin
+         io:put_chars("    " ++ Dir ++ "\n"),
+         rm_dir(Dir)
+     end|| Dir <- Dirs],
+    ok.
+
 dir_diff_all_runs(Dirs, LogCache) ->
     case LogCache#log_cache.all_runs of
 	[] ->
@@ -2403,17 +2474,17 @@ make_all_suites_index(NewTestData = {_TestName,DirName}) ->
 					   LogDirData) of
 	    {'EXIT',Reason} ->
 		io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"),
-		io:format("~p~n", [Reason]),
+		io:format("~tp~n", [Reason]),
 		{error,Reason};
 	    {error,Reason} ->
 		io:put_chars("FAILED while updating " ++ AbsIndexName ++ "\n"),
-		io:format("~p~n", [Reason]),
+		io:format("~tp~n", [Reason]),
 		{error,Reason};
 	    ok ->
 		ok;
 	    Err ->
 		io:format("Unknown internal error while updating ~ts. "
-			  "Please report.\n(Err: ~p, ID: 1)",
+			  "Please report.\n(Err: ~tp, ID: 1)",
 			  [AbsIndexName,Err]),
 		{error, Err}
 	end,
@@ -2632,11 +2703,11 @@ make_all_suites_index1(When, AbsIndexName, AllTestLogDirs) ->
     case catch make_all_suites_index2(IndexName, AllTestLogDirs) of
 	{'EXIT', Reason} ->
 	    io:put_chars("CRASHED while updating " ++ AbsIndexName ++ "!\n"),
-	    io:format("~p~n", [Reason]),
+	    io:format("~tp~n", [Reason]),
 	    {error, Reason};
 	{error, Reason} ->
 	    io:put_chars("FAILED while updating " ++ AbsIndexName ++ "\n"),
-	    io:format("~p~n", [Reason]),
+	    io:format("~tp~n", [Reason]),
 	    {error, Reason};
 	{ok,TempData} ->
 	    case When of
@@ -2650,7 +2721,7 @@ make_all_suites_index1(When, AbsIndexName, AllTestLogDirs) ->
 	    end;
 	Err ->
 	    io:format("Unknown internal error while updating ~ts. "
-		      "Please report.\n(Err: ~p, ID: 1)",
+		      "Please report.\n(Err: ~tp, ID: 1)",
 		      [AbsIndexName,Err]),
 	    {error, Err}
     end.
@@ -3129,7 +3200,7 @@ get_ts_html_wrapper(TestName, Logdir, PrintLabel, Cwd, TableCols, Encoding) ->
     TestName1 = if is_list(TestName) ->
 			lists:flatten(TestName);
 		   true ->
-			lists:flatten(io_lib:format("~p", [TestName]))
+			lists:flatten(io_lib:format("~tp", [TestName]))
 		end,
     Basic = basic_html(),
     LabelStr =