aboutsummaryrefslogtreecommitdiffstats
path: root/lib/test_server/src/test_server_sup.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/test_server/src/test_server_sup.erl')
-rw-r--r--lib/test_server/src/test_server_sup.erl939
1 files changed, 0 insertions, 939 deletions
diff --git a/lib/test_server/src/test_server_sup.erl b/lib/test_server/src/test_server_sup.erl
deleted file mode 100644
index fc2cfd57bd..0000000000
--- a/lib/test_server/src/test_server_sup.erl
+++ /dev/null
@@ -1,939 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2014. 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.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
-
-%%%-------------------------------------------------------------------
-%%% Purpose: Test server support functions.
-%%%-------------------------------------------------------------------
--module(test_server_sup).
--export([timetrap/2, timetrap/3, timetrap/4,
- timetrap_cancel/1, capture_get/1, messages_get/1,
- timecall/3, call_crash/5, app_test/2, check_new_crash_dumps/0,
- cleanup_crash_dumps/0, crash_dump_dir/0, tar_crash_dumps/0,
- get_username/0, get_os_family/0,
- hostatom/0, hostatom/1, hoststr/0, hoststr/1,
- framework_call/2,framework_call/3,framework_call/4,
- format_loc/1,
- util_start/0, util_stop/0, unique_name/0,
- 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").
--record(util_state, {starter, latest_name}).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% timetrap(Timeout,Scale,Pid) -> Handle
-%% Handle = term()
-%%
-%% Creates a time trap, that will kill the given process if the
-%% trap is not cancelled with timetrap_cancel/1, within Timeout
-%% milliseconds.
-%% Scale says if the time should be scaled up to compensate for
-%% delays during the test (e.g. if cover is running).
-
-timetrap(Timeout0, Pid) ->
- timetrap(Timeout0, Timeout0, true, Pid).
-
-timetrap(Timeout0, Scale, Pid) ->
- timetrap(Timeout0, Timeout0, Scale, Pid).
-
-timetrap(Timeout0, ReportTVal, Scale, Pid) ->
- process_flag(priority, max),
- Timeout = if not Scale -> Timeout0;
- true -> test_server:timetrap_scale_factor() * Timeout0
- end,
- TruncTO = trunc(Timeout),
- receive
- after TruncTO ->
- kill_the_process(Pid, Timeout0, TruncTO, ReportTVal)
- end.
-
-kill_the_process(Pid, Timeout0, TruncTO, ReportTVal) ->
- case is_process_alive(Pid) of
- true ->
- TimeToReport = if Timeout0 == ReportTVal -> TruncTO;
- true -> ReportTVal end,
- MFLs = test_server:get_loc(Pid),
- Mon = erlang:monitor(process, Pid),
- Trap = {timetrap_timeout,TimeToReport,MFLs},
- exit(Pid, Trap),
- receive
- {'DOWN', Mon, process, Pid, _} ->
- ok
- after 10000 ->
- %% Pid is probably trapping exits, hit it harder...
- catch error_logger:warning_msg(
- "Testcase process ~w not "
- "responding to timetrap "
- "timeout:~n"
- " ~p.~n"
- "Killing testcase...~n",
- [Pid, Trap]),
- exit(Pid, kill)
- end;
- false ->
- ok
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% timetrap_cancel(Handle) -> ok
-%% Handle = term()
-%%
-%% Cancels a time trap.
-timetrap_cancel(Handle) ->
- unlink(Handle),
- MonRef = erlang:monitor(process, Handle),
- exit(Handle, kill),
- receive {'DOWN',MonRef,_,_,_} -> ok
- after
- 2000 ->
- erlang:demonitor(MonRef, [flush]),
- ok
- end.
-
-capture_get(Msgs) ->
- receive
- {captured,Msg} ->
- capture_get([Msg|Msgs])
- after 0 ->
- lists:reverse(Msgs)
- end.
-
-messages_get(Msgs) ->
- receive
- Msg ->
- messages_get([Msg|Msgs])
- after 0 ->
- lists:reverse(Msgs)
- end.
-
-timecall(M, F, A) ->
- {Elapsed, Val} = timer:tc(M, F, A),
- {Elapsed / 1000000, Val}.
-
-
-call_crash(Time,Crash,M,F,A) ->
- OldTrapExit = process_flag(trap_exit,true),
- Pid = spawn_link(M,F,A),
- Answer =
- receive
- {'EXIT',Crash} ->
- ok;
- {'EXIT',Pid,Crash} ->
- ok;
- {'EXIT',_Reason} when Crash==any ->
- ok;
- {'EXIT',Pid,_Reason} when Crash==any ->
- ok;
- {'EXIT',Reason} ->
- test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.",
- [Crash, Reason]),
- exit({wrong_crash_reason,Reason});
- {'EXIT',Pid,Reason} ->
- test_server:format(12, "Wrong crash reason. Wanted ~p, got ~p.",
- [Crash, Reason]),
- exit({wrong_crash_reason,Reason});
- {'EXIT',OtherPid,Reason} when OldTrapExit == false ->
- exit({'EXIT',OtherPid,Reason})
- after do_trunc(Time) ->
- exit(call_crash_timeout)
- end,
- process_flag(trap_exit,OldTrapExit),
- Answer.
-
-do_trunc(infinity) -> infinity;
-do_trunc(T) -> trunc(T).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% app_test/2
-%%
-%% Checks one applications .app file for obvious errors.
-%% Checks..
-%% * .. required fields
-%% * .. that all modules specified actually exists
-%% * .. that all requires applications exists
-%% * .. that no module included in the application has export_all
-%% * .. that all modules in the ebin/ dir is included
-%% (This only produce a warning, as all modules does not
-%% have to be included (If the `pedantic' option isn't used))
-app_test(Application, Mode) ->
- case is_app(Application) of
- {ok, AppFile} ->
- do_app_tests(AppFile, Application, Mode);
- Error ->
- test_server:fail(Error)
- end.
-
-is_app(Application) ->
- case file:consult(filename:join([code:lib_dir(Application),"ebin",
- atom_to_list(Application)++".app"])) of
- {ok, [{application, Application, AppFile}] } ->
- {ok, AppFile};
- _ ->
- test_server:format(minor,
- "Application (.app) file not found, "
- "or it has very bad syntax.~n"),
- {error, not_an_application}
- end.
-
-
-do_app_tests(AppFile, AppName, Mode) ->
- DictList=
- [
- {missing_fields, []},
- {missing_mods, []},
- {superfluous_mods_in_ebin, []},
- {export_all_mods, []},
- {missing_apps, []}
- ],
- fill_dictionary(DictList),
-
- %% An appfile must (?) have some fields..
- check_fields([description, modules, registered, applications], AppFile),
-
- %% Check for missing and extra modules.
- {value, {modules, Mods}}=lists:keysearch(modules, 1, AppFile),
- EBinList=lists:sort(get_ebin_modnames(AppName)),
- {Missing, Extra} = common(lists:sort(Mods), EBinList),
- put(superfluous_mods_in_ebin, Extra),
- put(missing_mods, Missing),
-
- %% Check that no modules in the application has export_all.
- app_check_export_all(Mods),
-
- %% Check that all specified applications exists.
- {value, {applications, Apps}}=
- lists:keysearch(applications, 1, AppFile),
- check_apps(Apps),
-
- A=check_dict(missing_fields, "Inconsistent app file, "
- "missing fields"),
- B=check_dict(missing_mods, "Inconsistent app file, "
- "missing modules"),
- C=check_dict_tolerant(superfluous_mods_in_ebin, "Inconsistent app file, "
- "Modules not included in app file.", Mode),
- D=check_dict(export_all_mods, "Inconsistent app file, "
- "Modules have `export_all'."),
- E=check_dict(missing_apps, "Inconsistent app file, "
- "missing applications."),
-
- erase_dictionary(DictList),
- case A+B+C+D+E of
- 5 ->
- ok;
- _ ->
- test_server:fail()
- end.
-
-app_check_export_all([]) ->
- ok;
-app_check_export_all([Mod|Mods]) ->
- case catch apply(Mod, module_info, [compile]) of
- {'EXIT', {undef,_}} ->
- app_check_export_all(Mods);
- COpts ->
- case lists:keysearch(options, 1, COpts) of
- false ->
- app_check_export_all(Mods);
- {value, {options, List}} ->
- case lists:member(export_all, List) of
- true ->
- put(export_all_mods, [Mod|get(export_all_mods)]),
- app_check_export_all(Mods);
- false ->
- app_check_export_all(Mods)
- end
- 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) ->
- 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.
-
-common(L1, L2) ->
- common(L1, L2, [], []).
-
-common([X|Rest1], [X|Rest2], A1, A2) ->
- common(Rest1, Rest2, A1, A2);
-common([X|Rest1], [Y|Rest2], A1, A2) when X < Y ->
- common(Rest1, [Y|Rest2], [X|A1], A2);
-common([X|Rest1], [Y|Rest2], A1, A2) ->
- common([X|Rest1], Rest2, A1, [Y|A2]);
-common([], L, A1, A2) ->
- {A1, L++A2};
-common(L, [], A1, A2) ->
- {L++A1, A2}.
-
-check_apps([]) ->
- ok;
-check_apps([App|Apps]) ->
- case is_app(App) of
- {ok, _AppFile} ->
- ok;
- {error, _} ->
- put(missing_apps, [App|get(missing_apps)])
- end,
- check_apps(Apps).
-
-check_fields([], _AppFile) ->
- ok;
-check_fields([L|Ls], AppFile) ->
- check_field(L, AppFile),
- check_fields(Ls, AppFile).
-
-check_field(FieldName, AppFile) ->
- case lists:keymember(FieldName, 1, AppFile) of
- true ->
- ok;
- false ->
- put(missing_fields, [FieldName|get(missing_fields)]),
- ok
- end.
-
-check_dict(Dict, Reason) ->
- case get(Dict) of
- [] ->
- 1; % All ok.
- List ->
- io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]),
- 0
- end.
-
-check_dict_tolerant(Dict, Reason, Mode) ->
- case get(Dict) of
- [] ->
- 1; % All ok.
- List ->
- io:format("** ~ts (~ts) ->~n~p~n",[Reason, Dict, List]),
- case Mode of
- pedantic ->
- 0;
- _ ->
- 1
- end
- end.
-
-get_ebin_modnames(AppName) ->
- Wc=filename:join([code:lib_dir(AppName),"ebin",
- "*"++code:objfile_extension()]),
- TheFun=fun(X, Acc) ->
- [list_to_atom(filename:rootname(
- filename:basename(X)))|Acc] end,
- _Files=lists:foldl(TheFun, [], filelib:wildcard(Wc)).
-
-%%
-%% This function removes any erl_crash_dump* files found in the
-%% test server directory. Done only once when the test server
-%% is started.
-%%
-cleanup_crash_dumps() ->
- Dir = crash_dump_dir(),
- Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")),
- delete_files(Dumps).
-
-crash_dump_dir() ->
- filename:dirname(code:which(?MODULE)).
-
-tar_crash_dumps() ->
- Dir = crash_dump_dir(),
- case filelib:wildcard(filename:join(Dir, "erl_crash_dump*")) of
- [] -> {error,no_crash_dumps};
- Dumps ->
- TarFileName = filename:join(Dir,?crash_dump_tar),
- {ok,Tar} = erl_tar:open(TarFileName,[write,compressed]),
- lists:foreach(
- fun(File) ->
- ok = erl_tar:add(Tar,File,filename:basename(File),[])
- end,
- Dumps),
- ok = erl_tar:close(Tar),
- delete_files(Dumps),
- {ok,TarFileName}
- end.
-
-
-check_new_crash_dumps() ->
- Dir = crash_dump_dir(),
- Dumps = filelib:wildcard(filename:join(Dir, "erl_crash_dump*")),
- case length(Dumps) of
- 0 ->
- ok;
- Num ->
- test_server_ctrl:format(minor,
- "Found ~w crash dumps:~n", [Num]),
- append_files_to_logfile(Dumps),
- delete_files(Dumps)
- end.
-
-append_files_to_logfile([]) -> ok;
-append_files_to_logfile([File|Files]) ->
- NodeName=from($., File),
- test_server_ctrl:format(minor, "Crash dump from node ~tp:~n",[NodeName]),
- Fd=get(test_server_minor_fd),
- case file:read_file(File) of
- {ok, Bin} ->
- case file:write(Fd, Bin) of
- ok ->
- ok;
- {error,Error} ->
- %% Write failed. The following io:format/3 will probably also
- %% fail, but in that case it will throw an exception so that
- %% we will be aware of the problem.
- io:format(Fd, "Unable to write the crash dump "
- "to this file: ~p~n", [file:format_error(Error)])
- end;
- _Error ->
- io:format(Fd, "Failed to read: ~ts\n", [File])
- end,
- append_files_to_logfile(Files).
-
-delete_files([]) -> ok;
-delete_files([File|Files]) ->
- io:format("Deleting file: ~ts~n", [File]),
- case file:delete(File) of
- {error, _} ->
- case file:rename(File, File++".old") of
- {error, Error} ->
- io:format("Could neither delete nor rename file "
- "~ts: ~ts.~n", [File, Error]);
- _ ->
- ok
- end;
- _ ->
- ok
- end,
- delete_files(Files).
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% erase_dictionary(Vars) -> ok
-%% Vars = [atom(),...]
-%%
-%% Takes a list of dictionary keys, KeyVals, erases
-%% each key and returns ok.
-erase_dictionary([{Var, _Val}|Vars]) ->
- erase(Var),
- erase_dictionary(Vars);
-erase_dictionary([]) ->
- ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% fill_dictionary(KeyVals) -> void()
-%% KeyVals = [{atom(),term()},...]
-%%
-%% Takes each Key-Value pair, and inserts it in the process dictionary.
-fill_dictionary([{Var,Val}|Vars]) ->
- put(Var,Val),
- fill_dictionary(Vars);
-fill_dictionary([]) ->
- [].
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% get_username() -> UserName
-%%
-%% Returns the current user
-get_username() ->
- getenv_any(["USER","USERNAME"]).
-
-getenv_any([Key|Rest]) ->
- case catch os:getenv(Key) of
- String when is_list(String) -> String;
- false -> getenv_any(Rest)
- end;
-getenv_any([]) -> "".
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% get_os_family() -> OsFamily
-%%
-%% Returns the OS family
-get_os_family() ->
- {OsFamily,_OsName} = os:type(),
- OsFamily.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% hostatom()/hostatom(Node) -> Host; atom()
-%% hoststr() | hoststr(Node) -> Host; string()
-%%
-%% Returns the OS family
-hostatom() ->
- hostatom(node()).
-hostatom(Node) ->
- list_to_atom(hoststr(Node)).
-hoststr() ->
- hoststr(node()).
-hoststr(Node) when is_atom(Node) ->
- hoststr(atom_to_list(Node));
-hoststr(Node) when is_list(Node) ->
- from($@, Node).
-
-from(H, [H | T]) -> T;
-from(H, [_ | T]) -> from(H, T);
-from(_H, []) -> [].
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% framework_call(Callback,Func,Args,DefaultReturn) -> Return | DefaultReturn
-%%
-%% Calls the given Func in Callback
-framework_call(Func,Args) ->
- framework_call(Func,Args,ok).
-framework_call(Func,Args,DefaultReturn) ->
- CB = os:getenv("TEST_SERVER_FRAMEWORK"),
- framework_call(CB,Func,Args,DefaultReturn).
-framework_call(FW,_Func,_Args,DefaultReturn)
- when FW =:= false; FW =:= "undefined" ->
- DefaultReturn;
-framework_call(Callback,Func,Args,DefaultReturn) ->
- Mod = list_to_atom(Callback),
- case code:is_loaded(Mod) of
- false -> code:load_file(Mod);
- _ -> ok
- end,
- case erlang:function_exported(Mod,Func,length(Args)) of
- true ->
- EH = fun(Reason) -> exit({fw_error,{Mod,Func,Reason}}) end,
- SetTcState = case Func of
- end_tc -> true;
- init_tc -> true;
- _ -> false
- end,
- case SetTcState of
- true ->
- test_server:set_tc_state({framework,Mod,Func});
- false ->
- ok
- end,
- try apply(Mod,Func,Args) of
- Result ->
- Result
- catch
- exit:Why ->
- EH(Why);
- error:Why ->
- EH({Why,erlang:get_stacktrace()});
- throw:Why ->
- EH(Why)
- end;
- false ->
- DefaultReturn
- end.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% format_loc(Loc) -> string()
-%%
-%% Formats the printout of the line of code read from
-%% process dictionary (test_server_loc). Adds link to
-%% correct line in source code.
-format_loc([{Mod,Func,Line}]) ->
- [format_loc1({Mod,Func,Line})];
-format_loc([{Mod,Func,Line}|Rest]) ->
- ["[",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)];
-format_loc([{Mod,LineOrFunc}]) ->
- format_loc({Mod,LineOrFunc});
-format_loc({Mod,Func}) when is_atom(Func) ->
- io_lib:format("{~w,~w}",[Mod,Func]);
-format_loc(Loc) ->
- io_lib:format("~p",[Loc]).
-
-format_loc1([{Mod,Func,Line}]) ->
- [" ",format_loc1({Mod,Func,Line}),"]"];
-format_loc1([{Mod,Func,Line}|Rest]) ->
- [" ",format_loc1({Mod,Func,Line}),",\n"|format_loc1(Rest)];
-format_loc1({Mod,Func,Line}) ->
- ModStr = atom_to_list(Mod),
- case {lists:member(no_src, get(test_server_logopts)),
- lists:reverse(ModStr)} of
- {false,[$E,$T,$I,$U,$S,$_|_]} ->
- Link = if is_integer(Line) ->
- integer_to_list(Line);
- Line == last_expr ->
- list_to_atom(atom_to_list(Func)++"-last_expr");
- is_atom(Line) ->
- atom_to_list(Line);
- true ->
- Line
- end,
- io_lib:format("{~w,~w,<a href=\"~ts~ts#~s\">~w</a>}",
- [Mod,Func,
- test_server_ctrl:uri_encode(downcase(ModStr)),
- ?src_listing_ext,Link,Line]);
- _ ->
- io_lib:format("{~w,~w,~w}",[Mod,Func,Line])
- end.
-
-downcase(S) -> downcase(S, []).
-downcase([Uc|Rest], Result) when $A =< Uc, Uc =< $Z ->
- downcase(Rest, [Uc-$A+$a|Result]);
-downcase([C|Rest], Result) ->
- downcase(Rest, [C|Result]);
-downcase([], Result) ->
- lists:reverse(Result).
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% util_start() -> ok
-%%
-%% Start local utility process
-util_start() ->
- Starter = self(),
- case whereis(?MODULE) of
- undefined ->
- spawn_link(fun() ->
- register(?MODULE, self()),
- util_loop(#util_state{starter=Starter})
- end);
- _Pid ->
- ok
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% util_stop() -> ok
-%%
-%% Stop local utility process
-util_stop() ->
- try (?MODULE ! {self(),stop}) of
- _ ->
- receive {?MODULE,stopped} -> ok
- after 5000 -> exit(whereis(?MODULE), kill)
- end
- catch
- _:_ ->
- ok
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% unique_name() -> string()
-%%
-unique_name() ->
- ?MODULE ! {self(),unique_name},
- receive {?MODULE,Name} -> Name
- after 5000 -> exit({?MODULE,no_util_process})
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% util_loop(State) -> ok
-%%
-util_loop(State) ->
- receive
- {From,unique_name} ->
- Nr = erlang:unique_integer([positive]),
- Name = integer_to_list(Nr),
- if Name == State#util_state.latest_name ->
- timer:sleep(1),
- self() ! {From,unique_name},
- util_loop(State);
- true ->
- From ! {?MODULE,Name},
- util_loop(State#util_state{latest_name = Name})
- end;
- {From,stop} ->
- catch unlink(State#util_state.starter),
- From ! {?MODULE,stopped},
- ok
- end.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% call_trace(TraceSpecFile) -> ok
-%%
-%% Read terms on format {m,Mod} | {f,Mod,Func}
-%% from TraceSpecFile and enable call trace for
-%% specified functions.
-call_trace(TraceSpec) ->
- case catch try_call_trace(TraceSpec) of
- {'EXIT',Reason} ->
- erlang:display(Reason),
- exit(Reason);
- Ok ->
- Ok
- end.
-
-try_call_trace(TraceSpec) ->
- case file:consult(TraceSpec) of
- {ok,Terms} ->
- dbg:tracer(),
- %% dbg:p(self(), [p, m, sos, call]),
- dbg:p(self(), [sos, call]),
- lists:foreach(fun({m,M}) ->
- case dbg:tpl(M,[{'_',[],[{return_trace}]}]) of
- {error,What} -> exit({error,{tracing_failed,What}});
- _ -> ok
- end;
- ({f,M,F}) ->
- case dbg:tpl(M,F,[{'_',[],[{return_trace}]}]) of
- {error,What} -> exit({error,{tracing_failed,What}});
- _ -> ok
- end;
- (Huh) ->
- exit({error,{unrecognized_trace_term,Huh}})
- end, Terms),
- ok;
- {_,Error} ->
- exit({error,{tracing_failed,TraceSpec,Error}})
- end.
-