[m-rev.] for review: fix bug #20
Ian MacLarty
maclarty at csse.unimelb.edu.au
Thu Feb 4 11:25:53 AEDT 2010
On Wed, Feb 03, 2010 at 07:14:14PM +1100, Julien Fischer wrote:
>
> Hi,
>
> On Wed, 3 Feb 2010, Ian MacLarty wrote:
>
>> Print a warning when the declarative debugger is about to search in the
>> supertree of the starting node and there has been no interaction with the user
>> yet (bug #20). This could happen when the user issues the dd command at a node
>> whose descendents are all trusted. In this case the declarative debugger will
>> begin searching in the ancestors of the node where the dd command was issued,
>> which can seem unintuitive. The warning message should help the user
>> understand what is going on.
>
> When I spoke to Zoltan about this the other day he suggested that, in
> addition to emitting the warning, the debugger should ask the user to
> choose whether they wish to begin searching in the ancestors or abort
> the dd session.
> (The latter may be preferable in some cases, e.g. where a user has
> erroneously trusted some modules and only realises it upon seeing the
> warning.)
Done. Here is the new log and diff:
When the declarative debugger is about to search in the supertree of the
starting node and there has been no interaction with the user yet show a
warning and ask the user if the search should continue in ancestor calls
(bug #20). This could happen when the user issues the dd command at a
node whose descendents are all trusted. In this case the declarative
debugger will begin searching in the ancestors of the node where the dd
command was issued, which can seem unintuitive. The warning message
should help the user understand what is going on.
browser/declarative_debugger.m:
Add a warn_if_searching_supertree flag to the declarative debugger
state. This flag is initially set to yes and is changed to no after
a user interaction.
Print a warning if a supertree is requested and there has been no
interaction with the user yet. Ask the user if the search should
continue in the supertree.
Add a predicate to perform per-session initialization. This
currently resets the warn_if_searching_supertree flag.
browser/declarative_oracle.m:
browser/declarative_user.m:
Add get_user_input_stream functions.
tests/debugger/declarative/Mmakefile:
tests/debugger/declarative/all_trusted.exp:
tests/debugger/declarative/all_trusted.exp2:
tests/debugger/declarative/all_trusted.inp:
Include the warning message in the expected output.
tests/debugger/declarative/supertree_warning.exp:
tests/debugger/declarative/supertree_warning.inp:
tests/debugger/declarative/supertree_warning.m:
New test case.
trace/mercury_trace_cmd_dd.c:
Do per-session initialization.
trace/mercury_trace_declarative.c:
trace/mercury_trace_declarative.h:
Add a wrapper function to call the new session initialization
predicate.
Index: browser/declarative_debugger.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_debugger.m,v
retrieving revision 1.76
diff -u -r1.76 declarative_debugger.m
--- browser/declarative_debugger.m 27 Sep 2007 07:28:14 -0000 1.76
+++ browser/declarative_debugger.m 4 Feb 2010 00:18:49 -0000
@@ -310,6 +310,7 @@
:- import_module mdb.declarative_edt.
:- import_module mdb.declarative_oracle.
+:- import_module mdb.util.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.rtti_access.
@@ -342,18 +343,27 @@
:- type diagnoser_state(R)
---> diagnoser(
- analyser_state :: analyser_state(edt_node(R)),
- oracle_state :: oracle_state,
+ analyser_state :: analyser_state(edt_node(R)),
+ oracle_state :: oracle_state,
- % The diagnoser state before the previous oracle answer
- % (if there oracle has given any answers yet).
- previous_diagnoser :: maybe(diagnoser_state(R))
+ warn_if_searching_supertree :: bool,
+ % This field keeps track of whether we should warn the
+ % user when a supertree is requested.
+ % We issue a warning when there have been no interactions
+ % with the user and a supertree has been requested.
+ % This can happen when all the nodes under the starting
+ % node are trusted. This behaviour can be confusing, so
+ % we print a message to explain what is going on.
+
+ previous_diagnoser :: maybe(diagnoser_state(R))
+ % The diagnoser state before the previous oracle answer
+ % (if the oracle has given any answers yet).
).
diagnoser_state_init(InStr, OutStr, Browser, HelpSystem, Diagnoser) :-
analyser_state_init(Analyser),
oracle_state_init(InStr, OutStr, Browser, HelpSystem, Oracle),
- Diagnoser = diagnoser(Analyser, Oracle, no).
+ Diagnoser = diagnoser(Analyser, Oracle, yes, no).
:- pred push_diagnoser(diagnoser_state(R)::in, diagnoser_state(R)::out) is det.
@@ -434,11 +444,16 @@
query_oracle(Question, OracleResponse, FromUser, Oracle0, Oracle, !IO),
(
FromUser = yes,
- oracle_response_undoable(OracleResponse)
- ->
- push_diagnoser(!Diagnoser)
+ !Diagnoser ^ warn_if_searching_supertree := no,
+ (
+ oracle_response_undoable(OracleResponse)
+ ->
+ push_diagnoser(!Diagnoser)
+ ;
+ true
+ )
;
- true
+ FromUser = no
),
!:Diagnoser = !.Diagnoser ^ oracle_state := Oracle,
handle_oracle_response(Store, OracleResponse, DiagnoserResponse,
@@ -457,7 +472,22 @@
;
AnalyserResponse = analyser_response_require_explicit_supertree(Node),
edt_subtree_details(Store, Node, Event, Seqno, _),
- DiagnoserResponse = require_supertree(Event, Seqno)
+ ( !.Diagnoser ^ warn_if_searching_supertree = no,
+ DiagnoserResponse = require_supertree(Event, Seqno)
+ ; !.Diagnoser ^ warn_if_searching_supertree = yes,
+ Out = get_user_output_stream(!.Diagnoser ^ oracle_state),
+ io.write_string(Out, "All descendent calls are trusted.\n" ++
+ "Shall I continue searching in ancestor calls?\n", !IO),
+ read_search_supertree_response(!.Diagnoser, Response, !IO),
+ ( Response = yes,
+ DiagnoserResponse = require_supertree(Event, Seqno)
+ ; Response = no,
+ io.write_string(Out, "Diagnosis aborted.\n", !IO),
+ DiagnoserResponse = no_bug_found
+ ),
+ % We only want to issue the warning once, so set the flag to no.
+ !Diagnoser ^ warn_if_searching_supertree := no
+ )
;
AnalyserResponse = analyser_response_revise(Question),
Oracle0 = !.Diagnoser ^ oracle_state,
@@ -468,6 +498,33 @@
!Diagnoser, !IO)
).
+:- pred read_search_supertree_response(diagnoser_state(R)::in,
+ bool::out, io::di, io::uo) is det.
+
+read_search_supertree_response(Diagnoser, Response, !IO) :-
+ In = get_user_input_stream(Diagnoser ^ oracle_state),
+ Out = get_user_output_stream(Diagnoser ^ oracle_state),
+ Prompt = "> ",
+ util.trace_getline(Prompt, Result, In, Out, !IO),
+ ( Result = ok(Line),
+ UpperLine = string.to_upper(Line),
+ ( (UpperLine = "YES" ; UpperLine = "Y") ->
+ Response = yes
+ ; (UpperLine = "NO" ; UpperLine = "N") ->
+ Response = no
+ ;
+ io.write_string(Out, "Please answer yes or no.\n", !IO),
+ read_search_supertree_response(Diagnoser, Response, !IO)
+ )
+ ; Result = error(ErrNo),
+ io.write_string(Out, "Error reading input: " ++
+ io.error_message(ErrNo) ++ ". Aborting.\n", !IO),
+ Response = no
+ ; Result = eof,
+ io.write_string(Out, "Unexpected EOF. Aborting.\n", !IO),
+ Response = no
+ ).
+
:- pred handle_oracle_response(S::in, oracle_response(edt_node(R))::in,
diagnoser_response(R)::out, diagnoser_state(R)::in,
diagnoser_state(R)::out, io::di, io::uo) is cc_multi
@@ -586,6 +643,19 @@
diagnoser_state_init_store(InStr, OutStr, Browser, HelpSystem, Diagnoser) :-
diagnoser_state_init(InStr, OutStr, Browser, HelpSystem, Diagnoser).
+ % This is called when the user starts a new declarative
+ % debugging session with the dd command (and the --resume option
+ % wasn't given).
+ %
+:- pred diagnoser_session_init(diagnoser_state(trace_node_id)::in,
+ diagnoser_state(trace_node_id)::out) is det.
+
+diagnoser_session_init(!Diagnoser) :-
+ !Diagnoser ^ warn_if_searching_supertree := yes.
+
+:- pragma foreign_export("C", diagnoser_session_init(in, out),
+ "MR_DD_decl_session_init").
+
% Set the testing flag of the user_state in the given diagnoser.
%
:- pred set_diagnoser_testing_flag(bool::in,
Index: browser/declarative_oracle.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_oracle.m,v
retrieving revision 1.60
diff -u -r1.60 declarative_oracle.m
--- browser/declarative_oracle.m 23 Nov 2007 07:34:51 -0000 1.60
+++ browser/declarative_oracle.m 4 Feb 2010 00:18:49 -0000
@@ -153,6 +153,10 @@
%
:- func get_user_output_stream(oracle_state) = io.output_stream.
+ % Return the input stream used for interacting with the user.
+ %
+:- func get_user_input_stream(oracle_state) = io.input_stream.
+
% Set the testing flag of the user_state in the given oracle.
%
:- pred set_oracle_testing_flag(bool::in, oracle_state::in, oracle_state::out)
@@ -712,7 +716,10 @@
!:Oracle = !.Oracle ^ user_state := User.
get_user_output_stream(Oracle) =
- declarative_user.get_user_output_stream( Oracle ^ user_state).
+ declarative_user.get_user_output_stream(Oracle ^ user_state).
+
+get_user_input_stream(Oracle) =
+ declarative_user.get_user_input_stream(Oracle ^ user_state).
set_oracle_testing_flag(Testing, !Oracle) :-
User0 = !.Oracle ^ user_state,
Index: browser/declarative_user.m
===================================================================
RCS file: /home/mercury1/repository/mercury/browser/declarative_user.m,v
retrieving revision 1.69
diff -u -r1.69 declarative_user.m
--- browser/declarative_user.m 30 Aug 2009 23:09:42 -0000 1.69
+++ browser/declarative_user.m 4 Feb 2010 00:18:49 -0000
@@ -90,6 +90,10 @@
%
:- func get_user_output_stream(user_state) = io.output_stream.
+ % Return the input stream used for interacting with the user.
+ %
+:- func get_user_input_stream(user_state) = io.input_stream.
+
% Set the testing flag of the user_state.
%
:- pred set_user_testing_flag(bool::in, user_state::in, user_state::out)
@@ -1343,6 +1347,8 @@
get_user_output_stream(User) = User ^ outstr.
+get_user_input_stream(User) = User ^ instr.
+
set_user_testing_flag(Testing, User, User ^ testing := Testing).
%-----------------------------------------------------------------------------%
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.100
diff -u -r1.100 Mmakefile
--- tests/debugger/declarative/Mmakefile 27 Sep 2007 07:28:24 -0000 1.100
+++ tests/debugger/declarative/Mmakefile 4 Feb 2010 00:18:51 -0000
@@ -68,6 +68,7 @@
special_term_dep \
skip \
solns \
+ supertree_warning \
tabled_read_decl \
tabled_read_decl_goto \
throw \
@@ -527,6 +528,10 @@
$(MDB_STD) ./skip < skip.inp > skip.out 2>&1 \
|| { grep . $@ /dev/null; exit 1; }
+supertree_warning.out: supertree_warning supertree_warning.inp
+ $(MDB_STD) ./supertree_warning < supertree_warning.inp > supertree_warning.out 2>&1 \
+ || { grep . $@ /dev/null; exit 1; }
+
tabled_read_decl.out: tabled_read_decl tabled_read_decl.inp
$(MDB_STD) ./tabled_read_decl < tabled_read_decl.inp 2>&1 | \
sed 's/c_pointer(0x[0-9A-Fa-f]*)/c_pointer(0xXXXX)/g' \
Index: tests/debugger/declarative/all_trusted.exp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/all_trusted.exp,v
retrieving revision 1.2
diff -u -r1.2 all_trusted.exp
--- tests/debugger/declarative/all_trusted.exp 20 May 2005 05:40:20 -0000 1.2
+++ tests/debugger/declarative/all_trusted.exp 4 Feb 2010 00:18:51 -0000
@@ -14,6 +14,9 @@
mdb> f
E3: C2 EXIT pred all_trusted.p/2-0 (det)
mdb> dd -d 3 -n 7 -a
+All descendent calls are trusted.
+Shall I continue searching in ancestor calls?
+> y
2No bug found.
E3: C2 EXIT pred all_trusted.p/2-0 (det)
mdb> break main
Index: tests/debugger/declarative/all_trusted.exp2
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/all_trusted.exp2,v
retrieving revision 1.2
diff -u -r1.2 all_trusted.exp2
--- tests/debugger/declarative/all_trusted.exp2 20 May 2005 05:40:20 -0000 1.2
+++ tests/debugger/declarative/all_trusted.exp2 4 Feb 2010 00:18:51 -0000
@@ -14,6 +14,9 @@
mdb> f
E3: C2 EXIT pred all_trusted.p/2-0 (det)
mdb> dd -d 3 -n 7 -a
+All descendent calls are trusted.
+Shall I continue searching in ancestor calls?
+> y
2No bug found.
E3: C2 EXIT pred all_trusted.p/2-0 (det)
mdb> break main
Index: tests/debugger/declarative/all_trusted.inp
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/all_trusted.inp,v
retrieving revision 1.2
diff -u -r1.2 all_trusted.inp
--- tests/debugger/declarative/all_trusted.inp 20 May 2005 05:40:20 -0000 1.2
+++ tests/debugger/declarative/all_trusted.inp 4 Feb 2010 00:18:51 -0000
@@ -8,6 +8,7 @@
c
f
dd -d 3 -n 7 -a
+y
break main
c
dd -d 3 -n 7 -a
Index: tests/debugger/declarative/supertree_warning.exp
===================================================================
RCS file: tests/debugger/declarative/supertree_warning.exp
diff -N tests/debugger/declarative/supertree_warning.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/supertree_warning.exp 4 Feb 2010 00:18:51 -0000
@@ -0,0 +1,32 @@
+ E1: C1 CALL pred supertree_warning.main/2-0 (det) supertree_warning.m:13
+mdb> mdb> Contexts will not be printed.
+mdb> echo on
+Command echo enabled.
+mdb> table_io allow
+mdb> table_io start
+I/O tabling started.
+mdb> trust q
+Trusting pred supertree_warning.q/2
+mdb> break q
+ 0: + stop interface pred supertree_warning.q/2-0 (det)
+mdb> c
+ E2: C2 CALL pred supertree_warning.q/2-0 (det)
+mdb> f
+ E3: C2 EXIT pred supertree_warning.q/2-0 (det)
+mdb> dd -d 3 -n 7 -a
+All descendent calls are trusted.
+Shall I continue searching in ancestor calls?
+> maybe
+Please answer yes or no.
+> Yes
+p(1, 1)
+Valid? quit
+Diagnosis aborted.
+ E3: C2 EXIT pred supertree_warning.q/2-0 (det)
+mdb> dd -d 3 -n 7 -a
+All descendent calls are trusted.
+Shall I continue searching in ancestor calls?
+> n
+Diagnosis aborted.
+ E3: C2 EXIT pred supertree_warning.q/2-0 (det)
+mdb> quit -y
Index: tests/debugger/declarative/supertree_warning.inp
===================================================================
RCS file: tests/debugger/declarative/supertree_warning.inp
diff -N tests/debugger/declarative/supertree_warning.inp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/supertree_warning.inp 4 Feb 2010 00:18:51 -0000
@@ -0,0 +1,16 @@
+register --quiet
+context none
+echo on
+table_io allow
+table_io start
+trust q
+break q
+c
+f
+dd -d 3 -n 7 -a
+maybe
+Yes
+quit
+dd -d 3 -n 7 -a
+n
+quit -y
Index: tests/debugger/declarative/supertree_warning.m
===================================================================
RCS file: tests/debugger/declarative/supertree_warning.m
diff -N tests/debugger/declarative/supertree_warning.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/supertree_warning.m 4 Feb 2010 00:18:51 -0000
@@ -0,0 +1,22 @@
+:- module supertree_warning.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module int.
+
+main(!IO) :-
+ p(1, _).
+
+:- pred p(int::in, int::out) is det.
+
+p(X, Y) :- q(X, Y).
+
+:- pred q(int::in, int::out) is det.
+
+q(X, X).
Index: trace/mercury_trace_cmd_dd.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_cmd_dd.c,v
retrieving revision 1.6
diff -u -r1.6 mercury_trace_cmd_dd.c
--- trace/mercury_trace_cmd_dd.c 2 Oct 2007 17:04:37 -0000 1.6
+++ trace/mercury_trace_cmd_dd.c 4 Feb 2010 00:18:53 -0000
@@ -117,6 +117,10 @@
MR_trace_decl_set_testing_flag(testing);
+ if (new_session) {
+ MR_trace_decl_session_init();
+ }
+
if (search_mode_was_set || new_session) {
MR_trace_decl_set_fallback_search_mode(search_mode);
}
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.115
diff -u -r1.115 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 26 Aug 2009 00:06:08 -0000 1.115
+++ trace/mercury_trace_declarative.c 4 Feb 2010 00:18:54 -0000
@@ -1482,6 +1482,16 @@
}
void
+MR_trace_decl_session_init()
+{
+ MR_trace_decl_ensure_init();
+ MR_TRACE_CALL_MERCURY(
+ MR_DD_decl_session_init(
+ MR_trace_front_end_state, &MR_trace_front_end_state);
+ );
+}
+
+void
MR_trace_decl_set_fallback_search_mode(MR_DeclSearchMode search_mode)
{
MR_trace_decl_ensure_init();
Index: trace/mercury_trace_declarative.h
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_declarative.h,v
retrieving revision 1.32
diff -u -r1.32 mercury_trace_declarative.h
--- trace/mercury_trace_declarative.h 27 Sep 2007 07:28:28 -0000 1.32
+++ trace/mercury_trace_declarative.h 4 Feb 2010 00:18:54 -0000
@@ -85,6 +85,12 @@
MR_DeclSearchMode search_mode);
/*
+** MR_trace_decl_session_init performs per-session initialization.
+*/
+
+extern void MR_trace_decl_session_init(void);
+
+/*
** MR_trace_decl_reset_knowledge_base resets the oracle's knowledge base.
*/
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list