[m-dev.] diff: fix bug in debugger

[Fergus Henderson]

The .exp and .exp2 files here might not be completely correct;
if so, I'll replace them with updated versions tomorrow.

----------

Estimated hours taken: 4

Fix a bug where the debugger was crashing when tracing calls to procedures
like `std_util__det_arg' or `io__read' that have an output argument whose type
is a universally quantified type variable that does not occur in the type of
any of the input arguments.

trace/mercury_trace_vars.c:
	Ensure that we check for type_info / typeclass_info types 
	*before* calling MR_get_type_and_value_base(),
	since for those types the stack layout information might
	not have all the type parameters needed.

tests/debugger/Mmakefile:
tests/debugger/polymorphic_output.m:
tests/debugger/polymorphic_output.exp:
tests/debugger/polymorphic_output.exp2:
	A regression test.

Workspace: /home/pgrad/fjh/ws/hg
Index: tests/debugger/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.35
diff -u -d -r1.35 Mmakefile
--- tests/debugger/Mmakefile	2000/01/23 01:13:45	1.35
+++ tests/debugger/Mmakefile	2000/04/11 10:22:49
@@ -28,7 +28,8 @@
 	mdb_command_test		\
 	multi_parameter			\
 	queens				\
-	shallow
+	shallow				\
+	polymorphic_output
 
 # The following tests are disabled, since currently they get some spurious
 # failures if readline support is enabled:
Index: tests/debugger/polymorphic_output.exp
===================================================================
RCS file: polymorphic_output.exp
diff -N polymorphic_output.exp
--- /dev/null	Thu Mar 30 14:06:13 2000
+++ polymorphic_output.exp	Tue Apr 11 20:27:56 2000
@@ -0,0 +1,27 @@
+Melbourne Mercury Debugger, mdb version DEV.
+Copyright 1998 The University of Melbourne, Australia.
+mdb is free software, covered by the GNU General Public License.
+There is absolutely no warranty for mdb.
+       1:      1  1 CALL pred polymorphic_output:main/2-0 (det) polymorphic_output.m:20
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> context none
+Contexts will not be printed.
+mdb> b det_arg
+ 0: + stop  interface func std_util:det_arg/3-0 (det)
+mdb> c
+       7:      5  4 CALL func std_util:det_arg/3-0 (det)
+mdb> P
+       HeadVar__1             	two("three", 3, three("four", 4, "one", 1, empty, empty, empty), two/4)
+       HeadVar__2             	3
+mdb> f
+       8:      5  4 EXCP func std_util:det_arg/3-0 (det)
+mdb> P
+       HeadVar__1             	two("three", 3, three("four", 4, "one", 1, empty, empty, empty), two/4)
+       HeadVar__2             	3
+mdb> c
+Uncaught exception:
+Software Error: det_arg: argument number out of range
+Last trace event was event #11.
+Last trace event before the unhandled exception was event #7.
Index: tests/debugger/polymorphic_output.exp2
===================================================================
RCS file: polymorphic_output.exp2
diff -N polymorphic_output.exp2
--- /dev/null	Thu Mar 30 14:06:13 2000
+++ polymorphic_output.exp2	Tue Apr 11 20:27:58 2000
@@ -0,0 +1,27 @@
+Melbourne Mercury Debugger, mdb version DEV.
+Copyright 1998 The University of Melbourne, Australia.
+mdb is free software, covered by the GNU General Public License.
+There is absolutely no warranty for mdb.
+       1:      1  1 CALL pred polymorphic_output:main/2-0 (det) polymorphic_output.m:20
+mdb> echo on
+Command echo enabled.
+mdb> register --quiet
+mdb> context none
+Contexts will not be printed.
+mdb> b det_arg
+ 0: + stop  interface func std_util:det_arg/3-0 (det)
+mdb> c
+       7:      5  4 CALL func std_util:det_arg/3-0 (det)
+mdb> P
+       HeadVar__1             	two("three", 3, three("four", 4, "one", 1, empty, empty, empty), two/4)
+       HeadVar__2             	3
+mdb> f
+       8:      5  4 EXCP func std_util:det_arg/3-0 (det)
+mdb> P
+       HeadVar__1             	two("three", 3, three("four", 4, "one", 1, empty, empty, empty), two/4)
+       HeadVar__2             	3
+mdb> c
+Uncaught exception:
+Software Error: det_arg: argument number out of range
+Last trace event was event #11.
+Last trace event before the unhandled exception was event #7.
Index: tests/debugger/polymorphic_output.m
===================================================================
RCS file: polymorphic_output.m
diff -N polymorphic_output.m
--- /dev/null	Thu Mar 30 14:06:13 2000
+++ polymorphic_output.m	Tue Apr 11 20:23:58 2000
@@ -0,0 +1,40 @@
+% This is a regression test.
+%
+% It tests for a bug that showed up when tracing
+% calls to procedures like `std_util__det_arg'
+% or `io__read' that have an output argument
+% whose type is a universally quantified type
+% variable that does not occur in the type of
+% any of the input arguments.
+% Version rotd-2000-04-10 failed this test case.
+
+:- module polymorphic_output.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+:- import_module std_util, list, string, map, int.
+
+main -->
+    { map__from_assoc_list(["two"-2, "one"-1, "three"-3, "four"-4], M) },
+    io__write_list(functor_names(M), "\n", io__write_string),
+    io__nl.
+
+:- func functor_names(T) = list(string).
+
+functor_names(X) =
+    [Name | ( if Arity = 0 then ArgNames else [] ) ]
+:-
+    functor(X, Name, Arity),
+    ArgNames = arg_names(X, Arity - 1).
+
+:- func arg_names(T, int) = list(string).
+
+arg_names(X, I) =
+    ( if I < 0 then
+        []
+      else
+        list__append(functor_names(det_arg(X, I)), arg_names(X, I - 1))
+    ).
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.13
diff -u -d -r1.13 mercury_trace_vars.c
--- trace/mercury_trace_vars.c	2000/03/24 10:28:07	1.13
+++ trace/mercury_trace_vars.c	2000/04/11 10:04:20
@@ -105,7 +105,7 @@
 	MR_Var_Details			*MR_point_vars;
 } MR_Point;
 
