Introduce appup test utility

This adds a test function similar to the app file test function
existing in test_server. The code is mostly taken from the asn1,
snmp and inets test suites. Low-level upgrade instruction checking
is stripped. Library application's appup files get specialized
treatment, since their content is almost static.

3 files changed, 276 insertions, 4 deletions

diff --git a/lib/test_server/doc/src/test_server.xml b/lib/test_server/doc/src/test_server.xml
index 4a47a8f45c..ed5569e1fe 100644
--- a/lib/test_server/doc/src/test_server.xml
+++ b/lib/test_server/doc/src/test_server.xml
@@ -625,6 +625,31 @@ Only valid for peer nodes. Note that slave nodes always
       </desc>
     </func>
     <func>
+      <name>appup_test(App) -> ok | test_server:fail()</name>
+      <fsummary>Checks an applications .appup file for obvious errors</fsummary>
+      <type>
+        <v>App = term()</v>
+        <d>The name of the application to test</d>
+      </type>
+      <desc>
+        <p>Checks an applications .appup file for obvious errors.
+          The following is checked:
+          </p>
+        <list type="bulleted">
+          <item>syntax
+          </item>
+          <item>that .app file version and .appup file version match
+          </item>
+          <item>for non-library applications: validity of high-level upgrade
+           instructions, specifying no instructions is explicitly allowed
+           (in this case the application is not upgradeable)</item>
+          <item>for library applications: that there is exactly one wildcard
+           regexp clause restarting the application when upgrading or
+           downgrading from any version</item>
+        </list>
+      </desc>
+    </func>
+    <func>
       <name>comment(Comment) -> ok</name>
       <fsummary>Print a comment on the HTML result page</fsummary>
       <type>
diff --git a/lib/test_server/src/test_server.erl b/lib/test_server/src/test_server.erl
index d367e7b5d6..82672521f7 100644
--- a/lib/test_server/src/test_server.erl
+++ b/lib/test_server/src/test_server.erl
@@ -40,7 +40,7 @@
 -export([call_crash/3,call_crash/4,call_crash/5]).
 -export([temp_name/1]).
 -export([start_node/3, stop_node/1, wait_for_node/1, is_release_available/1]).
--export([app_test/1, app_test/2]).
+-export([app_test/1, app_test/2, appup_test/1]).
 -export([is_native/1]).
 -export([comment/1, make_priv_dir/0]).
 -export([os_type/0]).
@@ -2448,8 +2448,11 @@ app_test(App) ->
 app_test(App, Mode) ->
     test_server_sup:app_test(App, Mode).
 
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% appup_test/1
+%%
+appup_test(App) ->
+    test_server_sup:appup_test(App).
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %% is_native(Mod) -> true | false
diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl
index 70ead42b1b..3cfa84a52f 100644
--- a/lib/test_server/src/test_server_sup.erl
+++ b/lib/test_server/src/test_server_sup.erl
@@ -30,7 +30,8 @@
 	 framework_call/2,framework_call/3,framework_call/4,
 	 format_loc/1,
 	 util_start/0, util_stop/0, unique_name/0,
-	 call_trace/1]).
+	 call_trace/1,
+	 appup_test/1]).
 -include("test_server_internal.hrl").
 -define(crash_dump_tar,"crash_dumps.tar.gz").
 -define(src_listing_ext, ".src.html").
