Permalink
Browse files

Implement -T|--ignore-timeout flag

Use this flag to treat large 'receive ... after' timeouts
as infinity rather than transform all of them to zero.
  • Loading branch information...
1 parent 0ffc2d8 commit b5750fa2c6a042ac7d5e49d4d0db314d036fbf7e @iliastsi iliastsi committed Mar 26, 2013
Showing with 51 additions and 22 deletions.
  1. +16 −0 src/concuerror.erl
  2. +8 −3 src/concuerror_instr.erl
  3. +24 −18 src/concuerror_rep.erl
  4. +3 −1 utest/concuerror_instr_tests.erl
View
@@ -58,6 +58,7 @@
| {'show_output'}
| {'fail_uninstrumented'}
| {'wait_messages'}
+ | {'ignore_timeout', pos_integer()}
| {'ignore', [module()]}
| {'help'}.
@@ -361,6 +362,19 @@ parse([{Opt, Param} | Args], Options) ->
_Ohter -> wrongArgument('number', Opt)
end;
+ T when T =:= "T"; T =:= "-ignore-timeout" ->
+ case Param of
+ [Timeout] ->
+ case string:to_integer(Timeout) of
+ {Timeout_Int, []} when Timeout_Int > 0 ->
+ NewOptions = lists:keystore('ignore_timeout',
+ 1, Options, {'ignore_timeout', Timeout_Int}),
+ parse(Args, NewOptions);
+ _Other -> wrongArgument('type', Opt)
+ end;
+ _Other -> wrongArgument('number', Opt)
+ end;
+
"-help" ->
help(),
erlang:halt();
@@ -447,6 +461,8 @@ help() ->
" --ignore modules Don't rename this modules\n"
" --show-output Allow program under test to print to stdout\n"
" --wait-messages Wait for uninstrumented messages to arrive\n"
+ " -T|--ignore-timeout bound\n"
+ " Treat big after Timeouts as infinity timeouts\n"
" --gui Run concuerror with graphics\n"
" --dpor Runs the experimental optimal DPOR version\n"
" --dpor_flanagan Runs an experimental reference DPOR version\n"
View
@@ -561,9 +561,14 @@ instrument_receive(Tree) ->
true -> erl_syntax:atom(infinity);
false -> Timeout
end,
- RepReceive =
- erl_syntax:application(Module, Function,
- [FunExpr, HasTimeoutExpr]),
+ IgnoreTimeout =
+ case ets:lookup(?NT_OPTIONS, 'ignore_timeout') of
+ [{'ignore_timeout', ITValue}] ->
+ erl_syntax:integer(ITValue);
+ _ -> erl_syntax:atom(infinity)
+ end,
+ RepReceive = erl_syntax:application(
+ Module, Function, [FunExpr, HasTimeoutExpr, IgnoreTimeout]),
%% Create new receive expression.
NewReceive = erl_syntax:receive_expr(NewClauses),
%% Result is begin rep_receive(...), NewReceive end.
View
@@ -27,7 +27,7 @@
rep_spawn_monitor/1, rep_spawn_monitor/3,
rep_process_flag/2]).
--export([rep_receive/2, rep_receive_block/0,
+-export([rep_receive/3, rep_receive_block/0,
rep_after_notify/0, rep_receive_notify/3,
rep_receive_notify/1]).
@@ -263,25 +263,25 @@ find_my_links() ->
AllLids = [?LID_FROM_PID(Pid) || Pid <- AllPids],
[KnownLid || KnownLid <- AllLids, KnownLid =/= not_found].
-%% @spec rep_receive(fun((term()) -> 'block' | 'continue'),
-%% integer() | 'infinity') -> 'ok'.
+%% @spec rep_receive(
+%% fun((term()) -> 'block' | 'continue'),
+%% integer() | 'infinity',
+%% integer() | 'infinity') -> 'ok'.
%% @doc: Function called right before a receive statement.
%%
%% If a matching message is found in the process' message queue, continue
%% to actual receive statement, else block and when unblocked do the same.
--spec rep_receive(fun((term()) -> 'block' | 'continue'),
- integer() | 'infinity') -> 'ok'.
-rep_receive(Fun, HasTimeout) ->
+-spec rep_receive(
+ fun((term()) -> 'block' | 'continue'),
+ integer() | 'infinity',
+ integer() | 'infinity') -> 'ok'.
+rep_receive(Fun, HasTimeout, IgnoreTimeout) ->
check_unknown_process(),
- case ?LID_FROM_PID(self()) of
- not_found ->
- %% XXX: Uninstrumented process enters instrumented receive
- ok;
- _Lid ->
- rep_receive_loop(poll, Fun, HasTimeout)
- end.
+ rep_receive_loop(poll, Fun, HasTimeout, IgnoreTimeout).
+
+-define(IGNORE_TIMEOUT(T, B), B =/= 'infinity' andalso T >= B).
-rep_receive_loop(Act, Fun, HasTimeout) ->
+rep_receive_loop(Act, Fun, HasTimeout, Bound) ->
case Act of
Resume when Resume =:= ok;
Resume =:= continue -> ok;
@@ -291,7 +291,10 @@ rep_receive_loop(Act, Fun, HasTimeout) ->
block ->
NewAct =
case HasTimeout of
- infinity -> concuerror_sched:notify('receive', blocked);
+ infinity ->
+ concuerror_sched:notify('receive', blocked);
+ Timeout when ?IGNORE_TIMEOUT(Timeout, Bound) ->
+ concuerror_sched:notify('receive', blocked);
_ ->
NewFun =
fun(Msg) ->
@@ -303,11 +306,14 @@ rep_receive_loop(Act, Fun, HasTimeout) ->
Links = find_trappable_links(self()),
concuerror_sched:notify('after', {NewFun, Links})
end,
- rep_receive_loop(NewAct, Fun, HasTimeout);
+ rep_receive_loop(NewAct, Fun, HasTimeout, Bound);
continue ->
Tag =
case HasTimeout of
- infinity -> unblocked;
+ infinity ->
+ unblocked;
+ Timeout when ?IGNORE_TIMEOUT(Timeout, Bound) ->
+ unblocked;
_ -> had_after
end,
continue = concuerror_sched:notify('receive', Tag),
@@ -334,7 +340,7 @@ rep_receive_match(Fun, [H|T]) ->
-spec rep_receive_block() -> no_return().
rep_receive_block() ->
Fun = fun(_Message) -> block end,
- rep_receive(Fun, infinity).
+ rep_receive(Fun, infinity, infinity).
%% @spec rep_after_notify() -> 'ok'
%% @doc: Auxiliary function used in the `receive..after' statement
@@ -29,10 +29,12 @@ syntax_test_() ->
Setup =
fun() ->
_ = concuerror_log:start(),
- _ = concuerror_log:attach(concuerror_log, [])
+ _ = concuerror_log:attach(concuerror_log, []),
+ ?NT_OPTIONS = ets:new(?NT_OPTIONS, [named_table, public, set])
end,
Cleanup =
fun(_Any) ->
+ ets:delete(?NT_OPTIONS),
concuerror_log:stop()
end,
Test01 = {"Block expression in after clause",

0 comments on commit b5750fa

Please sign in to comment.