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.