% % An ECLiPSe test harness for Ulrich Neumerkel's syntax texts at % http://www.complang.tuwien.ac.at/ulrich/iso-prolog/conformity_assessment % % html_to_facts(FileIn, FileOut) generate Prolog facts from web page % % run(File, Language) produces plain text output % run_html(File, Language) produces html table in File_Language.html % % File is the name of a file containing facts for ulrich_test/3. % Language is an ECLiPSe module/library name. % % There is no automatic detection of compliance/noncompliance, this is % supposed to be decided by inspection. The html 'Remarks' column is % generated from the texts provided manually in the note/3 predicate. % % Author: Joachim Schimpf, 2011 % This code is given to the public domain "as is". Use at your own risk. % %---------------------------------------------------------------------- % Run the tests in file (containing ulrich_test/3 terms) % with plain text output to stdout %---------------------------------------------------------------------- run(File, Language) :- open(File, read, S), Module = m, ( current_module(Module) -> erase_module(Module) ; true ), create_module(Module, [], Language), do_test(S, Module, Language). do_test(S, M, L) :- at(S, BOF), ( read(S, date_generated(_Date)) -> true ; seek(S, BOF) ), ( read(S, ulrich_test(N,Input,Wanted)) -> ( substring(Input, " /**/", 1) -> true /* continuation query */ ; erase_module(M), create_module(M, [], L) ), nl_if_needed(output), printf("-------------------- test %d --------------------%n", [N]), printf("Input: %w%n", [Input]), printf("Expect: %w%n", [Wanted]), catch(( open(string(Input), read, SS), repeat, ( read_term(SS, Goal, [variable_names(VN)])@M -> true ; nl_if_needed(output), printf("%% syntax error%n",[]), fail ), ( Goal == end_of_file -> close(SS), ! ; ( call(Goal)@M -> nl_if_needed(output), ( VN==[] -> printf("%% succeeds%n",[]) ; printf("%% succeeds",[]), ( foreach(Name=Val,VN), param(M) do printf(", %w=%q",[Name,Val])@M ), writeln(.) ) ; nl_if_needed(output), printf("%% fails%n",[]) ), fail ) ), Tag, ( nl_if_needed(output), ( Tag=error(Error,_) -> true ; Error=Tag ), printf("%% throws %w%n",[Error]) ) ), do_test(S, M, L) ; close(S) ). nl_if_needed(Stream) :- ( get_stream_info(Stream, last_written, 10) -> true ; nl ). %---------------------------------------------------------------------- % Code for producing html result table % in file table__.html %---------------------------------------------------------------------- run_html(File, Language) :- concat_string([table_,File,'_',Language,'.html'], OutFile), open(OutFile, write, output), open(File, read, S), at(S, BOF), ( read(S, date_generated(Date)) -> true ; seek(S, BOF), Date="?" ), Module = m, ( current_module(Module) -> erase_module(Module) ; true ), create_module(Module, [], Language), writeln(""), writeln("

ISO-Prolog Syntax Compatibility

"), introduction(Language, Date, Intro), printf("

%s

