[m-rev.] diff: fix spawn_many test case

[Peter Wang]

Estimated hours taken: 0.5
Branches: main

tests/par_conj/spawn_many.m:
	Fix an implicit assumption in this test case that the child threads
	will manage to write to the channel faster than the main thread can
	read from it.

tests/par_conj/Mmakefile:
	Reduce the peak memory usage of the spawn_many test case.


Index: par_conj/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/par_conj/Mmakefile,v
retrieving revision 1.12
diff -u -r1.12 Mmakefile
--- par_conj/Mmakefile	30 Apr 2007 06:49:21 -0000	1.12
+++ par_conj/Mmakefile	1 May 2007 01:05:43 -0000
@@ -147,7 +147,10 @@
 # Run spawn_many with smallish C stacks, so we don't need to spawn so many
 # threads to see the bug.
 spawn_many.out: spawn_many
-	ulimit -s 256 && $(ENGINES) ./spawn_many 2>&1 > spawn_many.out || \
+	ulimit -s 256 && \
+		MERCURY_OPTIONS='-P2 --detstack-size 32 --small-detstack-size 32 \
+			--nondetstack-size 16 --small-nondetstack-size 16' \
+		./spawn_many 2>&1 > spawn_many.out || \
 		{ grep . $@ /dev/null; exit 1; }
 
 endif
Index: par_conj/spawn_many.m
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/par_conj/spawn_many.m,v
retrieving revision 1.1
diff -u -r1.1 spawn_many.m
--- par_conj/spawn_many.m	30 Apr 2007 06:49:21 -0000	1.1
+++ par_conj/spawn_many.m	1 May 2007 00:48:28 -0000
@@ -11,28 +11,25 @@
 
 :- import_module io.
 
-:- pred main(io::di, io::uo) is cc_multi.
+:- impure pred main(io::di, io::uo) is cc_multi.
 
 :- implementation.
 
 :- import_module int.
-:- import_module list.
-:- import_module maybe.
-:- import_module string.
 :- import_module thread.
 :- import_module thread.channel.
 :- import_module unit.
 
 main(!IO) :-
+    % Set a signal to go off if the program is taking too long.
+    % The default SIGALRM handler will abort the program.
+    impure alarm(10),
+
     NumSpawn = 5000,
     channel.init(Channel, !IO),
     loop(Channel, NumSpawn, !IO),
-    count(Channel, 0, NumExit, !IO),
-    (if NumSpawn = NumExit then
-        io.write_string("ok\n", !IO)
-    else
-        io.format("not ok: %d != %d\n", [i(NumSpawn), i(NumExit)], !IO)
-    ).
+    wait(Channel, NumSpawn, !IO),
+    io.write_string("ok\n", !IO).
 
 :- pred loop(channel(unit)::in, int::in, io::di, io::uo) is cc_multi.
 
@@ -41,24 +38,27 @@
         true
     else
         thread.spawn((pred(!.IO::di, !:IO::uo) is cc_multi :-
-            foo(Channel, !IO)
+            channel.put(Channel, unit, !IO)
         ), !IO),
         loop(Channel, N-1, !IO)
     ).
 
-:- pred foo(channel(unit)::in, io::di, io::uo) is det.
+:- pred wait(channel(unit)::in, int::in, io::di, io::uo) is det.
 
-foo(Channel, !IO) :-
-    channel.put(Channel, unit, !IO).
+wait(Channel, Num, !IO) :-
+    (if Num = 0 then
+        true
+    else
+        channel.take(Channel, _Unit, !IO),
+        wait(Channel, Num - 1, !IO)
+    ).
 
-:- pred count(channel(unit)::in, int::in, int::out, io::di, io::uo) is det.
+:- pragma foreign_decl("C", "#include <unistd.h>").
+:- impure pred alarm(int::in) is det.
 
-count(Channel, Num0, Num, !IO) :-
-    channel.try_take(Channel, MaybeUnit, !IO),
-    (
-        MaybeUnit = yes(_),
-        count(Channel, Num0 + 1, Num, !IO)
-    ;
-        MaybeUnit = no,
-        Num = Num0
-    ).
+:- pragma foreign_proc("C",
+    alarm(Seconds::in),
+    [will_not_call_mercury],
+"
+    alarm(Seconds);
+").
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------