[m-rev.] diff: fix bug in exported procs with foreign_type outputs

[Zoltan Somogyi]

compiler/export.m:
	Fix a bug. Output arguments of exported predicates are passed by
	reference, but the code to return them was assigning the returned value
	to the pointer, not the pointed-to storage. The fix is to add the
	required indirection.

tests/hard_coded/foreign_type.{m,exp}:
	Expand this test case to act as a regression test for this bug.
	Prior to this change, the compiler generated code that core dumped
	on the last batch of coordinates.

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/export.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/export.m,v
retrieving revision 1.67
diff -u -b -r1.67 export.m
--- compiler/export.m	26 May 2003 08:59:53 -0000	1.67
+++ compiler/export.m	24 Jun 2003 21:59:57 -0000
@@ -540,7 +540,7 @@
 			C_Type = foreign__to_type_string(c, Export_Type),
 			string__append_list(
 				["\tMR_MAYBE_UNBOX_FOREIGN_TYPE(",
-				C_Type, ", ", ArgLocString, ", ",
+				C_Type, ", ", ArgLocString, ", * ",
 				ArgName, ");\n"], OutputArg)
 		;
 			string__append_list(
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/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
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
Index: tests/hard_coded/foreign_type.exp
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/foreign_type.exp,v
retrieving revision 1.1
diff -u -b -r1.1 foreign_type.exp
--- tests/hard_coded/foreign_type.exp	7 May 2002 11:02:42 -0000	1.1
+++ tests/hard_coded/foreign_type.exp	24 Jun 2003 22:17:08 -0000
@@ -1,2 +1,8 @@
 X:4
 Y:5
+X:42
+Y:52
+X:420
+Y:520
+X:4201
+Y:5201
Index: tests/hard_coded/foreign_type.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/foreign_type.m,v
retrieving revision 1.5
diff -u -b -r1.5 foreign_type.m
--- tests/hard_coded/foreign_type.m	17 Feb 2003 06:02:22 -0000	1.5
+++ tests/hard_coded/foreign_type.m	24 Jun 2003 22:11:56 -0000
@@ -13,6 +13,12 @@
 :- func new(int, int) = coord.
 :- pragma export(new(in, in) = out, "exported_new").
 
+:- pred newpred(int::in, int::in, coord::out) is det.
+:- pragma export(newpred(in, in, out), "exported_newpred").
+
+:- func export_new(int, int) = coord.
+:- pred export_newpred(int::in, int::in, coord::out) is det.
+
 :- func x(coord) = int.
 :- func y(coord) = int.
 
@@ -23,6 +29,27 @@
 	io__nl,
 	io__write_string("Y:"),
 	io__write_int(y(C)),
+	io__nl,
+	{ newpred(42, 52, D) },
+	io__write_string("X:"),
+	io__write_int(x(D)),
+	io__nl,
+	io__write_string("Y:"),
+	io__write_int(y(D)),
+	io__nl,
+	{ E = export_new(420, 520) },
+	io__write_string("X:"),
+	io__write_int(x(E)),
+	io__nl,
+	io__write_string("Y:"),
+	io__write_int(y(E)),
+	io__nl,
+	{ export_newpred(4201, 5201, F) },
+	io__write_string("X:"),
+	io__write_int(x(F)),
+	io__nl,
+	io__write_string("Y:"),
+	io__write_int(y(F)),
 	io__nl.
 
 %----------------------------------------------------------------------------%
@@ -48,6 +75,14 @@
 	C.y = Y;
 ").
 
+:- pragma foreign_proc("C#", newpred(X::in, Y::in, C::out),
+	[will_not_call_mercury, promise_pure],
+"
+	C = new coord();
+	C.x = X;
+	C.y = Y;
+").
+
 :- pragma foreign_proc("C#", x(C::in) = (X::out),
 	[will_not_call_mercury, promise_pure],
 "
@@ -80,6 +115,14 @@
 	C->y = Y;
 ").
 
+:- pragma foreign_proc(c, newpred(X::in, Y::in, C::out),
+	[will_not_call_mercury, promise_pure],
+"
+	C = MR_GC_NEW(coord);
+	C->x = X;
+	C->y = Y;
+").
+
 :- pragma foreign_proc(c, x(C::in) = (X::out),
 	[will_not_call_mercury, promise_pure],
 "
@@ -98,6 +141,29 @@
 :- type coord ---> coord(x :: int, y :: int).
 
 new(X, Y) = coord(X, Y).
+newpred(X, Y, coord(X, Y)).
 
 %----------------------------------------------------------------------------%
+
+:- pragma foreign_proc(c, export_new(X::in, Y::in) = (C::out),
+	[will_not_call_mercury, promise_pure],
+"
+	coord *local_c;
+	local_c = exported_new(X, Y);
+	C = local_c;
+").
+
+export_new(X, Y) = new(X, Y).
+
+:- pragma foreign_proc(c, export_newpred(X::in, Y::in, C::out),
+	[will_not_call_mercury, promise_pure],
+"
+	coord *local_c;
+	exported_newpred(X, Y, &local_c);
+	C = local_c;
+").
+
+export_newpred(X, Y, C) :-
+	newpred(X, Y, C).
+
 %----------------------------------------------------------------------------%
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
--------------------------------------------------------------------------