[m-rev.] for review: avoid a potential deadlock with io.update_globals/3

[Julien Fischer]

Estimated hours taken: 3
Branches: main

Avoid a potential deadlock with the recently added library predicate
io.update_globals/3.

library/io.m:
 	If the closure passed to io.update_globals/3 throws an exception then
 	we need to release the lock associated with the globals before
 	propagating the exception upwards.  Failing to do so means that the
 	any subsequent call to io.{set,get,update}_globals will block
 	indefinitely.

tests/hard_coded/Mmakefile:
tests/hard_coded/io_globals_deadlock.{m,exp}:
 	Test case for the above.

Julien.

Index: library/io.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.353
diff -u -r1.353 io.m
--- library/io.m	22 Aug 2006 02:33:40 -0000	1.353
+++ library/io.m	30 Aug 2006 08:31:33 -0000
@@ -1105,6 +1105,8 @@
      %   io.set_globals(Globals, !IO)
      %
      % In parallel grades calls to io.update_globals/3 are atomic.
+    % If `UpdatePred' throws an exception then the `globals' field is
+    % left unchanged.
      %
  :- pred io.update_globals(pred(univ, univ)::in(pred(di, uo) is det),
      io::di, io::uo) is det.
@@ -4588,12 +4590,29 @@
      io.unsafe_set_globals(Globals, !IO),
      io.unlock_globals(!IO).

+:- pragma promise_pure(io.update_globals/3).
+
  io.update_globals(UpdatePred, !IO) :-
      io.lock_globals(!IO),
      io.unsafe_get_globals(Globals0, !IO),
-    UpdatePred(Globals0, Globals),
-    io.unsafe_set_globals(Globals, !IO),
-    io.unlock_globals(!IO).
+    promise_equivalent_solutions [!:IO] (
+        Update = (pred(G::out) is det :-
+            UpdatePred(unsafe_promise_unique(Globals0), G)
+        ),
+        try(Update, UpdateResult),
+        (
+            UpdateResult = succeeded(Globals1),
+            Globals = unsafe_promise_unique(Globals1),
+            io.unsafe_set_globals(Globals, !IO),
+            io.unlock_globals(!IO)
+        ;
+            % If the update operation threw an exception
+            % then release the lock and rethrow the exception.
+            UpdateResult = exception(_),
+            impure io.unlock_globals,
+            rethrow(UpdateResult)
+        )
+    ).

  :- pred io.lock_globals(io::di, io::uo) is det.
  :- pragma foreign_proc("C",
@@ -4627,6 +4646,20 @@
      %
  unlock_globals(!IO).

+:- impure pred io.unlock_globals is det.
+:- pragma foreign_proc("C", 
+    io.unlock_globals,
+    [will_not_call_mercury, thread_safe],
+"
+    #ifdef MR_THREAD_SAFE
+        MR_UNLOCK(&ML_io_user_globals_lock, \"io.unlock_globals/2\");
+    #endif
+"). 
+    % For the non-C backends.
+    %
+io.unlock_globals :-
+    impure impure_true.
+
      % NOTE: io.unsafe_{get, set}_globals/3 are marked as `thread_safe' so that
      % calling them to does not acquire the global lock.  Since calls to these
      % predicates should be surrounded by calls to io.{lock, unlock}_globals/2
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.293
diff -u -r1.293 Mmakefile
--- tests/hard_coded/Mmakefile	28 Aug 2006 10:13:22 -0000	1.293
+++ tests/hard_coded/Mmakefile	30 Aug 2006 08:19:22 -0000
@@ -118,6 +118,7 @@
  	intermod_type_qual \
  	intermod_unused_args \
  	int_fold_up_down \
+	io_globals_deadlock \
  	join_list \
  	list_series_int \
  	loop_inv_test \
Index: tests/hard_coded/io_globals_deadlock.exp
===================================================================
RCS file: tests/hard_coded/io_globals_deadlock.exp
diff -N tests/hard_coded/io_globals_deadlock.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/io_globals_deadlock.exp	30 Aug 2006 08:21:43 -0000
@@ -0,0 +1,2 @@
+update_pred_1 threw exception.
+Final value of Globals = 3
Index: tests/hard_coded/io_globals_deadlock.m
===================================================================
RCS file: tests/hard_coded/io_globals_deadlock.m
diff -N tests/hard_coded/io_globals_deadlock.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/io_globals_deadlock.m	30 Aug 2006 08:20:54 -0000
@@ -0,0 +1,60 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%-----------------------------------------------------------------------------%
+% 
+% Test that io.update_globals/3 does not cause a deadlock in .par grades
+% if the update closure throws an exception.  The initial version of
+% io.update_globals/3 did *not* do this.
+%
+%-----------------------------------------------------------------------------%
+
+:- module io_globals_deadlock.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is cc_multi.
+
+:- implementation.
+
+:- import_module exception.
+:- import_module list.
+:- import_module string.
+:- import_module unit.
+:- import_module univ.
+
+main(!IO) :-
+    io.set_globals(univ(3), !IO),
+    try_io(update_pred_1, Result, !IO),
+    (
+        Result = succeeded(unit),
+        io.write_string("update_pred_1 succeeded.\n", !IO)
+    ;
+        Result = exception(_),
+        io.write_string("update_pred_1 threw exception.\n", !IO)
+    ),
+    % 
+    % The following call to io.get_globals/3 will block if io.update_globals/3
+    % fails to reset the lock after throwing an exception.
+    %
+    io.get_globals(Globals, !IO),
+    det_univ_to_type(Globals, FinalValue),
+    io.format("Final value of Globals = %d\n", [i(FinalValue)], !IO).
+
+:- pred update_pred_1(unit::out, io::di, io::uo) is det.
+ 
+update_pred_1(unit, !IO) :-
+    io.update_globals(update_1, !IO).
+
+:- pred update_1(univ::di, univ::uo) is det.
+
+update_1(!Univ) :-
+    ( univ_to_type(!.Univ, N) ->
+        ( N = 3 ->
+            throw("N = 3")
+        ;
+            !:Univ = univ(561)
+        )
+    ;
+        throw("cannot convert univ to integer")
+    ).

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