[m-rev.] for review: add a test coverage scenario
Erwan Jahier
Erwan.Jahier at irisa.fr
Wed Aug 29 08:24:57 AEST 2001
| On 19-Jul-2001, Erwan Jahier <Erwan.Jahier at irisa.fr> wrote:
| > 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?
| ...
| > Add a scenario which provides commands that perform predicate and
| > call site coverage.
| ...
| > extras/morphine/INSTALL_MORPHINE:
|
| s/_/-
Done.
| > 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/
|
| That test case is only going to pass when it is run in that
| specific directory /udd/jahier/...
|
| One way to fix that is to change the Mmakefile so that it
| pipes the output of the test through
|
| sed "s@`pwd`@<current directory>@g"
This doesn't work because the test is executed from mercury/extras/morphine/
non-regression-tests/. Instead, I have removed the lines containing the
strings "/bin/ generate_call_site_cov", "is translated", and "translating" from
the test output (see the diff).
| > +++ coverage.op Fri Jul 20 00:11:16 2001
| > +"Takes a Mercury module name \"Module\", and unifies its 2sd argument with the \
|
| s/2sd/2nd/
|
| Likewise later in this file.
Done.
| > +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 \
|
| s/3-uple/3-tuple/
|
| Likewise later in this file.
Done.
| > 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
| > +%
| > +% 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.
|
| You generate a monitor which itself then generates another monitor?
No, sorry. I meant:
% Computes the call site list of a Mercury module, and generates a monitor
% (to be run by collect) that performs the call site coverage.
| > + ["*** Warning: No library source files was found",
|
| s/was/were/
|
| > + "*** Have you set the 2sd arg of get_call_site",
|
| s/2sd/second/
|
| (The correct abbreviation is "2nd", but it's better to spell it out here.)
|
| > + "*** correctly to the Mercury library path?\n"])
Done.
| "to the correct Mercury library path?" would be better.
Ok.
| > +:- 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("\\+").
|
| You should take the arity into account here.
Ok. See the diff below.
| > +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
|
| "" should be treated the same as "call" or "apply".
Ok, done.
| > +:- 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...
| > +%
|
| Rather than using promise_only_solution here, when you know it isn't always
| the only solution, you should just call solutions/2 and get the first element
| of the list (give the called predicate determinism `multi' rather than
| `cc_multi'). The XXX comment should stay, but at least you won't be lying
| to the compiler...
| Likewise for the other calls to `promise_only_solution'
| (in call_site_cov.in and pred_cov.in).
Done.
Thanks for the review Fergus. Here is the relative diff.
diff -r -u /tmp/mercury/extras/morphine/non-regression-tests/Mmakefile /udd/jahier/mercury/extras/morphine/non-regression-tests/Mmakefile
--- /tmp/mercury/extras/morphine/non-regression-tests/Mmakefile Fri May 18 16:23:51 2001
+++ /udd/jahier/mercury/extras/morphine/non-regression-tests/Mmakefile Wed Aug 29 00:19:33 2001
@@ -54,12 +54,16 @@
grep -v 'host = ' | \
grep -v 'compiled traceable' | \
grep -v 'loading' | \
+ grep -v 'translating ' | \
grep -v 'is loaded' | \
+ grep -v 'is translated' | \
grep -v 'making scenario' | \
grep -v 'WARNING' | \
grep -v 'Compiling collect.m' | \
grep -v 'mmc --grade' | \
- grep -v 'ml --grade' \
+ grep -v 'ml --grade' | \
+ grep -v 'bin/generate_pred_cov' | \
+ grep -v 'bin/generate_call_site_cov' \
> queens.out 2>&1
test_vars.out.orig: test_vars test_vars.in
diff -r -u /tmp/mercury/extras/morphine/non-regression-tests/queens.exp /udd/jahier/mercury/extras/morphine/non-regression-tests/queens.exp
--- /tmp/mercury/extras/morphine/non-regression-tests/queens.exp Tue Aug 28 23:28:36 2001
+++ /udd/jahier/mercury/extras/morphine/non-regression-tests/queens.exp Wed Aug 29 00:05:41 2001
@@ -270,9 +270,6 @@
**************************************************
**** 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]
@@ -294,11 +291,10 @@
Uncovered = [csc("queens", "qperm", 43, [fail]), csc("queens", "queen", 16, [exit, 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/
+**** Testing pred_cov...
Start debugging queens program.
1: 1 [1] call main(state('<<c_pointer>>'), -) [] 0
[1, 3, 5, 2, 4]
@@ -306,7 +302,7 @@
Uncovered: 2
To cover: 17
The coverage rate is 88.2353
-Uncovered call sites are:
+Uncovered predicates are:
pc(queens, queen, [exit, fail])
*** pred_cov: ok.
diff -r -u /tmp/mercury/extras/morphine/non-regression-tests/queens.in /udd/jahier/mercury/extras/morphine/non-regression-tests/queens.in
--- /tmp/mercury/extras/morphine/non-regression-tests/queens.in Tue Aug 28 23:28:44 2001
+++ /udd/jahier/mercury/extras/morphine/non-regression-tests/queens.in Tue Aug 28 21:03:44 2001
@@ -197,9 +197,9 @@
write("\n*** call_site_cov: ok.\n").
write("\n**************************************************"),
- write("\n**** Testing call_site_cov...\n"),
+ write("\n**** Testing pred_cov...\n"),
pred_cov("queens", Uncovered),
- write("\nUncovered call sites are:\n"),
+ write("\nUncovered predicates are:\n"),
checklist(printf("%w\n"), Uncovered),
write("\n*** pred_cov: ok.\n").
diff -r -u /tmp/mercury/extras/morphine/source/call_site_cov.in /udd/jahier/mercury/extras/morphine/source/call_site_cov.in
--- /tmp/mercury/extras/morphine/source/call_site_cov.in Tue Aug 28 23:28:44 2001
+++ /udd/jahier/mercury/extras/morphine/source/call_site_cov.in Tue Aug 28 23:55:45 2001
@@ -3,24 +3,17 @@
:- import_module string.
:- type call_site_crit --->
- csc(declared_module_name, proc_name, line_number, list(trace_port_type)).
+ csc(defined_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
- ).
-
+filter(Event, CSL0, CSL, continue) :-
+ solutions(update_call_site_list(port(Event), def_module(Event),
+ proc_name(Event), line_number(Event), CSL0), Sol),
+ ( Sol = [CSL1|_] -> 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.
+ accumulator_type::in, accumulator_type::out) is nondet.
update_call_site_list(Port, Mod, ProcName, Ln, CSL0, CSL) :-
( Port = exit ; Port = fail ),
list__delete(CSL0, csc(Mod, ProcName, Ln, Crit), CSL1),
diff -r -u /tmp/mercury/extras/morphine/source/coverage.op /udd/jahier/mercury/extras/morphine/source/coverage.op
--- /tmp/mercury/extras/morphine/source/coverage.op Tue Aug 28 23:28:44 2001
+++ /udd/jahier/mercury/extras/morphine/source/coverage.op Tue Aug 28 23:43:03 2001
@@ -5,7 +5,7 @@
%
% Author : Erwan Jahier <jahier at irisa.fr>
%
-% This file implements the coverage scenario, which provide various commands
+% This file implements the coverage scenario, which provides various commands
% to perform test coverage.
@@ -30,10 +30,10 @@
implementation : pred_cov_Op,
parameters : [],
message :
-"Takes a Mercury module name \"Module\", and unifies its 2sd argument with the \
+"Takes a Mercury module name \"Module\", and unifies its 2nd 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 \
+3-tuple 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. \
@@ -46,7 +46,9 @@
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) :-
+
+pred_cov_Op(ProgramCall, Uncovered) :-
+ split_string(ProgramCall, " ", " ", [Module|_Args]),
append_strings(Module, ".m", FileName),
getenv("MERCURY_MORPHINE_DIR", MorphineDir),
( exists("pred_cov.in") ->
@@ -56,13 +58,17 @@
"/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).
+ ( exists(MonitorName) ->
+ true
+ ;
+ concat_string([MorphineDir, "/bin/generate_pred_cov ", FileName],
+ Cmd2),
+ print(Cmd2), nl,
+ sh(Cmd2)
+ ),
+ crit_cov(pred, ProgramCall, MonitorName, CritListFile, Uncovered).
%-----------------------------------------------------------------------%
opium_command(
@@ -75,10 +81,10 @@
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 \
+"Takes a Mercury module name \"Module\", and unifies its 2nd 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-tuple 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 \
@@ -93,7 +99,9 @@
\"Module__call_site\" is used to display the coverage ratio.\
").
-call_site_cov_Op(Module, Uncovered) :-
+
+call_site_cov_Op(ProgramCall, Uncovered) :-
+ split_string(ProgramCall, " ", " ", [Module|_Args]),
append_strings(Module, ".m", FileName),
getenv("MERCURY_MORPHINE_DIR", MorphineDir),
( exists("call_site_cov.in") ->
@@ -103,20 +111,24 @@
"/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).
+ ( exists(MonitorName) ->
+ true
+ ;
+ concat_string([MorphineDir, "/bin/generate_call_site_cov ",
+ FileName, " ", MorphineDir, "/../../library/"], Cmd2),
+ print(Cmd2), nl,
+ sh(Cmd2)
+ ),
+ crit_cov(call_site, ProgramCall, MonitorName, CritListFile, Uncovered).
%-----------------------------------------------------------------------%
-crit_cov(CovType, Module, MonitorName, CritListFile, Uncovered) :-
- run(Module),
+crit_cov(CovType, ProgramCall, MonitorName, CritListFile, Uncovered) :-
+ run(ProgramCall),
collect(MonitorName, Uncovered),
count_crit(CovType, Uncovered, UncoveredCard),
print("Uncovered: "), print(UncoveredCard), nl,
diff -r -u /tmp/mercury/extras/morphine/source/generate_call_site_cov.m /udd/jahier/mercury/extras/morphine/source/generate_call_site_cov.m
--- /tmp/mercury/extras/morphine/source/generate_call_site_cov.m Tue Aug 28 23:28:44 2001
+++ /udd/jahier/mercury/extras/morphine/source/generate_call_site_cov.m Tue Aug 28 23:50:13 2001
@@ -5,9 +5,8 @@
%
% 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.
+% Computes the call site list of a Mercury module, and 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
@@ -77,9 +76,9 @@
% 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"])
+ ["*** Warning: No library source files were found",
+ "*** Have you set the second arg of get_call_site",
+ "*** to the correct Mercury library path?\n"])
;
[]
),
@@ -108,8 +107,6 @@
:- 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,
@@ -153,7 +150,8 @@
Const = atom(Atom),
CallSite = cs(Mod, Atom, LN),
(
- is_a_constructor(Atom)
+ length(ListTerm, Arity),
+ is_a_constructor(Atom, Arity)
->
list__filter_map(get_call_site_body, ListTerm,
CallSiteListList),
@@ -183,23 +181,21 @@
).
-:- 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 is_a_constructor(string::in, int::in) is semidet.
+is_a_constructor(";", 2).
+is_a_constructor(",", 2).
+is_a_constructor("{}", _).
+is_a_constructor("->", 2).
+is_a_constructor("if", 1).
+is_a_constructor("then", 2).
+is_a_constructor("else", 2) .
+is_a_constructor("=>", 2).
+is_a_constructor("<=", 2).
+is_a_constructor("<=>", 2).
+is_a_constructor("all", 2).
+is_a_constructor("some", 2).
+is_a_constructor("not", 1).
+is_a_constructor("\\+", 1).
:- pred ignore_call(string::in) is semidet.
@@ -217,14 +213,13 @@
% 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
+is_a_high_order_call(""). % High order function application of the
+ % form: `FuncVar(Arg1, ...)'.
+
%-----------------------------------------------------------------------%
%-----------------------------------------------------------------------%
@@ -252,11 +247,10 @@
%
% Well, the false entry probably can be fixed by hand...
%
-
- Csc = promise_only_solution(call_site_to_call_site_crit_cc(Pdl, Cs)).
+ solutions(call_site_to_call_site_crit_cc(Pdl, Cs), [Csc|_]).
:- pred call_site_to_call_site_crit_cc(list(proc_det)::in, call_site::in,
- call_site_crit::out) is cc_multi.
+ call_site_crit::out) is 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),
diff -r -u /tmp/mercury/extras/morphine/source/generate_pred_cov.m /udd/jahier/mercury/extras/morphine/source/generate_pred_cov.m
--- /tmp/mercury/extras/morphine/source/generate_pred_cov.m Tue Aug 28 23:28:44 2001
+++ /udd/jahier/mercury/extras/morphine/source/generate_pred_cov.m Mon Aug 20 17:10:38 2001
@@ -5,8 +5,8 @@
%
% Author : Erwan Jahier <jahier at irisa.fr>
%
-% Generates a monitor that generates a monitor (to be run by collect)
-% that performs the predicate coverage.
+% Generates a monitor (to be run by collect) that performs the predicate
+% coverage.
%
:- module generate_pred_cov.
diff -r -u /tmp/mercury/extras/morphine/source/pred_cov.in /udd/jahier/mercury/extras/morphine/source/pred_cov.in
--- /tmp/mercury/extras/morphine/source/pred_cov.in Tue Aug 28 23:28:44 2001
+++ /udd/jahier/mercury/extras/morphine/source/pred_cov.in Tue Aug 28 23:56:40 2001
@@ -7,19 +7,13 @@
:- 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
- ).
-
+filter(Event, CSL0, CSL, continue) :-
+ solutions(update_pred_list(port(Event), decl_module(Event),
+ proc_name(Event), CSL0), Sol),
+ ( Sol = [CSL1|_] -> 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.
+ accumulator_type::in, accumulator_type::out) is nondet.
update_pred_list(Port, Mod, ProcName, CSL0, CSL) :-
( Port = exit ; Port = fail ),
list__delete(CSL0, pc(Mod, ProcName, Crit), CSL1),
--
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