[m-rev.] diff: fix MLDS nondet pragma c_code bug

[Fergus Henderson]

Estimated hours taken: 1
Branches: main

compiler/ml_code_gen.m:
	Fix a bug in the code generation for nondet pragma c_code.
	It was not resetting the MR_succeeded variable after each success,
	so if the C code did a SUCCEED and then when retried did a FAIL,
	then the FAIL was being treated as a SUCCEED_LAST.

tests/hard_coded/nondet_pragma_c_bug.m:
tests/hard_coded/nondet_pragma_c_bug.exp:
	A regression test.

Workspace: /home/ceres/fjh/mercury
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.115
diff -u -d -r1.115 ml_code_gen.m
--- compiler/ml_code_gen.m	30 May 2002 08:00:03 -0000	1.115
+++ compiler/ml_code_gen.m	30 May 2002 10:44:25 -0000
@@ -2168,6 +2168,7 @@
 	%				CONT();
 	%			}
 	%			if (MR_done) break;
+	%			MR_succeeded = FALSE;
 	%			<obtain global lock>
 	%			<user's later_code C code>
 	%		}
@@ -2309,6 +2310,7 @@
 	{ Ending_C_Code = [
 			raw_target_code("\t\t}\n", []),
 			raw_target_code("\t\tif (MR_done) break;\n", []),
+			raw_target_code("\tMR_succeeded = MR_FALSE;\n", []),
 			raw_target_code(ObtainLock, []),
 			raw_target_code("\t\t{\n", []),
 			user_target_code(LaterCode, LaterContext, []),
Index: tests/hard_coded/nondet_pragma_c_bug.exp
===================================================================
RCS file: tests/hard_coded/nondet_pragma_c_bug.exp
diff -N tests/hard_coded/nondet_pragma_c_bug.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/nondet_pragma_c_bug.exp	30 May 2002 10:55:57 -0000
@@ -0,0 +1,10 @@
+foo:
+20
+10
+42
+99
+bar:
+20
+10
+42
+99
Index: tests/hard_coded/nondet_pragma_c_bug.m
===================================================================
RCS file: tests/hard_coded/nondet_pragma_c_bug.m
diff -N tests/hard_coded/nondet_pragma_c_bug.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/nondet_pragma_c_bug.m	30 May 2002 10:55:23 -0000
@@ -0,0 +1,67 @@
+:- module nondet_pragma_c_bug.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module std_util.
+
+main -->
+	print("foo:\n"),
+	unsorted_aggregate(foo, print_soln),
+	print("bar:\n"),
+	unsorted_aggregate(bar, print_soln).
+
+:- pred print_soln(int::in, io::di, io::uo) is det.
+print_soln(Soln) --> write(Soln), nl.
+
+:- pred foo(int).
+:- mode foo(out) is nondet.
+:- pragma c_code(foo(X::out), [may_call_mercury],
+        local_vars("
+                int state;
+        "),
+        first_code("
+                LOCALS->state = 1;
+        "),
+        retry_code("
+                LOCALS->state++;
+        "),
+        common_code("
+                switch (LOCALS->state) {
+                        case 1: X = 20; SUCCEED; break;
+                        case 2: X = 10; SUCCEED; break;
+                        case 3: X = 42; SUCCEED; break;
+                        case 4: X = 99; SUCCEED; break;
+                        case 5: FAIL; break;
+                }
+        ")
+).
+
+:- pred bar(int).
+:- mode bar(out) is nondet.
+:- pragma c_code(bar(X::out), [may_call_mercury],
+        local_vars("
+                int state;
+        "),
+        first_code("
+                LOCALS->state = 1;
+        "),
+        retry_code("
+                LOCALS->state++;
+        "),
+        common_code("
+                switch (LOCALS->state) {
+                        case 1: X = 20; SUCCEED; break;
+                        case 2: X = 10; SUCCEED; break;
+                        case 3: X = 42; SUCCEED; break;
+                        case 4: X = 99; SUCCEED; break;
+                        case 5: X = 123; FAIL; break;
+                }
+        ")
+).
+

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
The University of Melbourne         |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------