@@ -265,6 +266,249 @@ app_check_export_all([Mod|Mods]) ->
 	    end
     end.
 
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% appup_test/1
+%%
+%% Checks one applications .appup file for obvious errors.
+%% Checks..
+%% * .. syntax
+%% * .. that version in app file matches appup file version
+%% * .. validity of appup instructions
+%%
+%% For library application this function checks that the proper
+%% 'restart_application' upgrade and downgrade clauses exist.
+appup_test(Application) ->
+    case is_app(Application) of
+        {ok, AppFile} ->
+            case is_appup(Application, proplists:get_value(vsn, AppFile)) of
+                {ok, Up, Down} ->
+                    StartMod = proplists:get_value(mod, AppFile),
+                    Modules = proplists:get_value(modules, AppFile),
+                    do_appup_tests(StartMod, Application, Up, Down, Modules);
+                Error ->
+                    test_server:fail(Error)
+            end;
+        Error ->
+            test_server:fail(Error)
+    end.
+
+is_appup(Application, Version) ->
+    AppupFile = atom_to_list(Application) ++ ".appup",
+    AppupPath = filename:join([code:lib_dir(Application), "ebin", AppupFile]),
+    case file:consult(AppupPath) of
+        {ok, [{Version, Up, Down}]} when is_list(Up), is_list(Down) ->
+            {ok, Up, Down};
+        _ ->
+            test_server:format(
+              minor,
+              "Application upgrade (.appup) file not found, "
+              "or it has very bad syntax.~n"),
+            {error, appup_not_readable}
+    end.
+
+do_appup_tests(undefined, Application, Up, Down, _Modules) ->
+    %% library application
+    case Up of
+        [{<<".*">>, [{restart_application, Application}]}] ->
+            case Down of
+                [{<<".*">>, [{restart_application, Application}]}] ->
+                    ok;
+                _ ->
+                    test_server:format(
+                      minor,
+                      "Library application needs restart_application "
+                      "downgrade instruction.~n"),
+                    {error, library_downgrade_instruction_malformed}
+            end;
+        _ ->
+            test_server:format(
+              minor,
+              "Library application needs restart_application "
+              "upgrade instruction.~n"),
+            {error, library_upgrade_instruction_malformed}
+    end;
+do_appup_tests(_, _Application, Up, Down, Modules) ->
+    %% normal application
+    case check_appup_clauses_plausible(Up, up, Modules) of
+        ok ->
+            case check_appup_clauses_plausible(Down, down, Modules) of
+                ok ->
+                    test_server:format(minor, "OK~n");
+                Error ->
+                    test_server:format(minor, "ERROR ~p~n", [Error]),
+                    test_server:fail(Error)
+            end;
+        Error ->
+            test_server:format(minor, "ERROR ~p~n", [Error]),
+            test_server:fail(Error)
+    end.
+    
+check_appup_clauses_plausible([], _Direction, _Modules) ->
+    ok;
+check_appup_clauses_plausible([{Re, Instrs} | Rest], Direction, Modules)
+  when is_binary(Re) ->
+    case re:compile(Re) of
+        {ok, _} ->
+            case check_appup_instructions(Instrs, Direction, Modules) of
+                ok ->
+                    check_appup_clauses_plausible(Rest, Direction, Modules);
+                Error ->
+                    Error
+            end;
+        {error, Error} ->
+            {error, {version_regex_malformed, Re, Error}}
+    end;
+check_appup_clauses_plausible([{V, Instrs} | Rest], Direction, Modules)
+  when is_list(V) ->
+    case check_appup_instructions(Instrs, Direction, Modules) of
+        ok ->
+            check_appup_clauses_plausible(Rest, Direction, Modules);
+        Error ->
+            Error
+    end;
+check_appup_clauses_plausible(Clause, _Direction, _Modules) ->
+    {error, {clause_malformed, Clause}}.
+
+check_appup_instructions(Instrs, Direction, Modules) ->
+    case check_instructions(Direction, Instrs, Instrs, [], [], Modules) of
+        {_Good, []} ->
+            ok;
+        {_, Bad} ->
+            {error, {bad_instructions, Bad}}
+    end.
+
+check_instructions(_, [], _, Good, Bad, _) ->
+    {lists:reverse(Good), lists:reverse(Bad)};
+check_instructions(UpDown, [Instr | Rest], All, Good, Bad, Modules) ->
+    case catch check_instruction(UpDown, Instr, All, Modules) of
+        ok ->
+            check_instructions(UpDown, Rest, All, [Instr | Good], Bad, Modules);
+        {error, Reason} ->
+            NewBad = [{Instr, Reason} | Bad],
+            check_instructions(UpDown, Rest, All, Good, NewBad, Modules)
+    end.
+
+check_instruction(up, {add_module, Module}, _, Modules) ->
+    %% A new module is added
+    check_module(Module, Modules);
+check_instruction(down, {add_module, Module}, _, Modules) ->
+    %% An old module is re-added
+    case (catch check_module(Module, Modules)) of
+        {error, {unknown_module, Module, Modules}} -> ok;
+        ok -> throw({error, {existing_readded_module, Module}})
+    end;
+check_instruction(_, {load_module, Module}, _, Modules) ->
+    check_module(Module, Modules);
+check_instruction(_, {load_module, Module, DepMods}, _, Modules) ->
+    check_module(Module, Modules),
+    check_depend(DepMods);
+check_instruction(_, {load_module, Module, Pre, Post, DepMods}, _, Modules) ->
+    check_module(Module, Modules),
+    check_depend(DepMods),
+    check_purge(Pre),
+    check_purge(Post);
+check_instruction(up, {delete_module, Module}, _, Modules) ->
+    case (catch check_module(Module, Modules)) of
+        {error, {unknown_module, Module, Modules}} ->
+            ok;
+        ok ->
+            throw({error,{existing_module_deleted, Module}})
+    end;
+check_instruction(down, {delete_module, Module}, _, Modules) ->
+    check_module(Module, Modules);
+check_instruction(_, {update, Module}, _, Modules) ->
+    check_module(Module, Modules);
+check_instruction(_, {update, Module, supervisor}, _, Modules) ->
+    check_module(Module, Modules);
+check_instruction(_, {update, Module, DepMods}, _, Modules)
+  when is_list(DepMods) ->
+    check_module(Module, Modules);
+check_instruction(_, {update, Module, Change}, _, Modules) ->
+    check_module(Module, Modules),
+    check_change(Change);
+check_instruction(_, {update, Module, Change, DepMods}, _, Modules) ->
+    check_module(Module, Modules),
+    check_change(Change),
+    check_depend(DepMods);
+check_instruction(_, {update, Module, Change, Pre, Post, DepMods}, _, Modules) ->
+    check_module(Module, Modules),
+    check_change(Change),
+    check_purge(Pre),
+    check_purge(Post),
+    check_depend(DepMods);
+check_instruction(_,
+                  {update, Module, Timeout, Change, Pre, Post, DepMods},
+                  _,
+                  Modules) ->
+    check_module(Module, Modules),
+    check_timeout(Timeout),
+    check_change(Change),
+    check_purge(Pre),
+    check_purge(Post),
+    check_depend(DepMods);
+check_instruction(_,
+                  {update, Module, ModType, Timeout, Change, Pre, Post, DepMods},
+                  _,
+                  Modules) ->
+    check_module(Module, Modules),
+    check_mod_type(ModType),
+    check_timeout(Timeout),
+    check_change(Change),
+    check_purge(Pre),
+    check_purge(Post),
+    check_depend(DepMods);
+check_instruction(_, {restart_application, Application}, _, _) ->
+    check_application(Application);
+check_instruction(_, {remove_application, Application}, _, _) ->
+    check_application(Application);
+check_instruction(_, {add_application, Application}, _, _) ->
+    check_application(Application);
+check_instruction(_, {add_application, Application, Type}, _, _) ->
+    check_application(Application),
+    check_restart_type(Type);
+check_instruction(_, Instr, _, _) ->
+    throw({error, {low_level_or_invalid_instruction, Instr}}).
+
+check_module(Module, Modules) when is_atom(Module) ->
+    case {is_atom(Module), lists:member(Module, Modules)} of
+        {true, true}  -> ok;
+        {true, false} -> throw({error, {unknown_module, Module}});
+        {false, _}    -> throw({error, {bad_module, Module}})
+    end.
+
+check_application(App) ->
+    case is_atom(App) of
+        true  -> ok;
+        false -> throw({error, {bad_application, App}})
+    end.
+
+check_depend(Dep) when is_list(Dep) -> ok;
+check_depend(Dep)                   -> throw({error, {bad_depend, Dep}}).
+
+check_restart_type(permanent) -> ok;
+check_restart_type(transient) -> ok;
+check_restart_type(temporary) -> ok;
+check_restart_type(load)      -> ok;
+check_restart_type(none)      -> ok;
+check_restart_type(Type)      -> throw({error, {bad_restart_type, Type}}).
+
+check_timeout(T) when is_integer(T), T > 0 -> ok;
+check_timeout(default)                     -> ok;
+check_timeout(infinity)                    -> ok;
+check_timeout(T)                           -> throw({error, {bad_timeout, T}}).
+
+check_mod_type(static)  -> ok;
+check_mod_type(dynamic) -> ok;
+check_mod_type(Type)    -> throw({error, {bad_mod_type, Type}}).
+
+check_purge(soft_purge)   -> ok;
+check_purge(brutal_purge) -> ok;
+check_purge(Purge)        -> throw({error, {bad_purge, Purge}}).
+
+check_change(soft)          -> ok;
+check_change({advanced, _}) -> ok;
+check_change(Change)        -> throw({error, {bad_change, Change}}).
+
 %% Given two sorted lists, L1 and L2, returns {NotInL2, NotInL1},
 %% NotInL2 is the elements of L1 which don't occurr in L2,
 %% NotInL1 is the elements of L2 which don't ocurr in L1.