[m-rev.] diff: fix a bug with ":- type bug(T) == T."

Zoltan Somogyi zs at cs.mu.OZ.AU
Thu Apr 1 14:33:51 AEST 2004


compiler/rtti_out.m:
	Fix a bug: we were generating improper output for the type_ctor_infos
	of equivalence types in which the right hand side was a type variable.

tests/debugger/exported_eqv_type.{m,inp,exp}:
	A new test case checking for the proper handling of such types.

tests/debugger/Mmakefile:
	Enable the new test.

Zoltan.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/rtti_out.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.43
diff -u -b -r1.43 rtti_out.m
--- compiler/rtti_out.m	24 Mar 2004 02:57:13 -0000	1.43
+++ compiler/rtti_out.m	31 Mar 2004 10:43:52 -0000
@@ -580,8 +580,9 @@
 	io__write_string(""",\n\t", !IO),
 	(
 		MaybeFunctorsName = yes(FunctorsName),
-		io__write_string("{ (void *) &", !IO),
-		output_ctor_rtti_id(RttiTypeCtor, FunctorsName, !IO),
+		FunctorsRttiId = ctor_rtti_id(RttiTypeCtor, FunctorsName),
+		io__write_string("{ ", !IO),
+		output_cast_addr_of_rtti_id("(void *)", FunctorsRttiId, !IO),
 		io__write_string(" }", !IO)
 	;
 		MaybeFunctorsName = no,
@@ -590,8 +591,9 @@
 	io__write_string(",\n\t", !IO),
 	(
 		MaybeLayoutName = yes(LayoutName),
-		io__write_string("{ (void *) &", !IO),
-		output_ctor_rtti_id(RttiTypeCtor, LayoutName, !IO),
+		LayoutRttiId = ctor_rtti_id(RttiTypeCtor, LayoutName),
+		io__write_string("{ ", !IO),
+		output_cast_addr_of_rtti_id("(void *)", LayoutRttiId, !IO),
 		io__write_string(" }", !IO)
 	;
 		MaybeLayoutName = no,
@@ -664,8 +666,7 @@
 		MaybeFunctorsName = yes(notag_functor_desc)
 	;
 		TypeCtorDetails = eqv(EqvType),
-		output_maybe_pseudo_type_info_defn(EqvType,
-			!DeclSet, !IO),
+		output_maybe_pseudo_type_info_defn(EqvType, !DeclSet, !IO),
 		TypeData = maybe_pseudo_type_info_to_rtti_data(EqvType),
 		output_rtti_data_decls(TypeData, "", "", 0, _,
 			!DeclSet, !IO),
@@ -715,8 +716,7 @@
 	NotagFunctor = notag_functor(FunctorName, ArgType, MaybeArgName),
 	output_maybe_pseudo_type_info_defn(ArgType, !DeclSet, !IO),
 	ArgTypeData = maybe_pseudo_type_info_to_rtti_data(ArgType),
-	output_rtti_data_decls(ArgTypeData, "", "", 0, _,
-		!DeclSet, !IO),
+	output_rtti_data_decls(ArgTypeData, "", "", 0, _, !DeclSet, !IO),
 	output_generic_rtti_data_defn_start(
 		ctor_rtti_id(RttiTypeCtor, notag_functor_desc),
 		!DeclSet, !IO),
@@ -1590,15 +1590,17 @@
 
 output_addr_of_rtti_id(RttiId, !IO) :-
 	%
-	% If the RttiName is not an array, then
-	% we need to use `&' to take its address
+	% If the RttiName is not an array, then we need to use `&'
+	% to take its address
 	%
-	( rtti_id_has_array_type(RttiId) = yes ->
-		true
+	( RttiId = ctor_rtti_id(_, pseudo_type_info(type_var(VarNum))) ->
+		io__write_int(VarNum, !IO)
+	; rtti_id_has_array_type(RttiId) = yes ->
+		output_rtti_id(RttiId, !IO)
 	;
-		io__write_string("&", !IO)
-	),
-	output_rtti_id(RttiId, !IO).
+		io__write_string("&", !IO),
+		output_rtti_id(RttiId, !IO)
+	).
 
 :- pred output_addr_of_ctor_rtti_id(rtti_type_ctor::in, ctor_rtti_name::in,
 	io__state::di, io__state::uo) is det.
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/error
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/moose/tests
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
Index: tests/debugger/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/debugger/Mmakefile,v
retrieving revision 1.102
diff -u -b -r1.102 Mmakefile
--- tests/debugger/Mmakefile	19 Mar 2004 09:51:58 -0000	1.102
+++ tests/debugger/Mmakefile	31 Mar 2004 10:48:32 -0000
@@ -24,6 +24,7 @@
 	exception_value			\
 	exception_vars			\
 	existential_type_classes	\
+	exported_eqv_type		\
 	field_names			\
 	higher_order			\
 	implied_instance		\
@@ -294,6 +295,9 @@
 		2>&1 | sed 's/string.m:[0-9]*/string.m:NNNN/g' | \
 		sed 's/int.m:[0-9]*/int.m:NNNN/g' \
 		> existential_type_classes.out
+
+exported_eqv_type.out: exported_eqv_type exported_eqv_type.inp
+	$(MDB) ./exported_eqv_type < exported_eqv_type.inp > exported_eqv_type.out 2>&1
 
 field_names.out: field_names field_names.inp
 	$(MDB) ./field_names < field_names.inp > field_names.out 2>&1
Index: tests/debugger/exported_eqv_type.exp
===================================================================
RCS file: tests/debugger/exported_eqv_type.exp
diff -N tests/debugger/exported_eqv_type.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/exported_eqv_type.exp	31 Mar 2004 16:41:07 -0000
@@ -0,0 +1,27 @@
+       1:      1  1 CALL pred exported_eqv_type.main/2-0 (det) exported_eqv_type.m:18
+mdb> echo on
+Command echo enabled.
+mdb> context none
+Contexts will not be printed.
+mdb> register --quiet
+mdb> break p
+ 0: + stop  interface func exported_eqv_type.p/2-0 (det)
+mdb> continue
+       2:      2  2 CALL func exported_eqv_type.p/2-0 (det)
+mdb> finish
+       3:      2  2 EXIT func exported_eqv_type.p/2-0 (det)
+mdb> print *
+       Num (arg 1)            	2
+       Item (arg 2)           	55
+       Dups (arg 3)           	[55, 55]
+mdb> continue
+       4:      3  2 CALL func exported_eqv_type.p/2-0 (det)
+mdb> finish
+       5:      3  2 EXIT func exported_eqv_type.p/2-0 (det)
+mdb> print *
+       Num (arg 1)            	3
+       Item (arg 2)           	"a"
+       Dups (arg 3)           	["a", "a", "a"]
+mdb> continue -S
+[55, 55]
+["a", "a", "a"]
Index: tests/debugger/exported_eqv_type.inp
===================================================================
RCS file: tests/debugger/exported_eqv_type.inp
diff -N tests/debugger/exported_eqv_type.inp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/exported_eqv_type.inp	31 Mar 2004 10:49:38 -0000
@@ -0,0 +1,11 @@
+echo on
+context none
+register --quiet
+break p
+continue
+finish
+print *
+continue
+finish
+print *
+continue -S
Index: tests/debugger/exported_eqv_type.m
===================================================================
RCS file: tests/debugger/exported_eqv_type.m
diff -N tests/debugger/exported_eqv_type.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/exported_eqv_type.m	31 Mar 2004 10:48:16 -0000
@@ -0,0 +1,29 @@
+% This test case used to cause the compiler to generate C code containing
+% a reference to an undefined common cell.
+
+:- module exported_eqv_type.
+
+:- interface.
+
+:- type bug(T) == T.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+
+main(!IO) :-
+	X = p(2, 55),
+	Y = p(3, "a"),
+	io__write(X, !IO),
+	io__nl(!IO),
+	io__write(Y, !IO),
+	io__nl(!IO).
+
+:- func p(int, bug(T)) = bug(list(T)).
+
+p(Num, Item) = Dups :-
+	list__duplicate(Num, Item, Dups).
cvs diff: Diffing tests/debugger/declarative
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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