-static	bool	MR_trace_type_is_ignored(MR_TypeInfo type_info);
+static	bool	MR_trace_type_is_ignored(MR_PseudoTypeInfo pseudo_type_info);
 static	int	MR_trace_compare_var_details(const void *arg1,
 			const void *arg2);
 static	void	MR_trace_browse_var(FILE *out, MR_Var_Details *var,
@@ -180,13 +180,18 @@
 };
 
 static bool
-MR_trace_type_is_ignored(MR_TypeInfo type_info)
+MR_trace_type_is_ignored(MR_PseudoTypeInfo pseudo_type_info)
 {
 	MR_TypeCtorInfo	type_ctor_info;
 	int		ignore_type_ctor_count;
 	int		i;
 
-	type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+	if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pseudo_type_info)) {
+		return FALSE;
+	}
+
+	type_ctor_info =
+		MR_PSEUDO_TYPEINFO_GET_TYPE_CTOR_INFO(pseudo_type_info);
 	ignore_type_ctor_count =
 		sizeof(MR_trace_ignored_type_ctors) / sizeof(Word *);
 
@@ -226,6 +231,7 @@
 	MR_TypeInfo			*type_params;
 	Word				value;
 	MR_TypeInfo			type_info;
+	MR_PseudoTypeInfo		pseudo_type_info;
 	int				i;
 	int				slot;
 	int				slot_max;
@@ -349,14 +355,15 @@
 			continue;
 		}
 
+		pseudo_type_info = MR_var_pti(vars, i);
+		if (MR_trace_type_is_ignored(pseudo_type_info)) {
+			continue;
+		}
+
 		if (! MR_get_type_and_value_base(vars, i, valid_saved_regs,
 			base_sp, base_curfr, type_params, &type_info, &value))
 		{
 			/* this value is not a variable */
-			continue;
-		}
-
-		if (MR_trace_type_is_ignored(type_info)) {
 			continue;
 		}
 

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>  |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3        |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------