1: %%
    2: %% %CopyrightBegin%
    3: %%
    4: %% Copyright Ericsson AB 2005-2010. All Rights Reserved.
    5: %%
    6: %% The contents of this file are subject to the Erlang Public License,
    7: %% Version 1.1, (the "License"); you may not use this file except in
    8: %% compliance with the License. You should have received a copy of the
    9: %% Erlang Public License along with this software. If not, it can be
   10: %% retrieved online at http://www.erlang.org/.
   11: %%
   12: %% Software distributed under the License is distributed on an "AS IS"
   13: %% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
   14: %% the License for the specific language governing rights and limitations
   15: %% under the License.
   16: %%
   17: %% %CopyrightEnd%
   18: %%
   19: %%
   20: %%----------------------------------------------------------------------
   21: %% Purpose: Verify the application specifics of the asn1 application
   22: %%----------------------------------------------------------------------
   23: -module(asn1_appup_test).
   24: -compile({no_auto_import,[error/1]}).
   25: -compile(export_all).
   26: 
   27: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   28: 
   29: all() -> 
   30:     [appup].
   31: 
   32: groups() -> 
   33:     [].
   34: 
   35: init_per_group(_GroupName, Config) ->
   36: 	Config.
   37: 
   38: end_per_group(_GroupName, Config) ->
   39: 	Config.
   40: 
   41: 
   42: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   43: 
   44: init_per_suite(suite) -> [];
   45: init_per_suite(doc) -> [];
   46: init_per_suite(Config) when is_list(Config) ->
   47:     AppFile   = file_name(asn1, ".app"),
   48:     AppupFile = file_name(asn1, ".appup"),
   49:     [{app_file, AppFile}, {appup_file, AppupFile}|Config].
   50:     
   51: 
   52: file_name(App, Ext) ->
   53:     LibDir = code:lib_dir(App),
   54:     filename:join([LibDir, "ebin", atom_to_list(App) ++ Ext]).
   55: 
   56: 
   57: end_per_suite(suite) -> [];
   58: end_per_suite(doc) -> [];
   59: end_per_suite(Config) when is_list(Config) ->
   60:     Config.
   61: 
   62: 
   63: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   64: 
   65: appup(suite) ->
   66:     [];
   67: appup(doc) ->
   68:     "perform a simple check of the appup file";
   69: appup(Config) when is_list(Config) ->
   70:     AppupFile = key1search(appup_file, Config),
   71:     AppFile   = key1search(app_file, Config),
   72:     Modules   = modules(AppFile),
   73:     check_appup(AppupFile, Modules).
   74: 
   75: modules(File) ->
   76:     case file:consult(File) of
   77:         {ok, [{application,asn1,Info}]} ->
   78:             case lists:keysearch(modules,1,Info) of
   79:                 {value, {modules, Modules}} ->
   80:                     Modules;
   81:                 false ->
   82:                     fail({bad_appinfo, Info})
   83:             end;
   84:         Error ->
   85:             fail({bad_appfile, Error})
   86:     end.
   87: 
   88:     
   89: check_appup(AppupFile, Modules) ->
   90:     case file:consult(AppupFile) of
   91: 	{ok, [{V, UpFrom, DownTo}]} ->
   92: 	    io:format("V= ~p, UpFrom= ~p, DownTo= ~p, Modules= ~p~n",
   93: 		      [V, UpFrom, DownTo, Modules]),
   94: 	    check_appup(V, UpFrom, DownTo, Modules);
   95: 	Else ->
   96: 	    fail({bad_appupfile, Else})
   97:     end.
   98: 
   99: 
  100: check_appup(V, UpFrom, DownTo, Modules) ->
  101:     check_version(V),
  102:     check_depends(up,   UpFrom, Modules),
  103:     check_depends(down, DownTo, Modules),
  104:     ok.
  105: 
  106: 
  107: check_depends(_, [], _) ->
  108:     ok;
  109: check_depends(UpDown, [Dep|Deps], Modules) ->
  110:     check_depend(UpDown, Dep, Modules),
  111:     check_depends(UpDown, Deps, Modules).
  112: 
  113: 
  114: check_depend(up,I={add_application,_App},Modules) ->
  115:     d("check_instructions(~w) -> entry with"
  116:       "~n   Instruction:       ~p"
  117:       "~n   Modules: ~p", [up,I , Modules]),
  118:     ok;
  119: check_depend(down,I={remove_application,_App},Modules) ->
  120:     d("check_instructions(~w) -> entry with"
  121:       "~n   Instruction:       ~p"
  122:       "~n   Modules: ~p", [down,I , Modules]),
  123:     ok;
  124: check_depend(UpDown, {V, Instructions}, Modules) ->
  125:     d("check_instructions(~w) -> entry with"
  126:       "~n   V:       ~p"
  127:       "~n   Modules: ~p", [UpDown, V, Modules]),
  128:     check_version(V),
  129:     case check_instructions(UpDown, 
  130: 			    Instructions, Instructions, [], [], Modules) of
  131: 	{_Good, []} ->
  132: 	    ok;
  133: 	{_, Bad} ->
  134: 	    fail({bad_instructions, Bad, UpDown})
  135:     end.
  136: 
  137: 
  138: check_instructions(_, [], _, Good, Bad, _) ->
  139:     {lists:reverse(Good), lists:reverse(Bad)};
  140: check_instructions(UpDown, [Instr|Instrs], AllInstr, Good, Bad, Modules) ->
  141:     d("check_instructions(~w) -> entry with"
  142:       "~n   Instr: ~p", [UpDown,Instr]),
  143:     case (catch check_instruction(UpDown, Instr, AllInstr, Modules)) of
  144:         ok ->
  145:             check_instructions(UpDown, Instrs, AllInstr, 
  146: 			       [Instr|Good], Bad, Modules);
  147:         {error, Reason} ->
  148: 	    d("check_instructions(~w) -> bad instruction: "
  149: 	      "~n   Reason: ~p", [UpDown,Reason]),
  150:             check_instructions(UpDown, Instrs, AllInstr, Good, 
  151:                                [{Instr, Reason}|Bad], Modules)
  152:     end.
  153: 
  154: %% A new module is added
  155: check_instruction(up, {add_module, Module}, _, Modules) 
  156:   when is_atom(Module) ->
  157:     d("check_instruction -> entry when up-add_module instruction with"
  158:       "~n   Module: ~p", [Module]),
  159:     check_module(Module, Modules);
  160: 
  161: %% An old module is re-added
  162: check_instruction(down, {add_module, Module}, _, Modules) 
  163:   when is_atom(Module) ->
  164:     d("check_instruction -> entry when down-add_module instruction with"
  165:       "~n   Module: ~p", [Module]),
  166:     case (catch check_module(Module, Modules)) of
  167: 	{error, {unknown_module, Module, Modules}} ->
  168: 	    ok;
  169: 	ok ->
  170: 	    error({existing_readded_module, Module})
  171:     end;
  172: 
  173: %% Removing a module on upgrade: 
  174: %% - the module has been removed from the app-file.
  175: %% - check that no module depends on this (removed) module
  176: check_instruction(up, {remove, {Module, Pre, Post}}, _, Modules) 
  177:   when is_atom(Module), is_atom(Pre), is_atom(Post) ->
  178:     d("check_instruction -> entry when up-remove instruction with"
  179:       "~n   Module: ~p"
  180:       "~n   Pre:    ~p"
  181:       "~n   Post:   ~p", [Module, Pre, Post]),
  182:     case (catch check_module(Module, Modules)) of
  183: 	{error, {unknown_module, Module, Modules}} ->
  184: 	    check_purge(Pre),
  185: 	    check_purge(Post);
  186: 	ok ->
  187: 	    error({existing_removed_module, Module})
  188:     end;
  189: 
  190: %% Removing a module on downgrade: the module exist
  191: %% in the app-file.
  192: check_instruction(down, {remove, {Module, Pre, Post}}, AllInstr, Modules) 
  193:   when is_atom(Module), is_atom(Pre), is_atom(Post) ->
  194:     d("check_instruction -> entry when down-remove instruction with"
  195:       "~n   Module: ~p"
  196:       "~n   Pre:    ~p"
  197:       "~n   Post:   ~p", [Module, Pre, Post]),
  198:     case (catch check_module(Module, Modules)) of
  199: 	ok ->
  200: 	    check_purge(Pre),
  201: 	    check_purge(Post),
  202: 	    check_no_remove_depends(Module, AllInstr);
  203: 	{error, {unknown_module, Module, Modules}} ->
  204: 	    error({nonexisting_removed_module, Module})
  205:     end;
  206: 
  207: check_instruction(_, {load_module, Module, Pre, Post, Depend}, 
  208: 		  AllInstr, Modules) 
  209:   when is_atom(Module), is_atom(Pre), is_atom(Post), is_list(Depend) ->
  210:     d("check_instruction -> entry when load_module instruction with"
  211:       "~n   Module: ~p"
  212:       "~n   Pre:    ~p"
  213:       "~n   Post:   ~p"
  214:       "~n   Depend: ~p", [Module, Pre, Post, Depend]),
  215:     check_module(Module, Modules),
  216:     check_module_depend(Module, Depend, Modules),
  217:     check_module_depend(Module, Depend, updated_modules(AllInstr, [])),
  218:     check_purge(Pre),
  219:     check_purge(Post);
  220: 
  221: check_instruction(_, {update, Module, Change, Pre, Post, Depend}, 
  222: 		  AllInstr, Modules) 
  223:   when is_atom(Module), is_atom(Pre), is_atom(Post), is_list(Depend) ->
  224:     d("check_instruction -> entry when update instruction with"
  225:       "~n   Module: ~p"
  226:       "~n   Change: ~p"
  227:       "~n   Pre:    ~p"
  228:       "~n   Post:   ~p"
  229:       "~n   Depend: ~p", [Module, Change, Pre, Post, Depend]),
  230:     check_module(Module, Modules),
  231:     check_module_depend(Module, Depend, Modules),
  232:     check_module_depend(Module, Depend, updated_modules(AllInstr, [])),
  233:     check_change(Change),
  234:     check_purge(Pre),
  235:     check_purge(Post);
  236: 
  237: check_instruction(_, {apply, {Module, Function, Args}}, 
  238: 		  _AllInstr, Modules) 
  239:   when is_atom(Module), is_atom(Function), is_list(Args) ->
  240:     d("check_instruction -> entry when apply instruction with"
  241:       "~n   Module: ~p"
  242:       "~n   Function: ~p"
  243:       "~n   Args:    ~p", [Module, Function, Args]),
  244:     check_module(Module, Modules),
  245:     check_apply(Module,Function,Args);
  246: 
  247: check_instruction(_, Instr, _AllInstr, _Modules) ->
  248:     d("check_instruction -> entry when unknown instruction with"
  249:       "~n   Instr: ~p", [Instr]),
  250:     error({error, {unknown_instruction, Instr}}).
  251: 
  252: 
  253: %% If Module X depends on Module Y, then module Y must have an update
  254: %% instruction of some sort (otherwise the depend is faulty).
  255: updated_modules([], Modules) ->
  256:     d("update_modules -> entry when done with"
  257:       "~n   Modules: ~p", [Modules]),
  258:     Modules;
  259: updated_modules([Instr|Instrs], Modules) ->
  260:     d("update_modules -> entry with"
  261:       "~n   Instr:   ~p"
  262:       "~n   Modules: ~p", [Instr,Modules]),
  263:     Module = instruction_module(Instr),
  264:     d("update_modules -> Module: ~p", [Module]),
  265:     updated_modules(Instrs, [Module|Modules]).
  266:     
  267: instruction_module({add_module, Module}) ->
  268:     Module;
  269: instruction_module({remove, {Module, _, _}}) ->
  270:     Module;
  271: instruction_module({load_module, Module, _, _, _}) ->
  272:     Module;
  273: instruction_module({update, Module, _, _, _, _}) ->
  274:     Module;
  275: instruction_module({apply, {Module, _, _}}) ->
  276:     Module;
  277: instruction_module(Instr) ->
  278:     d("instruction_module -> entry when unknown instruction with"
  279:       "~n   Instr: ~p", [Instr]),
  280:     error({error, {unknown_instruction, Instr}}).
  281:     
  282: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  283: 
  284: check_version(V) when is_list(V) ->
  285:     ok;
  286: check_version(V) ->
  287:     error({bad_version, V}).
  288: 
  289: 
  290: check_module(M, Modules) when is_atom(M) ->
  291:     case lists:member(M,Modules) of
  292:         true ->
  293:             ok;
  294:         false ->
  295:             error({unknown_module, M, Modules})
  296:     end;
  297: check_module(M, _) ->
  298:     error({bad_module, M}).
  299: 
  300: check_apply(Module,Function,Args) ->
  301:     case (catch Module:module_info()) of
  302: 	Info when is_list(Info) ->
  303: 	    check_exported(Function,Args,Info);
  304: 	{'EXIT',{undef,_}} ->
  305: 	    error({not_existing_module,Module})
  306:     end.
  307: 
  308: check_exported(Function,Args,Info) ->
  309:     case lists:keysearch(exports,1,Info) of
  310: 	{value,{exports,FunList}} ->
  311: 	    case lists:keysearch(Function,1,FunList) of
  312: 		{value,{_,Arity}} when Arity==length(Args) ->
  313: 		    ok;
  314: 		_ ->
  315: 		    error({not_exported_function,Function,length(Args)})
  316: 	    end;
  317: 	_ ->
  318: 	    error({bad_export,Info})
  319:     end.
  320: 
  321: check_module_depend(M, [], _) when is_atom(M) ->
  322:     d("check_module_depend -> entry with"
  323:       "~n   M: ~p", [M]),    
  324:     ok;
  325: check_module_depend(M, Deps, Modules) when is_atom(M), is_list(Deps) ->
  326:     d("check_module_depend -> entry with"
  327:       "~n   M: ~p"
  328:       "~n   Deps: ~p"
  329:       "~n   Modules: ~p", [M, Deps, Modules]),    
  330:     case [Dep || Dep <- Deps, lists:member(Dep, Modules) == false] of
  331:         [] ->
  332:             ok;
  333:         Unknown ->
  334:             error({unknown_depend_modules, Unknown})
  335:     end;
  336: check_module_depend(_M, D, _Modules) ->
  337:     d("check_module_depend -> entry when bad depend with"
  338:       "~n   D: ~p", [D]),    
  339:     error({bad_depend, D}).
  340: 
  341: 
  342: check_no_remove_depends(_Module, []) ->
  343:     ok;
  344: check_no_remove_depends(Module, [Instr|Instrs]) ->
  345:     check_no_remove_depend(Module, Instr),
  346:     check_no_remove_depends(Module, Instrs).
  347: 
  348: check_no_remove_depend(Module, {load_module, Mod, _Pre, _Post, Depend}) ->
  349:     case lists:member(Module, Depend) of
  350: 	true ->
  351: 	    error({removed_module_in_depend, load_module, Mod, Module});
  352: 	false ->
  353: 	    ok
  354:     end;
  355: check_no_remove_depend(Module, {update, Mod, _Change, _Pre, _Post, Depend}) ->
  356:     case lists:member(Module, Depend) of
  357: 	true ->
  358: 	    error({removed_module_in_depend, update, Mod, Module});
  359: 	false ->
  360: 	    ok
  361:     end;
  362: check_no_remove_depend(_, _) ->
  363:     ok.
  364:     
  365: 
  366: check_change(soft) ->
  367:     ok;
  368: check_change({advanced, _Something}) ->
  369:     ok;
  370: check_change(Change) ->
  371:     error({bad_change, Change}).
  372: 
  373: 
  374: check_purge(soft_purge) ->
  375:     ok;
  376: check_purge(brutal_purge) ->
  377:     ok;
  378: check_purge(Purge) ->
  379:     error({bad_purge, Purge}).
  380: 
  381: 
  382: 
  383: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  384: 
  385: error(Reason) ->
  386:     throw({error, Reason}).
  387: 
  388: fail(Reason) ->
  389:     exit({suite_failed, Reason}).
  390: 
  391: key1search(Key, L) ->
  392:     case lists:keysearch(Key, 1, L) of
  393: 	undefined ->
  394: 	    fail({not_found, Key, L});
  395: 	{value, {Key, Value}} ->
  396: 	    Value
  397:     end.
  398: 
  399: 
  400: %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  401: 
  402: d(F, A) ->
  403:     d(false, F, A).
  404: 
  405: d(true, F, A) ->
  406:     io:format(F ++ "~n", A);
  407: d(_, _, _) ->
  408:     ok.
  409: 
  410: