Detection of callback-spec discrepancies

5 files changed, 179 insertions, 22 deletions

diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl
index acbe574e2b..487a12b252 100644
--- a/lib/dialyzer/src/dialyzer.erl
+++ b/lib/dialyzer/src/dialyzer.erl
@@ -442,14 +442,18 @@ message_to_string({opaque_type_test, [Fun, Opaque]}) ->
 message_to_string({race_condition, [M, F, Args, Reason]}) ->
   io_lib:format("The call ~w:~w~s ~s\n", [M, F, Args, Reason]);
 %%----- Warnings for behaviour errors --------------------
-message_to_string({callback_type_mismatch, [B, F, A, O]}) ->
+message_to_string({callback_type_mismatch, [B, F, A, T]}) ->
   io_lib:format("The inferred return type for ~w/~w is ~s which is not valid"
 		" return for the callback of the ~w behaviour\n",
-		[F, A, erl_types:t_to_string(O), B]);
-message_to_string({callback_arg_type_mismatch, [B, F, A, N, O]}) ->
+		[F, A, T, B]);
+message_to_string({callback_arg_type_mismatch, [B, F, A, N, T]}) ->
   io_lib:format("The inferred type for the ~s argument of ~w/~w is ~s which is"
 		" not valid for the callback of the ~w behaviour"
-		"\n", [ordinal(N), F, A, erl_types:t_to_string(O), B]);
+		"\n", [ordinal(N), F, A, T, B]);
+message_to_string({callback_spec_type_mismatch, [B, F, A, ST, CT]}) ->
+  io_lib:format("The return type ~s in the specification of ~w/~w is not a"
+		" subtype of ~s, which is the expected return type for the"
+		" callback of ~w behaviour.\n", [ST, F, A, CT, B]);
 message_to_string({callback_missing, [B, F, A]}) ->
   io_lib:format("Undefined callback function ~w/~w (behaviour '~w')\n",
 		[F, A, B]);
diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl
index 82963783d8..a30707c7c3 100644
--- a/lib/dialyzer/src/dialyzer_behaviours.erl
+++ b/lib/dialyzer/src/dialyzer_behaviours.erl
@@ -88,20 +88,26 @@ get_warnings(Module, [Behaviour|Rest], State, Acc) ->
   NewAcc = check_behaviour(Module, Behaviour, State, Acc),
   get_warnings(Module, Rest, State, NewAcc).
 
-check_behaviour(Module, Behaviour, #state{plt = Plt}, Acc) ->
+check_behaviour(Module, Behaviour, #state{plt = Plt} = State, Acc) ->
   case dialyzer_plt:lookup_callbacks(Plt, Behaviour) of
     [] -> [{callback_info_missing, [Behaviour]}|Acc];
-    Callbacks -> check_all_callbacks(Module, Behaviour, Callbacks, Plt, Acc)
+    Callbacks -> check_all_callbacks(Module, Behaviour, Callbacks, State, Acc)
   end.
 
-check_all_callbacks(_Module, _Behaviour, [], _Plt, Acc) ->
+check_all_callbacks(_Module, _Behaviour, [], _State, Acc) ->
   Acc;
-check_all_callbacks(Module, Behaviour, [Cb|Rest], Plt, Acc) ->
+check_all_callbacks(Module, Behaviour, [Cb|Rest],
+		    #state{plt = Plt, codeserver = Codeserver} = State, Acc) ->
   {{Behaviour, Function, Arity},
    {{_BehFile, _BehLine}, Callback}} = Cb,
   CbMFA = {Module, Function, Arity},
   CbReturnType = dialyzer_contracts:get_contract_return(Callback),
   CbArgTypes = dialyzer_contracts:get_contract_args(Callback),
+  Records =
+    case dict:find(Module, dialyzer_codeserver:get_records(Codeserver)) of
+      {ok, V} -> V;
+      error -> dict:new()
+    end,
   Acc0 = Acc,
   Acc1 = 
     case dialyzer_plt:lookup(Plt, CbMFA) of
@@ -117,8 +123,9 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest], Plt, Acc) ->
 		     erl_types:t_inf(ReturnType, CbReturnType)) of
 		false -> Acc00;
 		true ->
-		  [{callback_type_mismatch,[Behaviour, Function,
-					    Arity, ReturnType]}|Acc00]
+		  [{callback_type_mismatch,
+		    [Behaviour, Function, Arity,
+		     erl_types:t_to_string(ReturnType, Records)]}|Acc00]
 	      end
 	  end,
 	Acc02 =
@@ -127,32 +134,44 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest], Plt, Acc) ->
 	    false -> Acc01;
 	    true ->
 	      find_mismatching_args(ArgTypes, CbArgTypes, Behaviour,
-				    Function, Arity, 1, Acc01)
+				    Function, Arity, Records, 1, Acc01)
 	  end,
 	Acc02
     end,
   Acc2 =
