[m-rev.] diff: fixes to compile tests/hard_coded in il grade

Peter Ross pro at missioncriticalit.com
Fri Nov 29 03:14:35 AEDT 2002


Hi,


===================================================================


Estimated hours taken: 3
Branches: main

Get the tests in hard_coded to compile in the grade il.  The tests may
still fail because of other reasons.

tests/hard_coded/constraint_order.m:
tests/hard_coded/copy_pred.m:
tests/hard_coded/copy_pred_2.m:
tests/hard_coded/dupcall_impurity.m:
tests/hard_coded/export_test.m:
tests/hard_coded/foreign_import_module.m:
tests/hard_coded/foreign_type3.m:
tests/hard_coded/ho_solns.m:
tests/hard_coded/ho_univ_to_type.m:
tests/hard_coded/impure_foreign.m:
tests/hard_coded/impure_prune.m:
tests/hard_coded/intermod_c_code2.m:
tests/hard_coded/intermod_multimode.m:
tests/hard_coded/multimode.m:
tests/hard_coded/no_inline.m:
tests/hard_coded/rnd.m:
	Provide C# implementation of C code.

tests/hard_coded/existential_types_test.m:
tests/hard_coded/frameopt_pragma_redirect.m:
tests/hard_coded/mode_choice.m:
tests/hard_coded/pragma_c_code.m:
tests/hard_coded/pragma_inline.m:
tests/hard_coded/target_mlobjs.m:
tests/hard_coded/unused_float_box_test.m:
	Provide Mercury implementation of C code.

tests/hard_coded/redoip_clobber.m:
	Provide MC++ implementation of C code.



Index: tests/hard_coded/constraint_order.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/constraint_order.m,v
retrieving revision 1.1
diff -u -r1.1 constraint_order.m
--- tests/hard_coded/constraint_order.m	11 Aug 2001 14:09:57 -0000	1.1
+++ tests/hard_coded/constraint_order.m	28 Nov 2002 15:42:41 -0000
@@ -40,4 +40,5 @@
 :- impure pred unsafe_write_string(string::in) is det.
 
 :- pragma c_code(unsafe_write_string(Str::in), "printf(Str);").
-	
+:- pragma foreign_proc("C#", unsafe_write_string(Str::in), [],
+		"System.Console.Write(Str);").
Index: tests/hard_coded/copy_pred.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/copy_pred.m,v
retrieving revision 1.1
diff -u -r1.1 copy_pred.m
--- tests/hard_coded/copy_pred.m	19 Oct 1999 04:11:44 -0000	1.1
+++ tests/hard_coded/copy_pred.m	28 Nov 2002 15:42:41 -0000
@@ -23,6 +23,9 @@
 	:- mode inst_cast(in, out(pred(in, out) is det)) is det.
 	:- pragma c_code(inst_cast(X::in, Y::out(pred(in, out) is det)),
 		[will_not_call_mercury, thread_safe], "Y = X").
+	:- pragma foreign_proc("C#",
+		inst_cast(X::in, Y::out(pred(in, out) is det)),
+		[will_not_call_mercury, thread_safe, promise_pure], "Y = X;").
 
         :- pred foo(int, int, string, string) is det.
         :- mode foo(in, in, in, out) is det.
Index: tests/hard_coded/copy_pred_2.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/copy_pred_2.m,v
retrieving revision 1.1
diff -u -r1.1 copy_pred_2.m
--- tests/hard_coded/copy_pred_2.m	7 Aug 2001 23:12:32 -0000	1.1
+++ tests/hard_coded/copy_pred_2.m	28 Nov 2002 15:42:41 -0000
@@ -29,6 +29,9 @@
 	:- mode inst_cast(in, out(pred(in, out) is det)) is det.
 	:- pragma c_code(inst_cast(X::in, Y::out(pred(in, out) is det)),
 		[will_not_call_mercury, thread_safe], "Y = X").
+	:- pragma foreign_proc("C#",
+		inst_cast(X::in, Y::out(pred(in, out) is det)),
+		[will_not_call_mercury, thread_safe, promise_pure], "Y = X;").
 
 	:- pred foo(T, T, string, string).
 	:- mode foo(in, in, in, out) is det.
