aboutsummaryrefslogtreecommitdiffstats
path: root/lib/xmerl/test/test_xmerl.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/xmerl/test/test_xmerl.erl')
-rw-r--r--lib/xmerl/test/test_xmerl.erl329
1 files changed, 329 insertions, 0 deletions
diff --git a/lib/xmerl/test/test_xmerl.erl b/lib/xmerl/test/test_xmerl.erl
new file mode 100644
index 0000000000..d2c5d35a85
--- /dev/null
+++ b/lib/xmerl/test/test_xmerl.erl
@@ -0,0 +1,329 @@
+%%%-------------------------------------------------------------------
+%%% File : test_xmerl.erl
+%%% Author : Bertil Karlsson <bertil@finrod>
+%%% Description :
+%%%
+%%% Created : 2 Dec 2003 by Bertil Karlsson <bertil@finrod>
+%%%-------------------------------------------------------------------
+-module(test_xmerl).
+
+-compile(export_all).
+
+-define(xmerl_test_root,"/ldisk/xml/xml-test-suite/xmlconf").
+-define(jclark_subdir,"/ldisk/xml/xml-test-suite/xmlconf/xmltest").
+-define(sun_subdir,"/ldisk/xml/xml-test-suite/xmlconf/sun").
+-define(xerox_subdir,"/ldisk/xml/xml-test-suite/xmlconf/japanese").
+-define(oasis_subdir,"/ldisk/xml/xml-test-suite/xmlconf/oasis").
+-define(ibm_subdir,"/ldisk/xml/xml-test-suite/xmlconf/ibm").
+
+
+get_xmlconf() ->
+ FileName = filename:join(?xmerl_test_root,"xmlconf.xml"),
+ {ok,L} = read_file(FileName),
+ L.
+
+read_file(FileName) ->
+ case file:read_file(FileName) of
+ {ok,Binary} ->
+ {ok,binary_to_list(Binary)};
+ Err ->
+ exit({error,Err})
+ end.
+
+get_file(F="sun"++_Rest) ->
+ get_sun_xml(F);
+get_file(F="jclark-xmltest") ->
+ get_jclark_xml(F);
+get_file(F="xerox-japanese") ->
+ get_xerox_xml(F);
+get_file(F="nist-oasis") ->
+ get_oasis_xml(F);
+get_file("ibm-"++Rest) ->
+ get_ibm_xml(Rest).
+
+
+get_sun_xml(F) ->
+ FileName = filename:join([?sun_subdir,F++".xml"]),
+ {ok,L} = read_file(FileName),
+ L.
+get_jclark_xml(_F) ->
+ FileName = filename:join([?jclark_subdir,"xmltest.xml"]),
+ {ok,L} = read_file(FileName),
+ L.
+get_xerox_xml(_F) ->
+ FileName = filename:join([?xerox_subdir,"japanese.xml"]),
+ {ok,L} = read_file(FileName),
+ L.
+get_oasis_xml(_F) ->
+ FileName = filename:join([?oasis_subdir,"oasis.xml"]),
+ {ok,L} = read_file(FileName),
+ L.
+get_ibm_xml(F) ->
+ FileName = filename:join([?ibm_subdir,"ibm_oasis_"++F++".xml"]),
+ {ok,L} = read_file(FileName),
+ L.
+
+%% The generated xml file must have a unique name: concatenate the
+%% sub directory name and the ID of the TEST tag.
+%% In each file the start of xmlconf.xml is included. Then a TEST
+%% follows. It must be properly finished with end tags.
+extract_TESTSUITEs() ->
+ TestSuites = ["sun-valid","sun-invalid","sun-not-wf","sun-error",
+ "jclark-xmltest","xerox-japanese","nist-oasis",
+ "ibm-invalid","ibm-not-wf","ibm-valid"],
+ Pid=spawn_link(?MODULE,ticker,[]),
+ lists:foreach(fun extract_TESTCASES/1,TestSuites),
+ generate_testfuncs(),
+ xmerl_ticker ! finished.
+
+extract_TESTCASES(Suite) ->
+% io:format("extract_TESTCASES:1~n",[]),
+ L = get_file(Suite), % fetch xml file in sub directory
+% io:format("Reading Suite: ~p~n",[Suite]),
+ Prol = xmlconf_prolog(),
+% io:format("Reading xmlconf.xml~n",[]),
+ xmerl_ticker ! {suite,Suite},
+ extract_TESTs(Suite,L,Prol,[]).
+
+extract_TESTs(Suite,TCfile,Prol,TCAcc) ->
+ case find_start_tag(Suite,TCfile,[],TCAcc) of
+ {[],_,_,_} -> ok;
+%% print_filenames();
+ {T,Rest,TC,ID} ->
+ generate_TEST(Suite,ID,Prol,TC,T),
+ extract_TESTs(Suite,Rest,Prol,TC)
+% file_output("out.xml",L1)
+ end.
+
+generate_TEST(Suite,ID,Prolog,TC,T) ->
+% GenDir = filename:join(["test",sub_dir(Suite)]),
+ GenDir = sub_dir(Suite),
+ Extension = extension(Suite),
+% Filename = filename:join([GenDir,ID ++ Extension]),
+ Filename = mk_filename(Suite,GenDir,ID ++ Extension),
+ save_filename(Suite,ID),
+ {ok,IOF}=file:open(Filename,[write]),
+ TSEnding = testsuite_end(),
+ TCEnding = testcases_end(length(TC)),
+ file:write(IOF,Prolog ++ "\n\n" ++ TC ++ "\n\n" ++ T ++ "\n\n" ++
+ TCEnding++ "\n\n" ++ TSEnding),
+ file:close(IOF).
+
+save_filename("xerox-japanese",Name) ->
+ NewName = "japanese-"++Name,
+ save_filename1(NewName);
+save_filename(_,Name) ->
+ save_filename1(Name).
+
+save_filename1(Name) ->
+ Saves = case get(filenames) of
+ undefined ->
+ [];
+ L -> L
+ end,
+ put(filenames,[Name|Saves]).
+
+generate_testfuncs() ->
+ Filenames = get(filenames),
+ Res = (catch generate_testfuncs(lists:reverse(Filenames))),
+ io:format("~p~n",[Res]).
+generate_testfuncs(Filenames) ->
+ file:delete(testfuncs.erl),
+ {ok,IOF} = file:open(testfuncs.erl,[append]),
+ lists:foreach(fun(X) ->
+ RN = filename:rootname(X),
+ TestDirPath = "filename:join([?config(data_dir,Config),"++xmerl_SUITE:testcase_dir(list_to_atom(RN)),
+ file:write(IOF,"'"++RN++"'(suite) -> [];\n'"++RN++
+ "'(Config) ->\n"++
+ " ?line file:set_cwd(?config(data_dir,Config)),\n"++
+ " ?line {A,_} = xmerl_scan:file("++
+ TestDirPath++",\""++RN++".xml\"])"++
+ ",[]),\n"++
+ " ?line C = xmerl:export([A],xmerl_test)."++
+ "\n\n") end,Filenames),
+ file:close(IOF),
+ io:format("~ngenerated ~w testcases.erl.~n",[length(Filenames)]).
+
+print_filenames() ->
+ Filenames = get(filenames),
+ io:format("~n,~w files generated.~n[",[length(Filenames)]),
+ lists:foreach(fun(X) ->
+ io:format("~p,",[list_to_atom(X)]) end,
+ Filenames),
+ io:format("]~n"),
+ put(filenames,[]).
+
+
+mk_filename("xerox-japanese",GenDir,Name) ->
+ filename:join([GenDir,"japanese-"++Name]);
+mk_filename(_,GenDir,Name) ->
+ filename:join([GenDir,Name]).
+
+file_output(Filename,Content) ->
+ {ok,IOF}=file:open(Filename,[write]),
+ C1 = xmlconf_prolog(),
+ C2 = xmlconf_end(),
+ file:write(IOF,C1 ++ "\n\n" ++ Content ++ "\n\n" ++ C2),
+ file:close(IOF).
+
+
+find_start_tag(Suite,"<TESTCASES"++Rest,TAcc,TCAcc) ->
+ {L,Rest2}=parse_until_end_TCs_skip_base(Rest,[]),
+ find_start_tag(Suite,Rest2,TAcc,["<TESTCASES"++L|TCAcc]);
+find_start_tag(Suite,"</TESTCASES>"++Rest,TAcc,[H|T]) ->
+ find_start_tag(Suite,Rest,TAcc,T);
+find_start_tag(Suite,"<TEST"++Rest,TAcc,TCAcc) ->
+ Id = extract_ID(Rest),
+ {L,Rest2} = parse_until_end_T(Suite,Rest,[]),
+ {"<TEST" ++ L,Rest2,TCAcc,Id};
+find_start_tag(Suite,[H|T],TAcc,TCAcc) ->
+ find_start_tag(Suite,T,TAcc,TCAcc);
+find_start_tag(_,[],TAcc,TCAcc) -> % no more tests
+ {TAcc,[],TCAcc,[]}.
+
+parse_until_end_T(Suite,"URI"++Rest,Acc) ->
+ {Up2URI,Rest2}=parse_upto_URI_val(Suite,Rest,["URI"]),
+ parse_until_end_T(Suite,Rest2,[Up2URI|Acc]);
+% parse_until_end_T(Suite,"</TEST>"++Rest,Acc) ->
+% {lists:flatten(lists:reverse(["</TEST>"|Acc])),Rest};
+parse_until_end_T(Suite,"OUTPUT"++Rest,Acc) ->
+ {Up2OUTPUT,Rest2}=parse_upto_URI_val(Suite,Rest,["OUTPUT"]),
+ parse_until_end_T(Suite,Rest2,[Up2OUTPUT|Acc]);
+parse_until_end_T(_Suite,"</TEST>"++Rest,Acc) ->
+ {lists:flatten(lists:reverse(["</TEST>"|Acc])),Rest};
+parse_until_end_T(Suite,[H|T],Acc) ->
+ parse_until_end_T(Suite,T,[H|Acc]);
+parse_until_end_T(_,[],Acc) ->
+ exit({error,{"unexpected end",lists:reverse(Acc)}}).
+
+parse_upto_URI_val(Suite,[H|Rest],Acc) when H==$\t;H==$\n;H==$\s ->
+ parse_upto_URI_val(Suite,Rest,[H|Acc]);
+parse_upto_URI_val(Suite,[H|Rest],Acc) when H/="=" ->
+ {lists:flatten(lists:reverse([H|Acc])),Rest};
+parse_upto_URI_val(Suite,[H|Rest],Acc) ->
+ parse_upto_URI_val2(Suite,Rest,[H|Acc]).
+
+parse_upto_URI_val2(Suite,[H|Rest],Acc) when H==$"; H==$' ->
+ SubDir = sub_dir(Suite),
+ {lists:flatten(lists:reverse([$/,SubDir,H|Acc])),Rest};
+parse_upto_URI_val2(Suite,[H|T],Acc) ->
+ parse_upto_URI_val2(Suite,T,[H|Acc]).
+
+parse_until_end_TCs_skip_base(">"++Rest,Acc) ->
+ {lists:flatten(lists:reverse(["\n",">"|Acc])),Rest};
+parse_until_end_TCs_skip_base("xml:base="++Rest,Acc) ->
+ Rest2=skip_base_def(Rest),
+ parse_until_end_TCs_skip_base(Rest2,Acc) ->
+parse_until_end_TCs_skip_base([H|T],Acc) ->
+ parse_until_end_TCs_skip_base(T,[H|Acc]).
+
+skip_base_def([Del|R]) ->
+ skip_base_def(R,Del).
+skip_base_def([Del|R],Del) ->
+ R;
+skip_base_def([_H|R],Del) ->
+ skip_base_def(R,Del).
+
+% parse_end_T("</TEST>"++Rest,Acc) ->
+% {lists:flatten(lists:reverse(["</TEST>"|Acc])),Rest};
+% parse_end_T([H|T],Acc) ->
+% parse_end_T(T,[H|Acc]).
+
+
+xmlconf_prolog() ->
+ FC = get_xmlconf(),
+ parse_xmlconf_prolog(FC,[]).
+
+
+%%
+extract_ID("ID"++Rest) ->
+ extract_ID2(Rest);
+extract_ID([H|T]) ->
+ extract_ID(T).
+
+extract_ID2([H|Rest]) when H==$";H==$' ->
+ extract_IDval(Rest,[]);
+extract_ID2([H|T]) -> %skip '=' and white space
+ extract_ID2(T).
+
+extract_IDval([H|Rest],Acc) when H==$";H==$' ->
+ lists:flatten(lists:reverse(Acc));
+extract_IDval([H|T],Acc) ->
+ extract_IDval(T,[H|Acc]).
+
+
+testsuite_end() ->
+ "</TESTSUITE>".
+
+testcases_end(0) ->
+ "";
+testcases_end(N) ->
+ "</TESTCASES>" ++ "\n" ++testcases_end(N-1).
+
+xmlconf_end() ->
+ "</TESTSUITE>".
+
+
+parse_xmlconf_prolog("href=\"xmlconformance.xsl\""++Rest,Acc) ->
+ HRef = lists:reverse("href=\"../../xmlconformance.xsl\""),
+ parse_xmlconf_prolog(Rest,HRef++Acc);
+parse_xmlconf_prolog("<!DOCTYPE TESTSUITE SYSTEM \"testcases.dtd\""++Rest,Acc) ->
+ Rest2 = skip_entity_defs(Rest),
+ DocType = lists:reverse("<!DOCTYPE TESTSUITE SYSTEM \"../../testcases.dtd\">"),
+ parse_xmlconf_prolog(Rest2,DocType++Acc);
+parse_xmlconf_prolog("<TESTSUITE"++Rest,Acc) ->
+ Acc2 = parse_until_TESTSUITE_tag(Rest,[]),
+ lists:flatten(lists:reverse([Acc2,"<TESTSUITE"|Acc]));
+parse_xmlconf_prolog([H|T],Acc) ->
+ parse_xmlconf_prolog(T,[H|Acc]);
+parse_xmlconf_prolog([],Acc) ->
+ exit({error,{"unexpected end",lists:reverse(Acc)}}).
+
+parse_until_TESTSUITE_tag(">"++_Rest,Acc) ->
+ lists:flatten(lists:reverse([">"|Acc]));
+parse_until_TESTSUITE_tag([H|T],Acc) ->
+ parse_until_TESTSUITE_tag(T,[H|Acc]);
+parse_until_TESTSUITE_tag([],Acc) ->
+ exit({error,{"unexpected end",lists:reverse(Acc)}}).
+
+skip_entity_defs("]>"++Rest) ->
+ Rest;
+skip_entity_defs([H|T]) ->
+ skip_entity_defs(T).
+
+sub_dir("jclark-xmltest") ->
+ "xmerl_SUITE_data/xmltest";
+sub_dir("xerox-japanese") ->
+ "xmerl_SUITE_data/japanese";
+sub_dir("sun"++_Rest) ->
+ "xmerl_SUITE_data/sun";
+sub_dir("nist-oasis") ->
+ "xmerl_SUITE_data/oasis";
+sub_dir("ibm"++_Rest) ->
+ "xmerl_SUITE_data/ibm".
+
+extension("ibm"++_R) ->
+ "";
+extension(_) ->
+ ".xml".
+
+%*****************************
+ticker() ->
+ register(xmerl_ticker,self()),
+ receive
+ {suite,Name} ->
+ io:format("~nGenerating suite ~p",[Name])
+ end,
+ ticker_loop().
+
+ticker_loop() ->
+ receive
+ {suite,Name} ->
+ io:format("~nGenerating suite ~p",[Name]),
+ ticker_loop();
+ finished ->
+ ok
+ after 400 ->
+% io:format(".",[]),
+ ticker_loop()
+ end.
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-10 09:35:52 +0000