-    case dialyzer_plt:lookup_contract(Plt, CbMFA) of
-      'none' -> Acc1;
-      {value, _Contract} ->
-	%% TODO: Check spec for discrepancies
-	Acc1
+    case dialyzer_codeserver:lookup_mfa_contract(CbMFA, Codeserver) of
+      'error' -> Acc1;
+      {ok, {{File, Line}, Contract}} ->
+	Acc10 = Acc1,
+	SpecReturnType = dialyzer_contracts:get_contract_return(Contract),
+	SpecArgTypes = dialyzer_contracts:get_contract_args(Contract),
+	Acc11 =
+	  case erl_types:t_is_subtype(SpecReturnType, CbReturnType) of
+	    true -> Acc10;
+	    false -> [{callback_spec_type_mismatch,
+		       [File, Line, Behaviour, Function, Arity,
+			erl_types:t_to_string(SpecReturnType, Records),
+			erl_types:t_to_string(CbReturnType, Records)]}|Acc10]
+	  end,
+	Acc11
     end,
   NewAcc = Acc2,
-  check_all_callbacks(Module, Behaviour, Rest, Plt, NewAcc).
+  check_all_callbacks(Module, Behaviour, Rest, State, NewAcc).
 
-find_mismatching_args([], [], _Behaviour, _Function, _Arity, _N, Acc) ->
+find_mismatching_args([], [], _Beh, _Function, _Arity, _Records, _N, Acc) ->
   Acc;
 find_mismatching_args([Type|Rest], [CbType|CbRest], Behaviour,
-		      Function, Arity, N, Acc) ->
+		      Function, Arity, Records, N, Acc) ->
   case erl_types:t_is_none(erl_types:t_inf(Type, CbType)) of
     false ->
-      find_mismatching_args(Rest, CbRest, Behaviour, Function, Arity, N+1, Acc);
+      find_mismatching_args(Rest, CbRest, Behaviour, Function,
+			    Arity, Records, N+1, Acc);
     true ->
       NewAcc =
 	[{callback_arg_type_mismatch,
-	  [Behaviour, Function, Arity, N, Type]}|Acc],
-      find_mismatching_args(Rest, CbRest, Behaviour, Function, Arity, N+1, NewAcc)
+	  [Behaviour, Function, Arity, N, erl_types:t_to_string(Type, Records)]}|Acc],
+      find_mismatching_args(Rest, CbRest, Behaviour, Function,
+			    Arity, Records, N+1, NewAcc)
   end.
 
 add_tag_file_line(_Module, {Tag, [B|_R]} = Warn, State)
