error trapping - Check does not interrupt evaluation of the expression when a Message is emitted

On the surface, Check looks like a good method to use when you need to abort the evaluation of an expression whenever a Message is emitted. Unfortunately, as the following code demonstrates, the evaluation of the expression is completed after a Message has occurred.

(* the test message *)
Test::wrpt = "Negative point at `1`";

dat = RandomReal[1, 500];

(* without Check *)
woCheck = MapIndexed[
   If[# < 0, 
     Message[Test::wrpt, #2[[1]]]; Unevaluated[Sequence[]], 

     #] &,
   {-1}~Join~dat];

(* with Check *)
res = {};
Check[
 MapIndexed[
  If[# < 0, 
    Message[Test::wrpt, #2[[1]]]; Unevaluated[Sequence[]], 
    res = {res, #}; #] &,

  {-1}~Join~dat],
 $Failed
 ]
 (* Test::wrpt: Negative point at 1
  $Failed
 *)

But, when comparing the two

woCheck == Flatten@res
(* True *)

This implies, that for long running computations Check is not a good solution to abort a computation if an error Message is emitted. Can this be fixed?

Answer

A simple method for accomplishing this is to have Message Throw an error when it is called, interrupting the current execution. Here is a replacement for Check which does that, with the same calling signature:

ClearAll[InterruptingCheck]
SetAttributes[InterruptingCheck, HoldAll]

InterruptingCheck[expr_, failexpr_, msgs : {___MessageName } : {}] :=
 Internal`InheritedBlock[{Message, $msgFlag},
      (* Module localizes tag while not polluting the global namespace *)

      Module[{ tag },
      Unprotect[Message];
      (* 
      Attach hook to message, where failexpr is thrown after the 
      first Message is raised. msgFlag is used to prevent recursion,
      so that when msg is called the original def is used.
      *)
      msg : Message[m_, ___] /; ! TrueQ[$msgFlag] := Block[{$msgFlag = True},
     msg;
     If[Length@msgs == 0 || MemberQ[msgs, m], Throw[failexpr, tag]]];

     Catch[expr, tag]
  ]
 ]

(* With Leonid's suggestion, this now works correctly. *)
InterruptingCheck[expr_, failexpr_, msgGroup_String] := 
 Hold[msgGroup] /. $MessageGroups /. 
  Hold[messages_List] :> InterruptingCheck[expr, failexpr, messages]

\begin{Edit}

My original code for the supplying a message group failed to work correctly. The fix is shown above. It works by replacing msgGroup with the appropriate list of messages, but using Hold to prevent them from being replaced by their string equivalents. (That is part of the reason for the HoldAll attribute being used here, to begin with.) Then, the held messages are extracted from Hold and inserted into InterruptingCheck still held because of HoldAll.

\end{Edit}

When applied to the example in the question,

res2 = {};
InterruptingCheck[
 MapIndexed[
  If[# < 0, 
    Message[Test::wrpt, #2[[1]]]; Unevaluated[Sequence[]], 
    res2 = {res2, #}; #] &,
  dat[[;; 10]]~Join~{-1}~Join~dat],

 $Failed,
     {Test::wrpt}
     ]
     (* Test::wrpt: Negative point at 11
     $Failed
 *)

and res2 is

{0.288047, 0.026642, 0.361008, 0.28977, 0.573743, 
0.272747, 0.937062, 0.330572, 0.192807, 0.916764}

showing that it did stop execution at after the tenth element in the data.