aboutsummaryrefslogtreecommitdiffstats
path: root/lib/common_test/src/ct_config_xml.erl
diff options
context:
space:
mode:
authorErlang/OTP <[email protected]>2010-06-11 09:08:08 +0000
committerErlang/OTP <[email protected]>2010-06-11 09:08:08 +0000
commitc0f23851df50d6215981805102754b590c05acec (patch)
tree5a202fe2abc7cd77e9808930758b81d05957fab6 /lib/common_test/src/ct_config_xml.erl
parenta28aa321007f62ae4dce415cd190778c3ac184e7 (diff)
parent2d7ba88ebbb59a473dbcefd0f9dee1f1b816935e (diff)
downloadotp-c0f23851df50d6215981805102754b590c05acec.tar.gz
otp-c0f23851df50d6215981805102754b590c05acec.tar.bz2
otp-c0f23851df50d6215981805102754b590c05acec.zip
Merge branch 'peppe/common_test_r14_dev_2' into dev
* peppe/common_test_r14_dev_2: Misc documentation updates Add documentation for run_test program Step vsn for test_server to 3.4 Make {repeat*,N} property in group execute the group N times exactly Fix so that ct_run converts relative diretories in the code path to absolute Fix bug in handling framework:end_tc timeouts Fix bug that prevents the interactive shell mode to start properly Fix failing multiply timetrap test case Minor fixes in code and test suites Add support for executing pre-loaded suites (e.g. modules loaded as binaries) Add test suite for remote loading of binary suites Fix error with {repeat,0} property in groups causing double iterations Add support for config info functions (e.g. init_per_suite/0) Add support for dynamic timetrap handling Have end_per_testcase run even after timetrap_timeout and abort_testcase Flush old DOWN messages in demonitor Add groups in test specifications Add new tests for test case groups and test specifications Improve and fix various test suites Add event_handler_init start flag that can pass init arguments to event handlers ... OTP-8703 peppe/common_test_r14_dev_2
Diffstat (limited to 'lib/common_test/src/ct_config_xml.erl')
-rw-r--r--lib/common_test/src/ct_config_xml.erl118
1 files changed, 118 insertions, 0 deletions
diff --git a/lib/common_test/src/ct_config_xml.erl b/lib/common_test/src/ct_config_xml.erl
new file mode 100644
index 0000000000..8a6e75e635
--- /dev/null
+++ b/lib/common_test/src/ct_config_xml.erl
@@ -0,0 +1,118 @@
+%%--------------------------------------------------------------------
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010. 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
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%----------------------------------------------------------------------
+%% File : ct_config_xml.erl
+%% Description : CT callback module for reading configs from XML files
+%%
+%% Created : 16 February 2010
+%%----------------------------------------------------------------------
+-module(ct_config_xml).
+-export([read_config/1, check_parameter/1]).
+
+% read config file
+read_config(ConfigFile) ->
+ case catch do_read_xml_config(ConfigFile) of
+ {ok, Config}->
+ {ok, Config};
+ {error, Error, ErroneousString}->
+ {error, Error, ErroneousString}
+ end.
+
+% check file exists
+check_parameter(File)->
+ case filelib:is_file(File) of
+ true->
+ {ok, {file, File}};
+ false->
+ {error, {nofile, File}}
+ end.
+
+% actual reading of the config
+do_read_xml_config(ConfigFile)->
+ case catch xmerl_sax_parser:file(ConfigFile,
+ [{event_fun, fun event/3},
+ {event_state, []}]) of
+ {ok, EntityList, _}->
+ {ok, lists:reverse(transform_entity_list(EntityList))};
+ Oops->
+ {error, parsing_failed, Oops}
+ end.
+
+% event callback for xmerl_sax_parser
+event(Event, _LineNo, State) ->
+ tag(Event, State).
+
+% document start
+tag(startDocument, State) ->
+ State;
+
+% start of the config
+tag({startElement, _Uri, "config", _QName, _Attributes}, []) ->
+ [{"config", []}];
+
+% start tag
+tag({startElement, _Uri, Name, _QName, _Attributes}, Tags) ->
+ [{Name, []}|Tags];
+
+% value
+tag({characters, String}, [{Tag, _Value}|Tags]) ->
+ [{Tag, String}|Tags];
+
+% end tag
+tag({endElement, _Uri, _Name, _QName},
+ [Entity, {PrevEntityTag, PrevEntityValue}|Tags]) ->
+ NewHead = {PrevEntityTag, [Entity|PrevEntityValue]},
+ [NewHead|Tags];
+
+% end of the config
+tag({endElement, _Uri, "config", _QName}, [{"config", Config}]) ->
+ Config;
+
+% end of document, return result
+tag(endDocument, {_Tags, Result}) ->
+ Result;
+
+% default
+tag(_El, State) ->
+ State.
+
+% transform of the ugly deeply nested entity list to the key-value "tree"
+transform_entity_list(EntityList)->
+ lists:map(fun transform_entity/1, EntityList).
+
+% transform entity from {list(), list()} to {atom(), term()}
+transform_entity({Tag, [Value|Rest]}) when
+ is_tuple(Value)->
+ {list_to_atom(Tag), transform_entity_list(lists:reverse([Value|Rest]))};
+transform_entity({Tag, String})->
+ case list_to_term(String) of
+ {ok, Value}->
+ {list_to_atom(Tag), Value};
+ Error->
+ throw(Error)
+ end.
+
+% transform a string with Erlang terms
+list_to_term(String) ->
+ {ok, T, _} = erl_scan:string(String++"."),
+ case catch erl_parse:parse_term(T) of
+ {ok, Term} ->
+ {ok, Term};
+ Error ->
+ {error, Error, String}
+ end.