@@ -160,6 +179,9 @@ add_tag_file_line(_Module, {Tag, [B|_R]} = Warn, State)
        Tag =:= callback_info_missing ->
   {B, Line} = lists:keyfind(B, 1, State#state.behlines),
   {?WARN_BEHAVIOUR, {State#state.filename, Line}, Warn};
+add_tag_file_line(Module, {Tag, [File, Line|R]}, State)
+  when Tag =:= callback_spec_type_mismatch ->
+  {?WARN_BEHAVIOUR, {File, Line}, {Tag, R}};
 add_tag_file_line(Module, {_Tag, [_B, Fun, Arity|_R]} = Warn, State) ->
   {_A, FunCode} =
     dialyzer_codeserver:lookup_mfa_code({Module, Fun, Arity},
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/callbacks_and_specs/my_behaviour.erl b/lib/dialyzer/test/behaviour_SUITE_data/src/callbacks_and_specs/my_behaviour.erl
new file mode 100644
index 0000000000..c4e5203448
--- /dev/null
+++ b/lib/dialyzer/test/behaviour_SUITE_data/src/callbacks_and_specs/my_behaviour.erl
@@ -0,0 +1,11 @@
+-module(my_behaviour).
+
+-callback callback_init(Parent :: pid()) -> {'ok', State::term()}.
+
+-callback callback_cast(State::term(), From::pid(), Msg::term()) ->
+    {'noreply', NewState::term()}.
+
+-callback callback_call(State::term(), From::pid(), Msg::term()) ->
+    {'reply', NewState::term(), Reply::term()}.
+
+-callback callback_exit(State::term()) -> 'ok'.
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/callbacks_and_specs/my_callbacks_correct.erl b/lib/dialyzer/test/behaviour_SUITE_data/src/callbacks_and_specs/my_callbacks_correct.erl
new file mode 100644
index 0000000000..041b4ac56c
--- /dev/null
+++ b/lib/dialyzer/test/behaviour_SUITE_data/src/callbacks_and_specs/my_callbacks_correct.erl
@@ -0,0 +1,59 @@
+-module(my_callbacks_correct).
+
+-export([
+	 callback_init/1
+	 , callback_call/3
+	 , callback_cast/3
+	 , callback_exit/1
+	]).
+
+-record(state, {
+	  parent           :: pid(),
+	  status    = init :: 'init' | 'open' | 'closed',
+	  subscribe = []   :: list({pid(), integer()}),
+	  counter   = 1    :: integer()
+	 }).
+
+-type state()        :: #state{}.
+
+-type cast_message() :: 'open' | 'closed'.
+
+-type call_message() :: 'subscribe' | 'unsubscribe'.
+-type call_reply()   :: 'accepted' | 'rejected'.
+
+-spec callback_init(Parent::pid()) -> {'ok', state()}.
+
+callback_init(Parent) ->
+    {ok, #state{parent = Parent}}.
+
+-spec callback_cast(state(), pid(), cast_message()) -> {'noreply', state()}.
+
+callback_cast(#state{parent = Pid} = State, Pid, Message)
+  when Message =:= 'open'; Message =:= 'close' ->
+    {noreply, State#state{status = Message}};
+callback_cast(State, _Pid, _Message) ->
+    {noreply, State}.
+
+-spec callback_call(state(), pid(), call_message()) ->
+			   {'reply', state(), call_reply()}.
+
+callback_call(#state{status = open, subscribe = Subscribers} = State,
+	      Pid, Message)
+  when Message =:= 'subscribe';
+       Message =:= 'unsubscribe' ->
+    NewState =
+	case Message of
+	    subscribe ->
+		N = State#state.counter,
+		State#state{subscribe = [{Pid, N}|Subscribers], counter = N+1};
+	    unsubscribe ->
+		State#state{subscribe = lists:keydelete(Pid, 1, Subscribers)}
+	end,
+    {reply, NewState, accepted};
+callback_call(State, _Pid, _Message) ->
+    {reply, State, rejected}.
+
+-spec callback_exit(state()) -> 'ok'.
+
+callback_exit(_State) ->
+    ok.
diff --git a/lib/dialyzer/test/behaviour_SUITE_data/src/callbacks_and_specs/my_callbacks_wrong.erl b/lib/dialyzer/test/behaviour_SUITE_data/src/callbacks_and_specs/my_callbacks_wrong.erl
new file mode 100644
index 0000000000..0459622dc1
--- /dev/null
+++ b/lib/dialyzer/test/behaviour_SUITE_data/src/callbacks_and_specs/my_callbacks_wrong.erl
@@ -0,0 +1,61 @@
+-module(my_callbacks_wrong).
+
+-export([
+	 callback_init/1
+	 , callback_call/3
+	 , callback_cast/3
+	 , callback_exit/1
+	]).
+
+-behaviour(my_behaviour).
+
+-record(state, {
+	  parent           :: pid(),
+	  status    = init :: 'init' | 'open' | 'closed',
+	  subscribe = []   :: list({pid(), integer()}),
+	  counter   = 1    :: integer()
+	 }).
+
+-type state()        :: #state{}.
+
+-type cast_message() :: 'open' | 'closed'.
+
+-type call_message() :: 'subscribe' | 'unsubscribe'.
+-type call_reply()   :: 'accepted' | 'rejected'.
+
+-spec callback_init(Parent::pid()) -> state().    %% Wrong return spec
+
+callback_init(Parent) -> #state{parent = Parent}. %% Wrong return
+
+-spec callback_cast(state(), pid() | atom(), cast_message()) ->
+			   {'noreply' | 'reply', state()}. %% More generic spec
+
+callback_cast(#state{parent = Pid} = State, Pid, Message)
+  when Message =:= 'open'; Message =:= 'close' ->
+    {noreply, State#state{status = Message}};
+callback_cast(State, _Pid, _Message) ->
+    {noreply, State}.
+
+-spec callback_call(state(), atom(), call_message()) ->      %% Wrong arg spec
+			   {'reply', state(), call_reply()}.
+
+callback_call(#state{status = open, subscribe = Subscribers} = State,
+	      Pid, Message)
+  when Message =:= 'subscribe';
+       Message =:= 'unsubscribe' ->
+    NewState =
+	case Message of
+	    subscribe ->
+		N = State#state.counter,
+		State#state{subscribe = [{Pid, N}|Subscribers], counter = N+1};
+	    unsubscribe ->
+		State#state{subscribe = lists:keydelete(Pid, 1, Subscribers)}
+	end,
+    {reply, NewState, accepted};
+callback_call(State, _Pid, _Message) ->
+    {reply, State, rejected}.
+
+-spec callback_exit(state()) -> ok.
+
+callback_exit(_State) ->
+    ok.