Index: tests/hard_coded/dupcall_impurity.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/dupcall_impurity.m,v
retrieving revision 1.1
diff -u -r1.1 dupcall_impurity.m
--- tests/hard_coded/dupcall_impurity.m	6 Dec 2001 10:16:44 -0000	1.1
+++ tests/hard_coded/dupcall_impurity.m	28 Nov 2002 15:42:45 -0000
@@ -41,3 +41,9 @@
 :- pragma c_code(next_x(X::out), "X = my_global++;").
 :- pragma c_code(incr_x, "my_global++;").
 
+:- pragma foreign_code("C#", "static int my_global;").
+
+:- pragma foreign_proc("C#", get_x(X::out),
+		[promise_semipure], "X = my_global;").
+:- pragma foreign_proc("C#", next_x(X::out), [], "X = my_global++;").
+:- pragma foreign_proc("C#", incr_x, [], "my_global++;").
Index: tests/hard_coded/existential_types_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/existential_types_test.m,v
retrieving revision 1.7
diff -u -r1.7 existential_types_test.m
--- tests/hard_coded/existential_types_test.m	8 Apr 2001 08:44:46 -0000	1.7
+++ tests/hard_coded/existential_types_test.m	28 Nov 2002 15:42:45 -0000
@@ -14,8 +14,6 @@
 
 :- some [T] func my_exist_t = T.
 
-:- some [T] pred has_type(T::unused, type_desc::in) is det.
-
 :- import_module io.
 
 :- pred main(io__state::di, state::uo) is det.
@@ -39,16 +37,4 @@
 
 call_my_univ_value(Univ) = my_univ_value(Univ).
 
-:- pragma c_code(my_univ_value(Univ::in) = (Value::out), will_not_call_mercury, "{
-	MR_TypeInfo type_info;
-
-	MR_unravel_univ(Univ, type_info, Value);
-	TypeInfo_for_T = (MR_Word) type_info;
-}").
-
-% The predicate has_type/2 is basically an existentially typed
-% inverse to the function type_of/1.
-
-:- pragma c_code(has_type(_Arg::unused, TypeInfo::in), will_not_call_mercury,
-	"TypeInfo_for_T = TypeInfo;"
-).
+my_univ_value(Univ) = univ_value(Univ).
Index: tests/hard_coded/export_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/export_test.m,v
retrieving revision 1.2
diff -u -r1.2 export_test.m
--- tests/hard_coded/export_test.m	11 Sep 1997 02:11:56 -0000	1.2
+++ tests/hard_coded/export_test.m	28 Nov 2002 15:42:45 -0000
@@ -29,3 +29,7 @@
 "
 	foo(X, &Y);
 ").
