[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