[m-rev.] for review: add a test coverage scenario
Erwan Jahier
Erwan.Jahier at irisa.fr
Fri Jul 20 00:25:50 AEST 2001
Maybe this code is not mature enough (too much XXXs, not enough
tested), but I would like to commit it before I leave on
holidays. Any objection?
--
Estimated hours taken: 40
branches: main.
Add a scenario which provides commands that perform predicate and
call site coverage.
extras/morphine/source/generate_pred_cov.m:
(New file) Program that parses Mercury modules to
generate a monitor that performs predicate coverage.
extras/morphine/source/generate_call_site_cov.m:
(New file) Program that parses Mercury modules to generate
a monitor that performs call site coverage.
extras/morphine/source/coverage_util.m:
(New file) Common stuff to generate_pred_cov.m and
generate_call_site_cov.m
extras/morphine/source/generate_pred_cov.in:
extras/morphine/source/generate_call_site_cov.in:
(New files) Used to generate the call_site_cov and pred_cov
monitors.
extras/morphine/source/coverage.op:
(New file) New scenario that provides call_site_cov/2 and
pred_cov/2 commands, which perform the predicate and call
site coverage of a Mercury module.
extras/morphine/non-regression-tests/queens.in:
extras/morphine/non-regression-tests/queens.exp:
Add a test case for the pred_cov/2 and call_site_cov/2
commands.
extras/morphine/INSTALL_MORPHINE:
compile generate_call_site_cov.m and generate_pred_cov.m
modules when installing morphine.
Index: extras/morphine/INSTALL-MORPHINE
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/morphine/INSTALL-MORPHINE,v
retrieving revision 1.5
diff -u -d -u -r1.5 INSTALL-MORPHINE
--- extras/morphine/INSTALL-MORPHINE 2000/03/10 10:24:52 1.5
+++ extras/morphine/INSTALL-MORPHINE 2001/07/19 14:11:16
@@ -63,7 +63,7 @@
EOF
cd ..
-echo "Compiling the Mercury program listing.m..."
+echo "Compiling Mercury programs..."
[ -d bin ] || mkdir bin
cd ${MERCURY_MORPHINE_DIR}/source
mmake listing.depend
@@ -71,6 +71,19 @@
mv ${MERCURY_MORPHINE_DIR}/source/listing ${MERCURY_MORPHINE_DIR}/bin/
chmod a+x ${MERCURY_MORPHINE_DIR}/bin/listing
mmake listing.realclean
+
+mmake generate_pred_cov.depend
+mmake generate_pred_cov
+mv ${MERCURY_MORPHINE_DIR}/source/generate_pred_cov ${MERCURY_MORPHINE_DIR}/bin/
+chmod a+x ${MERCURY_MORPHINE_DIR}/bin/generate_pred_cov
+
+mmake generate_call_site_cov.depend
+mmake generate_call_site_cov
+mv ${MERCURY_MORPHINE_DIR}/source/generate_call_site_cov ${MERCURY_MORPHINE_DIR}/bin/
+chmod a+x ${MERCURY_MORPHINE_DIR}/bin/generate_call_site_cov
+
+mmake generate_pred_cov.realclean
+mmake generate_call_site_cov.realclean
chmod a+x ${MERCURY_MORPHINE_DIR}/scripts/morphine
Index: extras/morphine/non-regression-tests/queens.exp
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/morphine/non-regression-tests/queens.exp,v
retrieving revision 1.8
diff -u -d -u -r1.8 queens.exp
--- extras/morphine/non-regression-tests/queens.exp 2001/07/05 08:05:36 1.8
+++ extras/morphine/non-regression-tests/queens.exp 2001/07/19 14:11:16
@@ -268,6 +268,52 @@
Result2 = 38511 More? (;)
[morphine 9]:
**************************************************
+**** Testing call_site_cov...
+
+translating /udd/jahier/mercury/extras/morphine/source/coverage.op
+/udd/jahier/mercury/extras/morphine/source/coverage.op is translated
+/udd/jahier/mercury/extras/morphine/bin/generate_call_site_cov queens.m ../../../library/
+Start debugging queens program.
+ 1: 1 [1] call main(state('<<c_pointer>>'), -) [] 0
+[1, 3, 5, 2, 4]
+End of connection with the traced program
+Uncovered: 9
+To cover: 33
+The coverage rate is 72.7273
+Uncovered call sites are:
+csc(queens, queen, 16, [exit, fail])
+csc(queens, qperm, 43, [fail])
+csc(queens, write_string, 19, [exit])
+csc(queens, fail, 66, [])
+csc(queens, fail, 68, [])
+csc(queens, write_string, 82, [exit])
+csc(queens, write_string, 84, [exit])
+csc(queens, write_string, 86, [exit])
+csc(queens, write_int, 94, [exit])
+csc(queens, write_string, 100, [exit])
+
+*** call_site_cov: ok.
+
+Uncovered = [csc("queens", "queen", 16, [exit, fail]), csc("queens", "qperm", 43, [fail]), csc("queens", "write_string", 19, [exit]), csc("queens", "fail", 66, []), csc("queens", "fail", 68, []), csc("queens", "write_string", 82, [exit]), csc("queens", "write_string", 84, [exit]), csc("queens", "write_string", 86, [exit]), csc("queens", "write_int", 94, [exit]), csc("queens", "write_string", 100, [exit])] More? (;)
+[morphine 10]:
+**************************************************
+**** Testing call_site_cov...
+/udd/jahier/mercury/extras/morphine/bin/generate_pred_cov queens.m ../../../library/
+Start debugging queens program.
+ 1: 1 [1] call main(state('<<c_pointer>>'), -) [] 0
+[1, 3, 5, 2, 4]
+End of connection with the traced program
+Uncovered: 2
+To cover: 17
+The coverage rate is 88.2353
+Uncovered call sites are:
+pc(queens, queen, [exit, fail])
+
+*** pred_cov: ok.
+
+Uncovered = [pc("queens", "queen", [exit, fail])] More? (;)
+[morphine 11]:
+**************************************************
**** Testing other Morphine commands...
apropos(window)
man
@@ -298,5 +344,5 @@
*** other Morphine commands: ok.
**************************************************
-[morphine 10]:
+[morphine 12]:
bye
Index: extras/morphine/non-regression-tests/queens.in
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/morphine/non-regression-tests/queens.in,v
retrieving revision 1.7
diff -u -d -u -r1.7 queens.in
--- extras/morphine/non-regression-tests/queens.in 2001/07/05 08:05:37 1.7
+++ extras/morphine/non-regression-tests/queens.in 2001/07/19 14:11:16
@@ -189,6 +189,21 @@
write("\n*** collect: ok.\n").
write("\n**************************************************"),
+ write("\n**** Testing call_site_cov...\n"),
+ make(coverage),
+ call_site_cov("queens", Uncovered),
+ write("\nUncovered call sites are:\n"),
+ checklist(printf("%w\n"), Uncovered),
+ write("\n*** call_site_cov: ok.\n").
+
+write("\n**************************************************"),
+ write("\n**** Testing call_site_cov...\n"),
+ pred_cov("queens", Uncovered),
+ write("\nUncovered call sites are:\n"),
+ checklist(printf("%w\n"), Uncovered),
+ write("\n*** pred_cov: ok.\n").
+
+write("\n**************************************************"),
write("\n**** Testing other Morphine commands...\n"),
write("apropos(window)"), nl,
apropos(man),
Index: extras/morphine/source/call_site_cov.in
===================================================================
RCS file: call_site_cov.in
diff -N call_site_cov.in
--- /dev/null Wed Nov 15 09:24:47 2000
+++ call_site_cov.in Fri Jul 20 00:11:16 2001
@@ -0,0 +1,33 @@
+%
+
+:- import_module string.
+
+:- type call_site_crit --->
+ csc(declared_module_name, proc_name, line_number, list(trace_port_type)).
+
+:- type accumulator_type == list(call_site_crit).
+
+filter(Event, CSL0, CSL, continue) :-
+ ( CSL1 = promise_only_solution(
+ update_call_site_list(
+ port(Event), decl_module(Event), proc_name(Event),
+ line_number(Event), CSL0))
+ ->
+ CSL = CSL1
+ ;
+ CSL = CSL0
+ ).
+
+
+:- pred update_call_site_list(trace_port_type::in, string::in, string::in, int::in,
+ accumulator_type::in, accumulator_type::out) is cc_nondet.
+update_call_site_list(Port, Mod, ProcName, Ln, CSL0, CSL) :-
+ ( Port = exit ; Port = fail ),
+ list__delete(CSL0, csc(Mod, ProcName, Ln, Crit), CSL1),
+ list__delete(Crit, Port, NewCrit),
+ ( NewCrit = [] ->
+ CSL = CSL1
+ ;
+ list__insert(csc(Mod, ProcName, Ln, NewCrit), CSL1, CSL)
+ ).
+
Index: extras/morphine/source/coverage.op
===================================================================
RCS file: coverage.op
diff -N coverage.op
--- /dev/null Wed Nov 15 09:24:47 2000
+++ coverage.op Fri Jul 20 00:11:16 2001
@@ -0,0 +1,149 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 2001 IFSIC.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file License in the Morphine distribution.
+%
+% Author : Erwan Jahier <jahier at irisa.fr>
+%
+% This file implements the coverage scenario, which provide various commands
+% to perform test coverage.
+
+
+opium_scenario(
+ name : coverage,
+ files : [coverage],
+ scenarios : [],
+ message :
+"Provides commands to perform predicate and call site coverage.\
+"
+ ).
+
+
+%-----------------------------------------------------------------------%
+opium_command(
+ name : pred_cov,
+ arg_list : [Module, Uncovered],
+ arg_type_list : [string, var],
+ abbrev : pc,
+ interface : menu,
+ command_type : opium,
+ implementation : pred_cov_Op,
+ parameters : [],
+ message :
+"Takes a Mercury module name \"Module\", and unifies its 2sd argument with the \
+uncovered predicate criteria of \"Module\" and the modules it imports which \
+are in the current directory. A predicate criterion is a \
+3-uple containing a module name, a procedure name, and a list of `exit' and \
+`fail' atoms; for example, the predicate criterion \
+`pc(mod, foo, [exit, fail])' means that the procedure foo in module mod \
+has to succeed and fail exactly once to be considered as covered. \
+\n\
+\n\
+pred_cov/2 works as follows; it calls `morphine/bin/generate_pred_cov \
+<Module>.m' which generates 2 files: \"Module__pred_cov\" that contains \
+a monitor to perform the coverage, and \"Module__pred\" that contains \
+the list of call sites of Module. Then it runs the \"Module__pred_cov\" \
+monitor, which outputs the list of uncovered call sites. The file \
+\"Module__pred\" is used to display the coverage ratio.\
+").
+pred_cov_Op(Module, Uncovered) :-
+ append_strings(Module, ".m", FileName),
+ getenv("MERCURY_MORPHINE_DIR", MorphineDir),
+ ( exists("pred_cov.in") ->
+ true
+ ;
+ concat_string(["ln -s ", MorphineDir,
+ "/source/pred_cov.in "], Cmd1),
+ sh(Cmd1)
+ ),
+ concat_string([MorphineDir, "/bin/generate_pred_cov ", FileName,
+ " ../../../library/"], Cmd2),
+ print(Cmd2), nl,
+ sh(Cmd2),
+ append_strings(Module, "__pred_cov", MonitorName),
+ append_strings(Module, "__pred", CritListFile),
+ crit_cov(pred, Module, MonitorName, CritListFile, Uncovered).
+
+%-----------------------------------------------------------------------%
+opium_command(
+ name : call_site_cov,
+ arg_list : [Module, Uncovered],
+ arg_type_list : [string, var],
+ abbrev : csc,
+ interface : menu,
+ command_type : opium,
+ implementation : call_site_cov_Op,
+ parameters : [],
+ message :
+"Takes a Mercury module name \"Module\", and unifies its 2sd argument with the \
+uncovered call sites criteria of \"Module\" and the modules it imports which \
+are in the current directory. A call site criterion is a \
+4-uple containing a module name, a procedure name, a line number, and a \
+list of `exit' and `fail' atoms; for example, the call site criterion \
+`csc(mod, foo, 14, [exit, fail])' denotes the call to procedure foo in \
+module mod at line 14, which has to succeed and fail exactly once to be \
+considered as covered. \
+\n\
+\n\
+call_site_cov/2 works as follows; it calls `morphine/bin/generate_call_site_cov \
+<Module>.m' which generates 2 files: \"Module__call_site_cov\" that contains \
+a monitor to perform the coverage, and \"Module__call_site\" that contains \
+the list of call sites of Module. Then it runs the \"Module__call_site_cov\" \
+monitor, which outputs the list of uncovered call sites. The file \
+\"Module__call_site\" is used to display the coverage ratio.\
+").
+
+call_site_cov_Op(Module, Uncovered) :-
+ append_strings(Module, ".m", FileName),
+ getenv("MERCURY_MORPHINE_DIR", MorphineDir),
+ ( exists("call_site_cov.in") ->
+ true
+ ;
+ concat_string(["ln -s ", MorphineDir,
+ "/source/call_site_cov.in "], Cmd1),
+ sh(Cmd1)
+ ),
+ concat_string([MorphineDir, "/bin/generate_call_site_cov ", FileName,
+ " ../../../library/"], Cmd2),
+ print(Cmd2), nl,
+ sh(Cmd2),
+ append_strings(Module, "__call_site_cov", MonitorName),
+ append_strings(Module, "__call_site", CritListFile),
+ crit_cov(call_site, Module, MonitorName, CritListFile, Uncovered).
+
+
+
+%-----------------------------------------------------------------------%
+
+crit_cov(CovType, Module, MonitorName, CritListFile, Uncovered) :-
+ run(Module),
+ collect(MonitorName, Uncovered),
+ count_crit(CovType, Uncovered, UncoveredCard),
+ print("Uncovered: "), print(UncoveredCard), nl,
+ get_crit_list_from_file(CritListFile, ToCover),
+ count_crit(CovType, ToCover, ToCoverCard),
+ print("To cover: "), print(ToCoverCard), nl,
+
+ CoverageRate is ((ToCoverCard-UncoveredCard)/ToCoverCard*100),
+ printf("The coverage rate is %2g \% \n", CoverageRate).
+
+
+get_crit_list_from_file(CritListFileName, CritList) :-
+ open(CritListFileName, read, Stream),
+ read(Stream, CritList),
+ close(Stream).
+
+
+count_crit(call_site, [], 0).
+count_crit(call_site, [csc(_,_,_,List) | Tail], N) :-
+ length(List, L),
+ count_crit(call_site, Tail, N0),
+ N is N0 + L.
+
+count_crit(pred, [], 0).
+count_crit(pred, [pc(_,_,List) | Tail], N) :-
+ length(List, L),
+ count_crit(pred, Tail, N0),
+ N is N0 + L.
+
+
Index: extras/morphine/source/coverage_util.m
===================================================================
RCS file: coverage_util.m
diff -N coverage_util.m
--- /dev/null Wed Nov 15 09:24:47 2000
+++ coverage_util.m Fri Jul 20 00:11:16 2001
@@ -0,0 +1,353 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 2001 IFSIC.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file License in the Morphine distribution.
+%
+% Author : Erwan Jahier <jahier at irisa.fr>
+%
+
+:- module coverage_util.
+:- interface.
+:- import_module list, string, term, io, std_util.
+
+:- type proc_det == pair(
+ pair(string, string), % Procedure and module name
+ string). % Determinism
+:- type exit_or_fail ---> exit ; fail ; exception.
+
+
+:- pred get_read_item_list(list(term__term)::out,
+ io__state::di, io__state::uo) is det.
+
+:- pred get_imported_module_list(string::in, list(term)::in,
+ list(string)::out) is det.
+:- pred get_all_imported_module_list(
+ string::in, % Path of the Mercury library source files
+ list(string)::in, % Current list of imported modules
+ list(string)::in, % List of modules to be visited
+ list(string)::out, % New list of imported modules
+ list(string)::out, % New list of modules to be visited
+ io__state::di, io__state::uo
+ ) is det.
+
+
+:- pred get_all_proc_det_list(list(string)::in, list(proc_det)::out,
+ io__state::di, io__state::uo) is det.
+:- pred get_proc_det_list(string::in, list(term)::in, list(proc_det)::out)
+ is det.
+
+:- pred det_to_port_list(string::in, list(exit_or_fail)::out) is det.
+
+:- pred generate_monitor(string::in, list(T)::in, string::in,
+ io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module char, int, require, parser, term_io, set.
+
+%-----------------------------------------------------------------------%
+%-----------------------------------------------------------------------%
+
+get_read_item_list(ItemList) -->
+ parser__read_term(ReadTerm),
+ (
+ { ReadTerm = eof },
+ { ItemList0 = [] },
+ { ItemList1 = [] }
+ ;
+ { ReadTerm = term(_Varset, Term) },
+ { ItemList0 = [Term] },
+ get_read_item_list(ItemList1)
+ ;
+ { ReadTerm = error(_string, _int) },
+ print("*** Parse Error\n\n"),
+ { ItemList0 = [] },
+ { ItemList1 = [] }
+ ),
+ { append(ItemList0, ItemList1, ItemList) }.
+
+
+%-----------------------------------------------------------------------%
+%-----------------------------------------------------------------------%
+
+
+get_imported_module_list(LibPath, ItemList, ModList) :-
+ list__filter_map(get_imported_module, ItemList, ModListList0),
+ list__condense(ModListList0, ModList0),
+ list__remove_dups(ModList0, ModList1),
+ list__map(add_prefix(LibPath), ModList1, ModList2),
+ list__map(add_suffix(".m"), ModList2, ModList).
+
+
+% To be able to apply list__map
+:- pred add_suffix(string::in, string::in, string::out) is det.
+add_suffix(Suffix, String0, String) :-
+ append(String0, Suffix, String).
+
+:- pred add_prefix(string::in, string::in, string::out) is det.
+add_prefix(Prefix, String0, String) :-
+ append(Prefix, String0, String).
+
+:- pred get_imported_module(term__term::in, list(string)::out) is semidet.
+get_imported_module(Term, ImpModList) :-
+ Term = functor(atom(":-"), [Term2 | _], _),
+ Term2 = functor(atom("import_module"), [Term3 | _], _),
+ Term3 = functor(atom(A), _, _),
+ ( A = "," ->
+ % more than one module is imported
+ get_imported_module2(Term3, ImpModList)
+ ;
+ % Only one module is imported
+ ImpModList = [A]
+ ).
+
+:- pred get_imported_module2(term__term::in, list(string)::out) is semidet.
+get_imported_module2(Term, ImpModList) :-
+ Term = functor(atom(","), [Term1, Term2], _),
+ Term1 = functor(atom(A1), _, _),
+ Term2 = functor(atom(A2), _, _),
+ ( A2 = "," ->
+ get_imported_module2(Term2, ImpModList0)
+ ;
+ ImpModList0 = [A2]
+ ),
+ ImpModList = [A1 | ImpModList0].
+
+%-----------------------------------------------------------------------%
+
+
+get_all_imported_module_list(LibPath, ML0, MLv0, ML, MLv) -->
+ list__map_foldl(get_module_list_from_file(LibPath), MLv0, MLL1),
+ { list__condense(MLL1, ML1) },
+ { set__list_to_set(ML0, MS0) },
+ { set__list_to_set(ML1, MS1) },
+ { set__union(MS0, MS1, MS2) },
+ { set__to_sorted_list(MS2, ML2) },
+ { set__intersect(MS0, MS1, Inter) },
+ { set__difference(MS1, Inter, MSv2) },
+ { set__to_sorted_list(MSv2, MLv2) },
+ ( { MLv2 = [] } ->
+ % The fix point is reached
+ { ML = ML2 },
+ { MLv = MLv2 }
+ ;
+ get_all_imported_module_list(LibPath, ML2, MLv2, ML, MLv)
+ ).
+
+
+:- pred get_module_list_from_file(string::in, string::in, list(string)::out,
+ io__state::di, io__state::uo) is det.
+get_module_list_from_file(LibPath, FileName, ML) -->
+ io__see(FileName, Res),
+ ( { Res = ok } ->
+ get_read_item_list(ItemList),
+ io__seen,
+ { get_imported_module_list("", ItemList, ML) }
+ ;
+ { append_list([LibPath, FileName], FileName2) },
+ io__see(FileName2, Res2),
+ ( { Res2 = ok } ->
+ get_read_item_list(ItemList),
+ io__seen,
+ { get_imported_module_list(LibPath, ItemList, ML) }
+ ;
+ { ML = [] }
+ )
+ ).
+
+
+%-----------------------------------------------------------------------%
+%-----------------------------------------------------------------------%
+
+
+% XXX This duplicates a little bit the code of get_all_imported_module_list
+% in some way
+get_all_proc_det_list(FileList, ProcDetList) -->
+ list__map_foldl(get_proc_det_list_from_file, FileList, ProcDetListList),
+ { list__condense(ProcDetListList, ProcDetList) }.
+
+% Ditto.
+:- pred get_proc_det_list_from_file(string::in, list(proc_det)::out,
+ io__state::di, io__state::uo) is det.
+get_proc_det_list_from_file(FileName, PDL) -->
+ io__see(FileName, Res),
+ ( { Res = ok } ->
+ get_read_item_list(ItemList),
+ io__seen,
+ { get_proc_det_list(FileName, ItemList, PDL) }
+ ;
+ { PDL = [] }
+ ).
+
+
+get_proc_det_list(Mod, ItemList, ProcDetList) :-
+ list__filter_map(get_proc_det(Mod), ItemList, ProcDetList0),
+ list__remove_dups(ProcDetList0, ProcDetList).
+
+
+% get_proc_det(Mod, Item, ProcDet) takes an item and outputs a procedure name
+% and its determinism if Item is a declaration, fails otherwise.
+%
+:- pred get_proc_det(string::in, term__term::in, proc_det::out)
+ is semidet.
+get_proc_det(Mod, Term, (Mod - ProcName) - Det) :-
+ Term = functor(atom(":-"), [Term2 | _], _),
+ Term2 = functor(atom(A), [Term3 | _], _),
+ ( A = "pred" ; A = "func" ; A = "mode"),
+ Term3 = functor(atom("is"), [Term4, Term5 | _], _),
+ Term4 = functor(atom(B), [Term6 | _], _),
+ (
+ B = "="
+ ->
+ Term6 = functor(atom(ProcName0), _, _)
+ ;
+ ProcName0 = B
+ ),
+ Term5 = functor(atom(Det), _, _),
+ remove_module_qualifier(Mod, ProcName0, ProcName).
+
+:- pred remove_module_qualifier(string::in, string::in, string::out) is det.
+remove_module_qualifier(Module, ProcName0, ProcName) :-
+ %
+ % Extract the module name from the file name
+ ListStr = string__words(is_slash, Module),
+ reverse(ListStr, ListStrRev),
+ (
+ ListStrRev = [ModuleName|_],
+ remove_suffix(ModuleName, ".m", ModuleBaseName0)
+ ->
+ append(ModuleBaseName0, "__", ModuleBaseName)
+ ;
+ error("Fail to extract the module name from the file name ")
+ ),
+ %
+ % remove the module qualifier if necessary
+ % XXX Maybe I should rather add them when necessary?
+ ( append(ModuleBaseName, ProcName1, ProcName0) ->
+ ProcName = ProcName1
+ ;
+ ProcName = ProcName0
+ ).
+
+
+:- pred is_slash(char::in) is semidet.
+is_slash('/').
+
+% XXX should read a config file to determine which determinism generates
+% which list of ports to be covered.
+det_to_port_list(Det, PortList) :-
+ (
+ ( Det = "det" ; Det = "cc_multi" )
+ ->
+ PortList = [exit]
+ ;
+ Det = "nondet"
+ ->
+ PortList = [exit, exit, fail]
+ ;
+ Det = "multi"
+ ->
+ PortList = [exit, exit]
+ ;
+ ( Det = "semidet" ; Det = "cc_nondet" )
+ ->
+ PortList = [exit, fail]
+ ;
+ Det = "failure"
+ ->
+ PortList = [fail]
+ ;
+ PortList = [exception]
+ ).
+
+%-----------------------------------------------------------------------%
+%-----------------------------------------------------------------------%
+
+generate_monitor(FileName0, CritList, CovType) -->
+ ( { remove_suffix(FileName0, ".m", FileName1) } ->
+ { FileName2 = FileName1 }
+ ;
+ { FileName2 = FileName0 }
+ ),
+ { append_list([FileName2, "__", CovType, "_cov"], FileName3) },
+ io__tell(FileName3, Res1),
+ { append(CovType, "_cov.in", FileIn) },
+ io__see( FileIn, Res2),
+ (
+ { Res1 = error(Msg1) }
+ ->
+ print(Msg1),
+ io__told
+ ;
+ { Res2 = error(Msg2) }
+ ->
+ print(Msg2),
+ print("\nMake sure that "),
+ print(CovType),
+ print("_cov.in is in the current"),
+ print(" directory.\nMaybe you can try to "),
+ print("`ln -s .../morphine/source/"),
+ print(CovType),
+ print("_cov.in'\n"),
+ io__seen
+ ;
+ print("% File automatically generated by get_"),
+ print(CovType),
+ print(".m\n\n"),
+ io__read_file_as_string(_, Beginning),
+ print(Beginning),
+ print("initialize(Acc) :- \n\t list__condense(["),
+ % I do not generate the list of call site in the first place
+ % as the Mercury compiler has trouble to compile large list
+ % (square time in the size of the list).
+ % Therefore I cut the list into chunks and apply list__condense
+ % to it.
+ % XXX check if it really changes anything
+ print_crit_list(CritList, _),
+ print("], Acc)."),
+ io__told,
+ io__seen
+ ),
+ { append_list([FileName2, "__", CovType], FileName4) },
+ io__tell(FileName4, Res3),
+ (
+ { Res3 = error(Msg3) }
+ ->
+ print(Msg3)
+ ;
+ print(CritList),
+ print(".\n"),
+ io__told
+ ).
+
+:- pred print_crit_list(list(T)::in, list(T)::out,
+ io__state::di, io__state::uo) is det.
+print_crit_list(List0, List) -->
+ ( { List0 = [] } ->
+ { List = List0 }
+ ;
+ print("["),
+ print_crit_list2(10, List0, List1),
+ ( { List1 = [] } ->
+ print("\t\t] ")
+ ;
+ print("\t\t], ")
+ ),
+ print_crit_list(List1, List)
+ ).
+
+:- pred print_crit_list2(int::in, list(T)::in, list(T)::out,
+ io__state::di, io__state::uo) is det.
+print_crit_list2(_, [], [], S, S).
+print_crit_list2(N, [X|Xs], List) -->
+ ( { N = 0 ; Xs = [] } ->
+ { List = Xs },
+ print("\t\t"),
+ print(X),
+ print(" \n")
+ ;
+ print("\t\t"),
+ print(X),
+ print(", \n"),
+ print_crit_list2(N-1, Xs, List)
+ ).
Index: extras/morphine/source/generate_call_site_cov.m
===================================================================
RCS file: generate_call_site_cov.m
diff -N generate_call_site_cov.m
--- /dev/null Wed Nov 15 09:24:47 2000
+++ generate_call_site_cov.m Fri Jul 20 00:11:16 2001
@@ -0,0 +1,286 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 2001 IFSIC.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file License in the Morphine distribution.
+%
+% Author : Erwan Jahier <jahier at irisa.fr>
+%
+% Generates a monitor that computes the call site list of a Mercury module,
+% and which generates a monitor (to be run by collect) that performs the
+% call site coverage.
+%
+% Note that it will not only generate the call sites of the module, but
+% also the ones of the modules it imports that are in the same directory
+% (i.e., library modules excepted).
+%
+% This program is intended to be called by call_site_cov/2 morphine command
+% defined in morphine/source/coverage.op scenario.
+%
+% Limitations:
+%
+% This program is largely untested, and hence almost certainly buggy.
+%
+% High order calls not handled: e.g. solutions(foo, L) will miss the call
+% to foo (should be easy to fix).
+%
+% I suppose there is one mode per predicate or function; indeed, it is
+% impossible to know in which mode a predicate in called from the source
+% code only.
+% A way to fix that would be to search for that information in the HLDS
+% dump.
+%
+% In the same vein, library calls without module qualifiers that are
+% defined in several modules with the same name (e.g., append) are
+% not handled cleanly. But that should not be a big deal as library modules
+% with the same name ougth to have the same mode.
+% Here again this can be fixed by looking at the HLDS dump.
+%
+% Currently, I do not generate call sites for builtin procedures such
+% as =/2 or true/0 as they don't appear in the trace.
+% Maybe it would be better not to ignore them and let the monitors
+% believe that they are uncovered even when they are ???
+
+
+:- module generate_call_site_cov.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+:- import_module term, string, parser, io, term_io, list.
+:- import_module std_util, set, char, int, require.
+:- import_module coverage_util.
+
+main -->
+ io__command_line_arguments(Args),
+ (
+ (
+ { Args = [FileName] , LibPath = "" }
+ ; { Args = [FileName, LibPath] }
+ )
+ ->
+ (
+ io__see(FileName, Result),
+ (
+ { Result = ok }
+ ->
+ get_read_item_list(ItemList),
+ io__seen,
+
+ { get_imported_module_list("", ItemList, ImpModList) },
+ get_all_imported_module_list(LibPath, ImpModList,
+ ImpModList, ReallyAllModList, _),
+ get_all_imported_module_list("", ImpModList, ImpModList,
+ AllModList, _),
+ % ReallyAllModList should also contain all imported modules,
+ % even library ones.
+ ( { AllModList = ReallyAllModList } ->
+ print_list(
+ ["*** Warning: No library source files was found",
+ "*** Have you set the 2sd arg of get_call_site",
+ "*** correctly to the Mercury library path?\n"])
+ ;
+ []
+ ),
+
+ { get_proc_det_list(FileName, ItemList, DetList1) },
+ get_all_proc_det_list(ReallyAllModList, DetList2),
+ { append(DetList1, DetList2, DetList) },
+
+ { get_call_site_list(ItemList, CallSiteList1) },
+ get_all_call_site_list(AllModList, CallSiteList2),
+ { append(CallSiteList1, CallSiteList2, CallSiteList)},
+
+ { get_call_site_list_criteria(DetList, CallSiteList,
+ CallSiteCritList) },
+ generate_monitor(FileName, CallSiteCritList, "call_site")
+ ;
+ io__write_string("File does not exist\n")
+ ))
+ ;
+ io__write_string("*** Bad number of args when calling\n"),
+ io__write_string("*** Usage: get_call_site <file> "),
+ io__write_string("[<Mercury lib path>]\n")
+ ).
+
+:- type call_site ---> cs(string, string, int).
+:- type call_site_crit ---> csc(string, string, int, list(exit_or_fail)).
+
+%-----------------------------------------------------------------------%
+
+%-----------------------------------------------------------------------%
+%-----------------------------------------------------------------------%
+
+:- pred get_all_call_site_list(list(string)::in, list(call_site)::out,
+ io__state::di, io__state::uo) is det.
+get_all_call_site_list(FileList, CallSiteList) -->
+ list__map_foldl(get_call_site_list_from_file, FileList,
+ CallSiteListList),
+ { list__condense(CallSiteListList, CallSiteList) }.
+
+
+:- pred get_call_site_list_from_file(string::in, list(call_site)::out,
+ io__state::di, io__state::uo) is det.
+get_call_site_list_from_file(FileName, CSL) -->
+ io__see(FileName, Res),
+ ( { Res = ok } ->
+ get_read_item_list(ItemList),
+ io__seen,
+ { get_call_site_list(ItemList, CSL) }
+ ;
+ { CSL = [] }
+ ).
+
+
+:- pred get_call_site_list(list(term)::in, list(call_site)::out) is det.
+get_call_site_list(ItemList, CallSiteList) :-
+ list__filter_map(get_call_site, ItemList, CallSiteListList),
+ list__condense(CallSiteListList, CallSiteList0),
+ list__remove_dups(CallSiteList0, CallSiteList).
+
+
+:- pred get_call_site(term__term::in, list(call_site)::out) is semidet.
+
+get_call_site(term__functor(Const, [_, TermBody], _context), CallSiteList) :-
+ ( Const = atom(":-") ; Const = atom("-->") ),
+ get_call_site_body(TermBody, CallSiteList).
+
+
+:- pred get_call_site_body(term__term::in, list(call_site)::out) is semidet.
+get_call_site_body(term__functor(Const, ListTerm, context(Mod, LN)),
+ CallSiteList) :-
+ Const = atom(Atom),
+ CallSite = cs(Mod, Atom, LN),
+ (
+ is_a_constructor(Atom)
+ ->
+ list__filter_map(get_call_site_body, ListTerm,
+ CallSiteListList),
+ list__condense(CallSiteListList, CallSiteList)
+ ;
+ ignore_call(Atom)
+ ->
+ CallSiteList = []
+ ;
+ % High order calls (call(Closure, Arg1, ...),
+ % apply(Func, Arg1, ...))
+ is_a_high_order_call(Atom)
+ %
+ % XXX HO (pred and func) calls with the syntax Var(Arg1, ...)
+ % are missed
+ %
+ % XXX We also miss high order calls made by other high
+ % order procs such as `std_util__solutions' or
+ % `list__filter_map'. Maybe it does not matter too much
+ % since the call is necessary being done if the HO pred
+ % is called.
+ ->
+ ListTerm = [term__functor(atom(Hofa), _, context(ModH, LNH))|_],
+ CallSiteList = [cs(Hofa, ModH, LNH)]
+ ;
+ CallSiteList = [CallSite]
+ ).
+
+
+:- pred is_a_constructor(string::in) is semidet.
+is_a_constructor(";").
+is_a_constructor(",").
+is_a_constructor("{}").
+is_a_constructor("->").
+is_a_constructor("if").
+is_a_constructor("then").
+is_a_constructor("else").
+is_a_constructor("=>").
+is_a_constructor("<=").
+is_a_constructor("<=>").
+is_a_constructor("all").
+is_a_constructor("some").
+is_a_constructor("not").
+is_a_constructor("\\+").
+
+% is_a_constructor("").
+
+
+:- pred ignore_call(string::in) is semidet.
+ignore_call("."). % Corresponds to the var list of `all' and `some'
+ % quantifiers.
+ignore_call("[]"). % Null DCG goal.
+
+% XXX Ignore those builtin predicates as they cannot be traced?
+ignore_call("true").
+ignore_call("false").
+ignore_call("is").
+
+% XXX Should really be ignored ?
+ignore_call("="). % XXX We would like to check those calls, but they
+ % do not appear in the trace. That's a real pain...
+ignore_call("\\="). % XXX Ditto
+
+ignore_call(""). % High order function application of the
+ % form: `FuncVar(Arg1, ...)'.
+
+
+
+:- pred is_a_high_order_call(string::in) is semidet.
+is_a_high_order_call("call"). % pred call
+is_a_high_order_call("apply"). % func call
+
+%-----------------------------------------------------------------------%
+%-----------------------------------------------------------------------%
+
+:- pred get_call_site_list_criteria(list(proc_det)::in, list(call_site)::in,
+ list(call_site_crit)::out) is det.
+get_call_site_list_criteria(DetList, CallSiteList, CallSiteCritList) :-
+ map(call_site_to_call_site_crit(DetList), CallSiteList,
+ CallSiteCritList).
+
+
+:- pred call_site_to_call_site_crit(list(proc_det)::in, call_site::in,
+ call_site_crit::out) is det.
+call_site_to_call_site_crit(Pdl, Cs, Csc) :-
+% XXX Actually, there can be more than one solution if several procs
+% have the same name in different modules. I need the type inference
+% result to solve that problem. Note that it should not occur too often,
+% and when it happens, the determinism ougth to be the same
+% (e.g., append for lists and strings...)
+%
+% XXX It would also require a mode analysis to know in which mode append is
+% called... Sigh, I should really parse the HLDS ...
+%
+% It means that I suppose it works for one mode => one predicate !
+%
+% Well, the false entry probably can be fixed by hand...
+%
+
+ Csc = promise_only_solution(call_site_to_call_site_crit_cc(Pdl, Cs)).
+
+:- pred call_site_to_call_site_crit_cc(list(proc_det)::in, call_site::in,
+ call_site_crit::out) is cc_multi.
+call_site_to_call_site_crit_cc(DetList, cs(Mod0, Pred0, Ln),
+ csc(Mod, Pred, Ln, Crit)) :-
+ ( remove_suffix(Mod0, ".m", Mod1) -> Mod = Mod1 ; Mod = Mod0),
+ % remove module qualifier if present
+ ( sub_string_search(Pred0, "__", Int) ->
+ Pred = string__right(Pred0, length(Pred0) - (Int+2))
+ ;
+ Pred = Pred0
+ ),
+
+ ( member(_Mod - Pred - Det, DetList) ->
+ det_to_port_list(Det, Crit)
+ ;
+ Crit = []
+ ).
+
+%-----------------------------------------------------------------------%
+%-----------------------------------------------------------------------%
+
+:- pred print_list(list(T)::in, io__state::di, io__state::uo) is det.
+
+print_list([]) --> [].
+print_list([Term|Tail]) -->
+ print(Term), nl,
+ print_list(Tail).
+
+
Index: extras/morphine/source/generate_pred_cov.m
===================================================================
RCS file: generate_pred_cov.m
diff -N generate_pred_cov.m
--- /dev/null Wed Nov 15 09:24:47 2000
+++ generate_pred_cov.m Fri Jul 20 00:11:16 2001
@@ -0,0 +1,75 @@
+%------------------------------------------------------------------------------%
+% Copyright (C) 2001 IFSIC.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file License in the Morphine distribution.
+%
+% Author : Erwan Jahier <jahier at irisa.fr>
+%
+% Generates a monitor that generates a monitor (to be run by collect)
+% that performs the predicate coverage.
+%
+
+:- module generate_pred_cov.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+:- import_module term, string, parser, io, term_io, list.
+:- import_module std_util, set, char, int, require.
+:- import_module coverage_util.
+
+main -->
+ io__command_line_arguments(Args),
+ ( { Args = [FileName| _] } ->
+ (
+ io__see(FileName, Result),
+ ( { Result = ok } ->
+ get_read_item_list(ItemList),
+ io__seen,
+
+ { get_imported_module_list("", ItemList, ImpModList) },
+ get_all_imported_module_list("", ImpModList, ImpModList,
+ AllModList, _),
+
+ % we want the predicates define in the module it imports
+ % which are in the same directory
+ { get_proc_det_list(FileName, ItemList, DetList1) },
+ get_all_proc_det_list(AllModList, DetList2),
+ { append(DetList1, DetList2, DetList) },
+
+ { get_pred_list_criteria(DetList, PredCritList) },
+ generate_monitor(FileName, PredCritList, "pred")
+ ;
+ io__write_string("File does not exist\n")
+ ))
+ ;
+ print("*** generate_pred_cov take a mercury file name as input\n")
+ ).
+
+
+:- type pred_crit ---> pc(string, string, list(exit_or_fail)).
+
+
+%-----------------------------------------------------------------------%
+%-----------------------------------------------------------------------%
+
+:- pred get_pred_list_criteria(list(proc_det)::in, list(pred_crit)::out)
+ is det.
+get_pred_list_criteria(DetList, PredCritList) :-
+ map(pred_to_pred_crit, DetList, PredCritList).
+
+
+:- pred pred_to_pred_crit(proc_det::in, pred_crit::out) is det.
+pred_to_pred_crit((Mod0-Pred0) - Det, pc(Mod, Pred, PortList)) :-
+ ( remove_suffix(Mod0, ".m", Mod1) -> Mod = Mod1 ; Mod = Mod0 ),
+ ( sub_string_search(Pred0, "__", Int) ->
+ Pred = string__right(Pred0, length(Pred0) - (Int+2))
+ ;
+ Pred = Pred0
+ ),
+ det_to_port_list(Det, PortList).
+
+
+
Index: extras/morphine/source/pred_cov.in
===================================================================
RCS file: pred_cov.in
diff -N pred_cov.in
--- /dev/null Wed Nov 15 09:24:47 2000
+++ pred_cov.in Fri Jul 20 00:11:17 2001
@@ -0,0 +1,32 @@
+%
+
+:- import_module string.
+
+:- type pred_crit --->
+ pc(declared_module_name, proc_name, list(trace_port_type)).
+
+:- type accumulator_type == list(pred_crit).
+
+filter(Event, CSL0, CSL, continue) :-
+ ( CSL1 = promise_only_solution(
+ update_pred_list(
+ port(Event), decl_module(Event), proc_name(Event), CSL0))
+ ->
+ CSL = CSL1
+ ;
+ CSL = CSL0
+ ).
+
+
+:- pred update_pred_list(trace_port_type::in, string::in, string::in,
+ accumulator_type::in, accumulator_type::out) is cc_nondet.
+update_pred_list(Port, Mod, ProcName, CSL0, CSL) :-
+ ( Port = exit ; Port = fail ),
+ list__delete(CSL0, pc(Mod, ProcName, Crit), CSL1),
+ list__delete(Crit, Port, NewCrit),
+ ( NewCrit = [] ->
+ CSL = CSL1
+ ;
+ list__insert(pc(Mod, ProcName, NewCrit), CSL1, CSL)
+ ).
+
--
R1.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list