+:- pragma foreign_proc("C#", bar(X::in, Y::out),
+		[may_call_mercury, promise_pure], "
+	export_test.mercury_code.foo(X, ref Y);
+").
Index: tests/hard_coded/foreign_import_module.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/foreign_import_module.m,v
retrieving revision 1.1
diff -u -r1.1 foreign_import_module.m
--- tests/hard_coded/foreign_import_module.m	6 Nov 2001 15:21:26 -0000	1.1
+++ tests/hard_coded/foreign_import_module.m	28 Nov 2002 15:42:45 -0000
@@ -21,3 +21,7 @@
 "
 	foo(X, &Y);
 ").
+:- pragma foreign_proc("C#", bar(X::in, Y::out),
+		[may_call_mercury, promise_pure], "
+	foreign_import_module_2.mercury_code.foo(X, ref Y);
+").
Index: tests/hard_coded/foreign_type3.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/foreign_type3.m,v
retrieving revision 1.1
diff -u -r1.1 foreign_type3.m
--- tests/hard_coded/foreign_type3.m	4 Sep 2002 08:31:53 -0000	1.1
+++ tests/hard_coded/foreign_type3.m	28 Nov 2002 15:42:45 -0000
@@ -29,20 +29,43 @@
 } coord;
 ").
 
+:- pragma foreign_decl("C#", "
+public enum dirs {
+	north,
+	east,
+	west,
+	south
+}
+
+public struct coord {
+	public int x;
+	public int y;
+}
+").
+
 :- type dir.
 :- pragma foreign_type(c, dir, "dirs").
+:- pragma foreign_type(il, dir,
+		"valuetype [foreign_type3__csharp_code]dirs").
 
 :- type coord.
 :- pragma foreign_type(c, coord, "coord").
+:- pragma foreign_type(il, coord,
+		"valuetype [foreign_type3__csharp_code]coord").
 
 :- type double.
 :- pragma foreign_type(c, double, "double").
+:- pragma foreign_type(il, double, "valuetype [mscorlib]System.Double").
 
 :- func north = dir.
 :- pragma foreign_proc(c, north = (E::out),
 		[will_not_call_mercury, promise_pure], "
 	E = north;
 ").
+:- pragma foreign_proc("C#", north = (E::out),
+		[will_not_call_mercury, promise_pure], "
+	E = dirs.north;
+").
 
 :- func new(int, int) = coord.
 :- pragma foreign_proc(c, new(X::in, Y::in) = (C::out),
@@ -50,9 +73,18 @@
 	C.x = X;
 	C.y = Y;
 ").
+:- pragma foreign_proc("C#", new(X::in, Y::in) = (C::out),
+		[will_not_call_mercury, promise_pure], "
+	C.x = X;
+	C.y = Y;
+").
 
 :- func pi = double.
 :- pragma foreign_proc(c, pi = (Pi::out),
+		[will_not_call_mercury, promise_pure], "
+	Pi = 3.14;
+").
+:- pragma foreign_proc("C#", pi = (Pi::out),
 		[will_not_call_mercury, promise_pure], "
 	Pi = 3.14;
 ").
Index: tests/hard_coded/frameopt_pragma_redirect.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/frameopt_pragma_redirect.m,v
retrieving revision 1.1
diff -u -r1.1 frameopt_pragma_redirect.m
--- tests/hard_coded/frameopt_pragma_redirect.m	12 Nov 1999 03:47:08 -0000	1.1
+++ tests/hard_coded/frameopt_pragma_redirect.m	28 Nov 2002 15:42:45 -0000
@@ -60,6 +60,7 @@
 :- pragma c_code(is_invalid(X :: in),
 	[will_not_call_mercury, thread_safe], 
 	"SUCCESS_INDICATOR = X > 50;").
+is_invalid(X) :- X > 50.
 
 main -->
 	{ add_interval_list([1 - 2, 3 - 4, 5 - 6, 7 - 8, 9 - 10], I) },
Index: tests/hard_coded/ho_solns.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/ho_solns.m,v
retrieving revision 1.2
diff -u -r1.2 ho_solns.m
--- tests/hard_coded/ho_solns.m	2 Sep 2001 12:20:13 -0000	1.2
+++ tests/hard_coded/ho_solns.m	28 Nov 2002 15:42:45 -0000
@@ -39,6 +39,13 @@
 	L = L0;
 }
 ").
+:- pragma foreign_proc("C#",
+	convert_list(L0 :: in, L :: out(list_skel(mypred))),
+	[promise_pure], "
+{
+	L = L0;
+}
+").
 
 :- pred use_list(list(mypred), io__state, io__state).
 :- mode use_list(in(list_skel(mypred)), di, uo) is det.
Index: tests/hard_coded/ho_univ_to_type.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/ho_univ_to_type.m,v
retrieving revision 1.2
diff -u -r1.2 ho_univ_to_type.m
--- tests/hard_coded/ho_univ_to_type.m	2 Sep 2001 12:20:13 -0000	1.2
+++ tests/hard_coded/ho_univ_to_type.m	28 Nov 2002 15:42:45 -0000
@@ -57,5 +57,11 @@
 	Pred2 = Pred1;
 }
 ").
+:- pragma foreign_proc("C#", convert_inst(Pred1::in, Pred2::out(mypred)),
+		[promise_pure], "
+{
+	Pred2 = Pred1;
+}
+").
 
 
Index: tests/hard_coded/impure_foreign.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/impure_foreign.m,v
retrieving revision 1.1
diff -u -r1.1 impure_foreign.m
--- tests/hard_coded/impure_foreign.m	16 Dec 2001 08:11:18 -0000	1.1
+++ tests/hard_coded/impure_foreign.m	28 Nov 2002 15:42:45 -0000
@@ -41,12 +41,16 @@
 	int counter = 1;
 ").
 
+:- pragma foreign_code("C#", "static int counter = 1;").
+
 :- impure pred incr(int::out) is det.
 
 incr(_::out) :- error("incr/1 called for language other than C").
 
 :- pragma foreign_proc("C", incr(Val::out), [will_not_call_mercury],
 			"counter++; Val = counter;").
+:- pragma foreign_proc("C#", incr(Val::out), [will_not_call_mercury],
+			"counter++; Val = counter;").
 
 :- semipure pred get(int::out) is det.
 
@@ -55,6 +59,9 @@
 :- pragma foreign_proc("C", get(Val::out),
 		[will_not_call_mercury, promise_semipure],
 		"Val = counter").
+:- pragma foreign_proc("C#", get(Val::out),
+		[will_not_call_mercury, promise_semipure],
+		"Val = counter;").
 	
 :- pred unsafe_get(int::out) is det.
 :- pragma promise_pure(unsafe_get/1).
Index: tests/hard_coded/impure_prune.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/impure_prune.m,v
retrieving revision 1.2
diff -u -r1.2 impure_prune.m
--- tests/hard_coded/impure_prune.m	5 Dec 2000 02:10:56 -0000	1.2
+++ tests/hard_coded/impure_prune.m	28 Nov 2002 15:42:45 -0000
@@ -38,3 +38,8 @@
 :- pragma c_code(get_counter(X::out), will_not_call_mercury, "X = counter;").
 :- pragma c_code(set_counter(X::in), will_not_call_mercury, "counter = X;").
 
+:- pragma foreign_code("C#", "static int counter = 0;").
+:- pragma foreign_proc("C#", get_counter(X::out),
+		[promise_semipure], "X = counter;").
+:- pragma foreign_proc("C#", set_counter(X::in), [], "counter = X;").
+
Index: tests/hard_coded/intermod_c_code2.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/intermod_c_code2.m,v
retrieving revision 1.1
diff -u -r1.1 intermod_c_code2.m
--- tests/hard_coded/intermod_c_code2.m	5 Mar 2001 04:02:39 -0000	1.1
+++ tests/hard_coded/intermod_c_code2.m	28 Nov 2002 15:42:45 -0000
@@ -15,4 +15,9 @@
 	U = T;
 	TypeInfo_for_U = TypeInfo_for_T;
 }").
+:- pragma foreign_proc("C#", c_code_2(T::in, U::out), [promise_pure],
+"{
+	U = T;
+	TypeInfo_for_U = TypeInfo_for_T;
+}").
 
Index: tests/hard_coded/intermod_multimode.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/intermod_multimode.m,v
retrieving revision 1.3
diff -u -r1.3 intermod_multimode.m
--- tests/hard_coded/intermod_multimode.m	28 Aug 2001 09:27:42 -0000	1.3
+++ tests/hard_coded/intermod_multimode.m	28 Nov 2002 15:42:45 -0000
@@ -85,6 +85,7 @@
 	impure puts("test2(out, out)").
 
 :- pragma c_code(puts(S::in), [will_not_call_mercury], "puts(S)").
+:- pragma foreign_proc("C#", puts(S::in), [], "System.Console.WriteLine(S);").
 
 :- pragma promise_pure(get_determinism/2).
 :- pragma inline(get_determinism/2).
Index: tests/hard_coded/mode_choice.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/mode_choice.m,v
retrieving revision 1.2
diff -u -r1.2 mode_choice.m
--- tests/hard_coded/mode_choice.m	18 Feb 2002 07:01:27 -0000	1.2
+++ tests/hard_coded/mode_choice.m	28 Nov 2002 15:42:45 -0000
@@ -54,15 +54,23 @@
 :- mode test1(in, out, out) is semidet.
 :- mode test1(in, in, out) is semidet.
 
+	
+:- pragma promise_pure(test1/3).
 :- pragma c_code(test1(_A::in, B::out, C::out), will_not_call_mercury, "
 	B = C = ""test1(in, out, out)"";
 	SUCCESS_INDICATOR = MR_TRUE;
 ").
+test1(_A::in, B::out, C::out) :-
+	B = C,
+	B = "test1(in, out, out)".
 
 :- pragma c_code(test1(_A::in, _B::in, C::out), will_not_call_mercury, "
 	C = ""test1(in, in, out)"";
 	SUCCESS_INDICATOR = MR_TRUE;
 "). 
+test1(_A::in, _B::in, C::out) :-
+	C = "test1(in, in, out)".
+
 
 % prefer `di' to `uo'
 
@@ -70,13 +78,18 @@
 :- mode test2(in, out) is det.
 :- mode test2(di, uo) is det.
 
+:- pragma promise_pure(test2/2).
 :- pragma c_code(test2(_A::in, B::out), will_not_call_mercury, "
 	B = ""test2(in, out)"";
 ").
+test2(_A::in, B::out) :-
+	B = "test2(in, out)".
 
 :- pragma c_code(test2(_A::di, B::uo), will_not_call_mercury, "
 	B = ""test2(di, uo)"";
 ").
+test2(_A::di, B::uo) :-
+	B = "test2(di, uo)".
 
 /******* `ui' modes not yet supported
 % prefer `ui' to `in'
@@ -98,6 +111,9 @@
 :- pragma c_code(mkany(S::out(any)), will_not_call_mercury, "
 	S = NULL;
 ").
+:- pragma foreign_proc("C#", mkany(S::out(any)), [promise_pure], "
+	S = null;
+").
 
 % prefer in(any) over out(any)
 % [i.e. any -> any beats free -> any]
@@ -106,14 +122,20 @@
 :- mode test3(in(any), out) is det.
 :- mode test3(out(any), out) is det.
 
+:- pragma promise_pure(test3/2).
 :- pragma c_code(test3(_A::in(any), B::out), will_not_call_mercury, "
 	B = ""test3(in(any), out)"";
 ").
+test3(_A::in(any), B::out) :-
+	B = "test3(in(any), out)".
 
 :- pragma c_code(test3(A::out(any), B::out), will_not_call_mercury, "
 	A = NULL;
 	B = ""test3(out(any), out)"";
 ").
+test3(A::out(any), B::out) :-
+	mkany(A),
+	B = "test3(out(any), out)".
 
 % for non-comparable modes, pick the first one
 
@@ -121,15 +143,22 @@
 :- mode test4(in, out, out) is det.
 :- mode test4(out, in, out) is det.
 
+:- pragma promise_pure(test4/3).
 :- pragma c_code(test4(_A::in, B::out, C::out), will_not_call_mercury, "
 	B = """";
 	C = ""test4(in, out, out)"";
 ").
+test4(_A::in, B::out, C::out) :-
+	B = "",
+	C = "test4(in, out, out)".
 
 :- pragma c_code(test4(A::out, _B::in, C::out), will_not_call_mercury, "
 	A = """";
 	C = ""test4(out, in, out)"";
 ").
+test4(A::out, _B::in, C::out) :-
+	A = "",
+	C = "test4(out, in, out)".
 
 % for non-comparable modes, pick the first one
 
@@ -141,11 +170,16 @@
 :- mode test5(in(a), in(ab), out) is det.
 :- mode test5(in(ab), in(b), out) is det.
 
+:- pragma promise_pure(test5/3).
 :- pragma c_code(test5(_A::in(a), _B::in(ab), C::out), will_not_call_mercury, "
 	C = ""test5(in(a), in(ab), out)"";
 ").
+test5(_A::in(a), _B::in(ab), C::out) :-
+	C = "test5(in(a), in(ab), out)".
+	
 
 :- pragma c_code(test5(_A::in(ab), _B::in(b), C::out), will_not_call_mercury, "
 	C = ""test5(in(ab), in(b), out)"";
 ").
-
+test5(_A::in(ab), _B::in(b), C::out) :-
+	C = "test5(in(ab), in(b), out)".
Index: tests/hard_coded/multimode.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/multimode.m,v
retrieving revision 1.2
diff -u -r1.2 multimode.m
--- tests/hard_coded/multimode.m	18 May 2001 09:43:03 -0000	1.2
+++ tests/hard_coded/multimode.m	28 Nov 2002 15:42:45 -0000
@@ -87,3 +87,5 @@
 
 :- impure pred puts(string::in) is det.
 :- pragma c_code(puts(S::in), [will_not_call_mercury], "puts(S)").
+:- pragma foreign_proc("C#", puts(S::in),
+		[promise_pure], "System.Console.WriteLine(S);").
Index: tests/hard_coded/no_inline.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/no_inline.m,v
retrieving revision 1.4
diff -u -r1.4 no_inline.m
--- tests/hard_coded/no_inline.m	7 Dec 2001 03:59:42 -0000	1.4
+++ tests/hard_coded/no_inline.m	28 Nov 2002 15:42:45 -0000
@@ -32,3 +32,5 @@
 	Value = counter++;
 }
 ").
+:- pragma foreign_code("C#", "static int counter = 0;").
+:- pragma foreign_proc("C#", bar(Value::out), [], "Value = counter++;").
Index: tests/hard_coded/pragma_c_code.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/pragma_c_code.m,v
retrieving revision 1.6
diff -u -r1.6 pragma_c_code.m
--- tests/hard_coded/pragma_c_code.m	25 Nov 2000 10:42:04 -0000	1.6
+++ tests/hard_coded/pragma_c_code.m	28 Nov 2002 15:42:45 -0000
@@ -7,6 +7,7 @@
 :- pred main(io__state::di, io__state::uo) is det.
 
 :- implementation.
+:- import_module int, list, math, string.
 
 main --> 
 	c_write_string("Hello, world\n"),
@@ -26,6 +27,8 @@
 	printf(""%s"", Message);
 	IO = IO0;
 ").
+c_write_string(Str) -->
+	io__write_string(Str).
 
 :- pred c_incr_and_decr(int::in, int::out, int::out) is det.
 
@@ -33,6 +36,7 @@
 	Int1 = Int0 + 1;
 	Int2 = Int0 - 1;
 ").
+c_incr_and_decr(A, A + 1, A - 1).
 
 :- pred c_write_integer(int::in, io__state::di, io__state::uo) is det.
 
@@ -40,10 +44,13 @@
 	printf(""%ld\\n"", (long) Int);
 	IO = IO0;
 ").
+c_write_integer(Int) -->
+	io__format("%d\n", [i(Int)]).
 
 :- pred c_get_meaning_of_life(float::out) is det.
 
 :- pragma(c_code, c_get_meaning_of_life(X::out), "X = 42.0;").
+c_get_meaning_of_life(42.0).
 
 :- pred c_write_float(float::in, io__state::di, io__state::uo) is det.
 
@@ -51,6 +58,8 @@
 	printf(""%.1f\\n"", X);
 	IO = IO0;
 ").
+c_write_float(F) -->
+	io__format("%f\n", [f(F)]).
 
 :- pragma(c_header_code, "#include <math.h>").
 
@@ -60,3 +69,5 @@
 	printf(""%.3f\\n"", cos(X));
 	IO = IO0;
 ").
+c_write_cosine(F) -->
+	io__format("%.3f\n", [f(cos(F))]).
Index: tests/hard_coded/pragma_inline.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/pragma_inline.m,v
retrieving revision 1.8
diff -u -r1.8 pragma_inline.m
--- tests/hard_coded/pragma_inline.m	31 Jan 2001 18:52:06 -0000	1.8
+++ tests/hard_coded/pragma_inline.m	28 Nov 2002 15:42:45 -0000
@@ -27,6 +27,8 @@
         printf(""%s"", Message);
         IO = IO0;
 ").
+c_write_string(Str) -->
+	io__write_string(Str).
 
 :- pragma(inline, c_write_string/3).
 
@@ -47,3 +49,4 @@
 	strcpy(S3, S1);
 	strcpy(S3 + len_1, S2);
 }").
+append_strings(A, B, A ++ B).
Index: tests/hard_coded/redoip_clobber.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/redoip_clobber.m,v
retrieving revision 1.3
diff -u -r1.3 redoip_clobber.m
--- tests/hard_coded/redoip_clobber.m	18 Feb 2002 07:01:27 -0000	1.3
+++ tests/hard_coded/redoip_clobber.m	28 Nov 2002 15:42:45 -0000
@@ -59,6 +59,26 @@
 
 	SUCCESS_INDICATOR = MR_FALSE;
 ").
+:- pragma foreign_proc("MC++", use(X::in),
+	[will_not_call_mercury, promise_pure],
+"
+	/*
+	** To exhibit the bug, this predicate needs only to fail.
+	** However, the symptom of the bug is an infinite loop.
+	** To detect the presence of the bug in finite time,
+	** we abort execution if this code is executed too many times.
+	**
+	** We mention X here to shut up a warning.
+	*/
+
+	static int counter = 0;
+
+	if (++counter > 100) {
+		throw new System::Exception(""the bug is back"");
+	}
+
+	SUCCESS_INDICATOR = MR_FALSE;
+").
 
 main -->
 	( { foo(X), use(X) } ->
Index: tests/hard_coded/rnd.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/rnd.m,v
retrieving revision 1.1
diff -u -r1.1 rnd.m
--- tests/hard_coded/rnd.m	18 Feb 1998 03:24:46 -0000	1.1
+++ tests/hard_coded/rnd.m	28 Nov 2002 15:42:46 -0000
@@ -242,9 +242,13 @@
 
 :- func rfloat(int) = float.
 :- pragma c_code(rfloat(I::in) = (F::out), "F = I;").
+:- pragma foreign_proc("C#", rfloat(I::in) = (F::out),
+		[promise_pure], "F = I;").
 
 :- func rint(float) = int.
 :- pragma c_code(rint(F::in) = (I::out), "I = F;").
+:- pragma foreign_proc("C#", rint(F::in) = (I::out),
+		[promise_pure], "I = (int) F;").
 
 :- pred for(int, int, pred(int, T, T), T, T).
 :- mode for(in, in, pred(in, in, out) is det, in, out) is det.
Index: tests/hard_coded/target_mlobjs.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/target_mlobjs.m,v
retrieving revision 1.1
diff -u -r1.1 target_mlobjs.m
--- tests/hard_coded/target_mlobjs.m	7 Jan 2002 07:48:19 -0000	1.1
+++ tests/hard_coded/target_mlobjs.m	28 Nov 2002 15:42:46 -0000
@@ -16,4 +16,5 @@
 	c_write_string(Message);
 	IO = IO0;
 ").
-
+c_write_string(Str) -->
+	io__write_string(Str).
Index: tests/hard_coded/unused_float_box_test.m
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/unused_float_box_test.m,v
retrieving revision 1.2
diff -u -r1.2 unused_float_box_test.m
--- tests/hard_coded/unused_float_box_test.m	20 Jan 2002 07:32:32 -0000	1.2
+++ tests/hard_coded/unused_float_box_test.m	28 Nov 2002 15:42:46 -0000
@@ -79,6 +79,9 @@
 {
 	abort();
 }").
+get_notag_functor_info(_, _) :-
+	semidet_succeed,
+	private_builtin__sorry("local get_notag_functor_info").
 
     % from the type stored in the univ.)
 :- pred get_equiv_functor_info(Univ::in, ExpUniv::out) is semidet.
@@ -89,6 +92,9 @@
 {
 	abort();
 }").
+get_equiv_functor_info(_, _) :-
+	semidet_succeed,
+	private_builtin__sorry("local get_equiv_functor_info").
 
 :- pred get_enum_functor_info(Univ::in, Int::out) is semidet.
 
@@ -98,6 +104,9 @@
 {
 	abort();
 }").
+get_enum_functor_info(_, _) :-
+	semidet_succeed,
+	private_builtin__sorry("local get_enum_functor_info").
 
 :- pred get_du_functor_info(my_univ::in, int::out, int::out, int::out,
     list(univ)::out) is semidet.
@@ -108,6 +117,9 @@
 {
 	abort();
 }").
+get_du_functor_info(_, _, _, _, _) :-
+	semidet_succeed,
+	private_builtin__sorry("local get_du_functor_info").
 
 %------------------------------------------------------------------------------%
 

--------------------------------------------------------------------------
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