", [Intro]), writeln(""), get_flag(version_as_list, VL), join_string(VL, ., Vers), printf("" "", [Vers,Language]), do_test_html(S, Module, Language), writeln("
NrInputISO expectedECLiPSe %w (%w)Remarks
"), writeln(""), close(output). do_test_html(S, M, L) :- ( read(S, ulrich_test(N,Input,Wanted)) -> ( substring(Input, " /**/", 1) -> true /* continuation query */ ; erase_module(M), create_module(M, [], L) ), htmlify_string(Input, InputHtml), htmlify_string(Wanted, WantedHtml), printf("%d%w%w", [N,InputHtml,WantedHtml]), at(output, Pos0), block(( open(string(Input), read, SS), repeat, ( read_term(SS, Goal, [variable_names(VN)])@M -> true ; printf("syntax error
",[]), fail ), ( Goal == end_of_file -> close(SS), ! ; at(output, Pos), ( call(Goal)@M -> ( at(output) > Pos -> write("
") ; true ), ( VN=[N1=V1|VNs] -> printf("%w = %q",[N1,V1])@M, ( foreach(N2=V2,VNs), param(M) do printf(", %w = %q",[N2,V2])@M ), printf("
",[]) ; at(output) > Pos -> true ; printf("succeeds
",[]) ) ; ( at(output) > Pos -> write("
") ; true ), printf("fails
",[]) ), fail ) ), Tag, ( ( at(output) > Pos0 -> write("
") ; true ), ( Tag=error(Error,_) -> functor(Error,ErrName,_) ; ErrName=error ), printf("%w
", [ErrName]) ) ), ( note(L, N, Note) -> true ; Note = "Ok" ), ( substring(Note, "Ok", 1) -> printf("%w%n",[Note]) ; printf("%w%n",[Note]) ), do_test_html(S, M, L) ; close(S) ). br_if_needed(Stream) :- ( get_stream_info(Stream, last_written, 10) -> true ; write("
") ). htmlify_string(In, Out) :- string_list(In, InList), htmlify_list(InList, OutList), string_list(Out, OutList). htmlify_list([], []). htmlify_list([C|Cs], HtmlCs) :- htmlify(C, HtmlCs, HtmlCs0), htmlify_list(Cs, HtmlCs0). htmlify(10, [0'<,0'b,0'r,0'>|Cs], Cs) :- !. htmlify(0'>, [0'&,0'g,0't,0';|Cs], Cs) :- !. htmlify(0'<, [0'&,0'l,0't,0';|Cs], Cs) :- !. htmlify(0'&, [0'&,0'a,0'm,0'p,0';|Cs], Cs) :- !. htmlify(0' , [0'&,0'n,0'b,0's,0'p,0';|Cs], Cs) :- !. htmlify(C, [C|Cs], Cs). %---------------------------------------------------------------------- % Notes to be printed in the "remarks" column (html output) %---------------------------------------------------------------------- note(iso_strict,N,S) :- note(iso,N,S). note(_iso,N,"Ok, debatable standard interpretation (7.10.5.d).") :- memberchk(N, [32,34]). note(iso,N,"Ok, extra spacing.") :- memberchk(N, [27,28,30,31,33,133,137,138,139,140, 150,151,153,154,156,163,169,175,181,183,185,188,191,192,194, 200,215,218,222,223,226,227,236,238,248,249,257,259,260]). note(iso,173,"Ok, fails on some machines due to precision."). %note(eclipse_language,N,"Equivalent to X=16'41. (see 'iso_escapes')") :- % memberchk(N, [123,124]). %note(eclipse_language,N,"Equivalent to X=16'1. (see 'iso_escapes')") :- % memberchk(N, [125]). note(eclipse_language,N,"ECLiPSe extension (see 'nl_in_quotes')") :- memberchk(N,[5,6,177]). note(eclipse_language,N,"Incompatibility traditional/ISO (see 'iso_escapes')") :- memberchk(N,[15,18,101,102,103]). note(eclipse_language,16,"SICStus? feature (see 'iso_escapes')"). note(eclipse_language,N,"Quintus feature (see 'iso_escapes')") :- memberchk(N,[17,19,21,241]). note(eclipse_language,N,"ECLiPSe extension (see 'bar_is_no_atom')") :- memberchk(N,[31]). note(eclipse_language,N, "By default, the right-quote is a normal graphic character in ECLiPSe," " and must therefore not be escaped within atoms/strings" " (change via chtab(0'`,string_quote))") :- memberchk(N,[38,39,40,178]). note(eclipse_language,N, "By default, the right-quote is a normal graphic character in ECLiPSe" " and can therefore be used to form atoms" " (change via chtab(0'`,string_quote))") :- memberchk(N,[111,112,113,26,264]). note(eclipse_language,N,"Point not required in ECLiPSe (see 'float_needs_point')") :- memberchk(N,[47,49,50,53]). note(eclipse_language,N,"Sign must be adjacent to number (see 'blanks_after_sign')") :- memberchk(N,[56,59,64]). note(eclipse_language,N,"Sign must be unquoted (see 'blanks_after_sign')") :- memberchk(N,[57,58,61]). note(eclipse_language,N,"Plus and minus are both signs (see 'plus_is_no_sign')") :- memberchk(N,[65,67]). note(eclipse_language,N,"ECLiPSe extension (see 'iso_restrictions')") :- memberchk(N,[70,71,72,77,78,82,83,84,86,87,88,90,92,106,134,148,158, 161,162,235,237,238,240,243,268]). note(eclipse_language,75,"ECLiPSe extension (see 'limit_arg_precedence')."). note(eclipse_language,N, "We do deliberately not allow the doubling of quotes to represent" " a quote. The backslash-escape must be used for that. The reason" " is that (a) consecutive atoms are possible in Prolog, and we" " prefer '+''Atom' to stand for +('Atom') rather than for" " '+\\'Atom'; and (b) we use \"string1\"\"string2\" for" " \"string1string2\", i.e. adjacent strings are implicitly" " concatenated (see 'doubled_quote_is_quote')") :- memberchk(N,[100,115,116,165,179]). note(eclipse_language,N,"Backward compatibility feature (see 'iso_escapes')") :- memberchk(N,[117,120,126,197,210,211,213,214,232]). note(eclipse_language,171,"String data type in ECLiPSe (change via chtab(0'\",list_quote))"). note(eclipse_language,N,"Different radix notation (see 'iso_base_prefix')") :- memberchk(N,[121,122,174,175,176,216]). note(eclipse_language,N,"Equally valid output") :- memberchk(N,[135,137,139,140,182,183,184,185,188,191,192]). note(eclipse_language,N,"ISO predicate/function") :- memberchk(N,[170,172,173]). introduction(eclipse_language, Date, Text) :- !, concat_string([ "This is a mixture of tests for input syntax and for writeq output." " The test instances here are the ones" " collected by Ulrich Neumerkel" " (as of ", Date, ")." " This table is for ECLiPSe modules written in 'eclipse_language'." " For modules using 'iso'-language, see separate table." " The comments explain non-ISO features and say which syntax option" " controls the corresponding behaviour." ], Text). introduction(Language, Date, Text) :- concat_string([ "This is a mixture of tests for input syntax and for writeq output." " The test instances here are the ones" " collected by Ulrich Neumerkel" " (as of ", Date, "). This table is for ECLiPSe modules using the '", Language, "' language module." " For modules in native ECLiPSe syntax, see separate table." ], Text). %---------------------------------------------------------------------- % Turn Ulrich's web page into Prolog facts %---------------------------------------------------------------------- :- lib(regex). html_to_facts :- html_to_facts("ulrich_tests.html", "iso_spec"). html_to_facts(FileIn, FileOut) :- open(FileIn, read, In), open(FileOut, write, Out, [end_of_line(lf)]), get_flag(unix_time, Time), local_time_string(Time, "%Y-%m-%d", Date), writeln(Out, "% These are Ulrich Neumerkel's ISO syntax tests as Prolog facts"), writeln(Out, "% Generated from http://www.complang.tuwien.ac.at/ulrich/iso-prolog/conformity_assessment"), write_term(Out, date_generated(Date), [quoted(true),nl(true),fullstop(true)]), compile_pattern("([0-9]+)[ \t]*(.*)$", [], P1), compile_pattern("(.*)$", [], P2), repeat, ( read_string(In, end_of_line, _, TestLine) -> matchsub(P1, TestLine, [], [S,S1,Text0]), ( number_string(N,S), number_string(N,S1) -> true ; printf("Ignored line: %w%n", [TestLine]), fail ), html_to_txt(Text0, Text), ( read_string(In, end_of_line, _, ExpLine) -> true ; printf("Missing followup line to: %w%n", [TestLine]), fail ), ( matchsub(P2, ExpLine, [], [_Standard,Expected0]) -> true ; printf("Missing followup line to: %w%n", [TestLine]), fail ), html_to_txt(Expected0, Expected), write_term(Out, ulrich_test(N, Text, Expected), [quoted(true),nl(true),fullstop(true)]), fail ; !, close(In) ). html_to_txt(Html, Text) :- replace("
", "\n", Html, Text1), replace(" ", " ", Text1, Text2), replace(">", ">", Text2, Text3), replace("<", "<", Text3, Text4), replace("&", "&", Text4, Text5), replace(".*", "", Text5, Text6), replace(".*", "", Text6, Text). replace(Pattern, New, String, NewString) :- split(Pattern, String, [], Parts), ( fromto(Parts, [NoMatch,_Match|NMs], NMs, [Last]), fromto(Repl, [NoMatch, Subst|NSs], NSs, [Last]), param(New) do Subst = New ), concat_string(Repl, NewString).