%%%-------------------------------------------------------------------
%%% 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.
