Introduce the attribute -optional_callbacks in the context of behaviours

lib/compiler/src/sys_pre_expand.erl

@@ -1,7 +1,7 @@
 %%
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 1996-2012. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2014. All Rights Reserved.
 %%
 %% The contents of this file are subject to the Erlang Public License,
 %% Version 1.1, (the "License"); you may not use this file except in
@@ -33,12 +33,15 @@
 
 -include("../include/erl_bits.hrl").
 
+-type fa() :: {atom(), arity()}.
+
 -record(expand, {module=[],                     %Module name
                  exports=[],                    %Exports
                  imports=[],                    %Imports
                  compile=[],                    %Compile flags
                  attributes=[],                 %Attributes
                  callbacks=[],                  %Callbacks
+                 optional_callbacks=[] :: [fa()],  %Optional callbacks
                  defined,			%Defined functions (gb_set)
                  vcount=0,                      %Variable counter
                  func=[],                       %Current function
@@ -99,7 +102,21 @@ define_functions(Forms, #expand{defined=Predef}=St) ->
 module_attrs(#expand{attributes=Attributes}=St) ->
     Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes],
     Callbacks = [Callback || {_,_,callback,_}=Callback <- Attrs],
-    {Attrs,St#expand{callbacks=Callbacks}}.
+    OptionalCallbacks = get_optional_callbacks(Attrs),
+    {Attrs,St#expand{callbacks=Callbacks,
+                     optional_callbacks=OptionalCallbacks}}.
+
+get_optional_callbacks(Attrs) ->
+    L = [O ||
+            {attribute, _, optional_callbacks, O} <- Attrs,
+            is_fa_list(O)],
+    lists:append(L).
+
+is_fa_list([{FuncName, Arity}|L])
+  when is_atom(FuncName), is_integer(Arity), Arity >= 0 ->
+    is_fa_list(L);
+is_fa_list([]) -> true;
+is_fa_list(_) -> false.
 
 module_predef_funcs(St) ->
     {Mpf1,St1}=module_predef_func_beh_info(St),
@@ -108,19 +125,24 @@ module_predef_funcs(St) ->
 
 module_predef_func_beh_info(#expand{callbacks=[]}=St) ->
     {[], St};
-module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined,
+module_predef_func_beh_info(#expand{callbacks=Callbacks,
+                                    optional_callbacks=OptionalCallbacks,
+                                    defined=Defined,
 				    exports=Exports}=St) ->
     PreDef=[{behaviour_info,1}],
     PreExp=PreDef,
-    {[gen_beh_info(Callbacks)],
+    {[gen_beh_info(Callbacks, OptionalCallbacks)],
      St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined),
 	       exports=union(from_list(PreExp), Exports)}}.
 
-gen_beh_info(Callbacks) ->
+gen_beh_info(Callbacks, OptionalCallbacks) ->
     List = make_list(Callbacks),
+    OptionalList = make_optional_list(OptionalCallbacks),
     {function,0,behaviour_info,1,
      [{clause,0,[{atom,0,callbacks}],[],
-       [List]}]}.
+       [List]},
+      {clause,0,[{atom,0,optional_callbacks}],[],
+       [OptionalList]}]}.
 
 make_list([]) -> {nil,0};
 make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) ->
@@ -130,6 +152,14 @@ make_list([{_,_,_,[{{Name,Arity},_}]}|Rest]) ->
        {integer,0,Arity}]},
      make_list(Rest)}.
 
+make_optional_list([]) -> {nil,0};
+make_optional_list([{Name,Arity}|Rest]) ->
+    {cons,0,
+     {tuple,0,
+      [{atom,0,Name},
+       {integer,0,Arity}]},
+     make_optional_list(Rest)}.
+
 module_predef_funcs_mod_info(St) ->
     PreDef = [{module_info,0},{module_info,1}],
     PreExp = PreDef,

lib/dialyzer/src/dialyzer_behaviours.erl

@@ -102,14 +102,18 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest],
 		    #state{plt = Plt, codeserver = Codeserver,
 			   records = Records} = State, Acc) ->
   {{Behaviour, Function, Arity},
-   {{_BehFile, _BehLine}, Callback}} = Cb,
+   {{_BehFile, _BehLine}, Callback, Xtra}} = Cb,
   CbMFA = {Module, Function, Arity},
   CbReturnType = dialyzer_contracts:get_contract_return(Callback),
   CbArgTypes = dialyzer_contracts:get_contract_args(Callback),
   Acc0 = Acc,
   Acc1 = 
     case dialyzer_plt:lookup(Plt, CbMFA) of
-      'none' -> [{callback_missing, [Behaviour, Function, Arity]}|Acc0];
+      'none' ->
+        case lists:member(optional_callback, Xtra) of
+          true -> Acc0;
+          false -> [{callback_missing, [Behaviour, Function, Arity]}|Acc0]
+        end;
       {'value', RetArgTypes} ->
 	Acc00 = Acc0,
 	{ReturnType, ArgTypes} = RetArgTypes,
@@ -137,7 +141,7 @@ check_all_callbacks(Module, Behaviour, [Cb|Rest],
   Acc2 =
     case dialyzer_codeserver:lookup_mfa_contract(CbMFA, Codeserver) of
       'error' -> Acc1;
-      {ok, {{File, Line}, Contract}} ->
+      {ok, {{File, Line}, Contract, _Xtra}} ->
 	Acc10 = Acc1,
 	SpecReturnType0 = dialyzer_contracts:get_contract_return(Contract),
 	SpecArgTypes0 = dialyzer_contracts:get_contract_args(Contract),

lib/dialyzer/src/dialyzer_codeserver.erl

@@ -278,10 +278,10 @@ lookup_mod_contracts(Mod, #codeserver{contracts = ContDict})
   case ets_dict_find(Mod, ContDict) of
     error -> dict:new();
     {ok, Keys} ->
-      dict:from_list([get_contract_pair(Key, ContDict)|| Key <- Keys])
+      dict:from_list([get_file_contract(Key, ContDict)|| Key <- Keys])
   end.
 
-get_contract_pair(Key, ContDict) ->
+get_file_contract(Key, ContDict) ->
   {Key, ets:lookup_element(ContDict, Key, 2)}.
 
 -spec lookup_mfa_contract(mfa(), codeserver()) ->

lib/dialyzer/src/dialyzer_contracts.erl

@@ -45,7 +45,7 @@
 %% Types used in other parts of the system below
 %%-----------------------------------------------------------------------
 
--type file_contract() :: {file_line(), #contract{}}.
+-type file_contract() :: {file_line(), #contract{}, Extra :: [_]}.
 
 -type plt_contracts() :: [{mfa(), #contract{}}]. % actually, an orddict()
 
@@ -148,10 +148,10 @@ process_contract_remote_types(CodeServer) ->
   ExpTypes = dialyzer_codeserver:get_exported_types(CodeServer),
   RecordDict = dialyzer_codeserver:get_records(CodeServer),
   ContractFun =
-    fun({_M, _F, _A}, {File, #tmp_contract{contract_funs = CFuns, forms = Forms}}) ->
+    fun({_M, _F, _A}, {File, #tmp_contract{contract_funs = CFuns, forms = Forms}, Xtra}) ->
 	NewCs = [CFun(ExpTypes, RecordDict) || CFun <- CFuns],
 	Args = general_domain(NewCs),
-	{File, #contract{contracts = NewCs, args = Args, forms = Forms}}
+	{File, #contract{contracts = NewCs, args = Args, forms = Forms}, Xtra}
     end,
   ModuleFun =
     fun(_ModuleName, ContractDict) ->
@@ -177,7 +177,7 @@ check_contracts(Contracts, Callgraph, FunTypes, FindOpaques) ->
 	case dialyzer_callgraph:lookup_name(Label, Callgraph) of
 	  {ok, {M,F,A} = MFA} ->
 	    case orddict:find(MFA, Contracts) of
-	      {ok, {_FileLine, Contract}} ->
+	      {ok, {_FileLine, Contract, _Xtra}} ->
                 Opaques = FindOpaques(M),
 		case check_contract(Contract, Type, Opaques) of
 		  ok ->
@@ -364,7 +364,7 @@ contracts_without_fun(Contracts, AllFuns0, Callgraph) ->
   [warn_spec_missing_fun(MFA, Contracts) || MFA <- ErrorContractMFAs].
 
 warn_spec_missing_fun({M, F, A} = MFA, Contracts) ->
-  {FileLine, _Contract} = dict:fetch(MFA, Contracts),
+  {FileLine, _Contract, _Xtra} = dict:fetch(MFA, Contracts),
   {?WARN_CONTRACT_SYNTAX, FileLine, {spec_missing_fun, [M, F, A]}}.
 
 %% This treats the "when" constraints. It will be extended, we hope.
@@ -388,14 +388,16 @@ insert_constraints([], Dict) -> Dict.
 
 -type types() :: erl_types:type_table().
 
--spec store_tmp_contract(mfa(), file_line(), [_], contracts(), types()) ->
+-type spec_data() :: {TypeSpec :: [_], Xtra:: [_]}.
+
+-spec store_tmp_contract(mfa(), file_line(), spec_data(), contracts(), types()) ->
         contracts().
 
-store_tmp_contract(MFA, FileLine, TypeSpec, SpecDict, RecordsDict) ->
+store_tmp_contract(MFA, FileLine, {TypeSpec, Xtra}, SpecDict, RecordsDict) ->
   %% io:format("contract from form: ~p\n", [TypeSpec]),
   TmpContract = contract_from_form(TypeSpec, RecordsDict, FileLine),
   %% io:format("contract: ~p\n", [TmpContract]),
-  dict:store(MFA, {FileLine, TmpContract}, SpecDict).
+  dict:store(MFA, {FileLine, TmpContract, Xtra}, SpecDict).
 
 contract_from_form(Forms, RecDict, FileLine) ->
   {CFuns, Forms1} = contract_from_form(Forms, RecDict, FileLine, [], []),
@@ -599,7 +601,7 @@ get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, FindOpaques,
 get_invalid_contract_warnings_modules([], _CodeServer, _Plt, _FindOpaques, Acc) ->
   Acc.
 
-get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract}}|Left],
+get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left],
 				   Plt, RecDict, FindOpaques, Acc) ->
   case dialyzer_plt:lookup(Plt, MFA) of
     none ->

lib/dialyzer/src/dialyzer_plt.erl

@@ -158,9 +158,7 @@ lookup_contract(#mini_plt{contracts = ETSContracts},
   ets_table_lookup(ETSContracts, MFA).
 
 -spec lookup_callbacks(plt(), module()) ->
-	 'none' | {'value', [{mfa(), {{Filename::string(),
-				       Line::pos_integer()},
-				      #contract{}}}]}.
+	 'none' | {'value', [{mfa(), dialyzer_contracts:file_contract()}]}.
 
 lookup_callbacks(#mini_plt{callbacks = ETSCallbacks}, Mod) when is_atom(Mod) ->
   ets_table_lookup(ETSCallbacks, Mod).
@@ -618,9 +616,7 @@ table_insert_list(Plt, [{Key, Val}|Left]) ->
 table_insert_list(Plt, []) ->
   Plt.
 
-table_insert(Plt, Key, {_Ret, _Arg} = Obj) ->
-  dict:store(Key, Obj, Plt);
-table_insert(Plt, Key, #contract{} = C) ->
+table_insert(Plt, Key, {_File, #contract{}, _Xtra} = C) ->
   dict:store(Key, C, Plt).
 
 table_lookup(Plt, Obj) ->

lib/dialyzer/src/dialyzer_succ_typings.erl

@@ -201,7 +201,7 @@ postprocess_dataflow_warns([{?WARN_CONTRACT_RANGE, {CallF, CallL}, Msg}|Rest],
 			   Codeserver, WAcc, Acc) ->
   {contract_range, [Contract, M, F, A, ArgStrings, CRet]} = Msg,
   case dialyzer_codeserver:lookup_mfa_contract({M,F,A}, Codeserver) of
-    {ok, {{ContrF, _ContrL} = FileLine, _C}} ->
+    {ok, {{ContrF, _ContrL} = FileLine, _C, _X}} ->
       case CallF =:= ContrF of
 	true ->
 	  NewMsg = {contract_range, [Contract, M, F, ArgStrings, CallL, CRet]},
@@ -401,7 +401,7 @@ decorate_succ_typings(Contracts, Callgraph, FunTypes, FindOpaques) ->
           case dialyzer_callgraph:lookup_name(Label, Callgraph) of
             {ok, MFA} ->
               case orddict:find(MFA, Contracts) of
-                {ok, {_FileLine, Contract}} ->
+                {ok, {_FileLine, Contract, _Xtra}} ->
                   Args = dialyzer_contracts:get_contract_args(Contract),
                   Ret = dialyzer_contracts:get_contract_return(Contract),
                   C = erl_types:t_fun(Args, Ret),

lib/dialyzer/src/dialyzer_utils.erl

@@ -322,8 +322,26 @@ merge_records(NewRecords, OldRecords) ->
         {'ok', spec_dict(), callback_dict()} | {'error', string()}.
 
 get_spec_info(ModName, AbstractCode, RecordsDict) ->
+  OptionalCallbacks0 = get_optional_callbacks(AbstractCode, ModName),
+  OptionalCallbacks = gb_sets:from_list(OptionalCallbacks0),
   get_spec_info(AbstractCode, dict:new(), dict:new(),
-		RecordsDict, ModName, "nofile").
+		RecordsDict, ModName, OptionalCallbacks, "nofile").
+
+get_optional_callbacks(Abs, ModName) ->
+  [{ModName, F, A} || {F, A} <- get_optional_callbacks(Abs)].
+
+get_optional_callbacks(Abs) ->
+    L = [O ||
+            {attribute, _, optional_callbacks, O} <- Abs,
+            is_fa_list(O)],
+    lists:append(L).
+
+is_fa_list([{FuncName, Arity}|L])
+  when is_atom(FuncName), is_integer(Arity), Arity >= 0 ->
+    is_fa_list(L);
+is_fa_list([]) -> true;
+is_fa_list(_) -> false.
+
 
 %% TypeSpec is a list of conditional contracts for a function.
 %% Each contract is of the form {[Argument], Range, [Constraint]} where
@@ -332,31 +350,33 @@ get_spec_info(ModName, AbstractCode, RecordsDict) ->
 %%    are erl_types:erl_type()
 
 get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left],
-	      SpecDict, CallbackDict, RecordsDict, ModName, File)
+	      SpecDict, CallbackDict, RecordsDict, ModName, OptCb, File)
   when ((Contract =:= 'spec') or (Contract =:= 'callback')),
        is_list(TypeSpec) ->
   MFA = case Id of
 	  {_, _, _} = T -> T;
 	  {F, A} -> {ModName, F, A}
 	end,
+  Xtra = [optional_callback || gb_sets:is_member(MFA, OptCb)],
   ActiveDict =
     case Contract of
       spec     -> SpecDict;
       callback -> CallbackDict
     end,
   try dict:find(MFA, ActiveDict) of
     error ->
+      SpecData = {TypeSpec, Xtra},
       NewActiveDict =
-	dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, TypeSpec,
+	dialyzer_contracts:store_tmp_contract(MFA, {File, Ln}, SpecData,
 					      ActiveDict, RecordsDict),
       {NewSpecDict, NewCallbackDict} =
 	case Contract of
 	  spec     -> {NewActiveDict, CallbackDict};
 	  callback -> {SpecDict, NewActiveDict}
 	end,
       get_spec_info(Left, NewSpecDict, NewCallbackDict,
-		    RecordsDict, ModName,File);
-    {ok, {{OtherFile, L},_C}} ->
+		    RecordsDict, ModName, OptCb, File);
+    {ok, {{OtherFile, L}, _D}} ->
       {Mod, Fun, Arity} = MFA,
       Msg = flat_format("  Contract/callback for function ~w:~w/~w "
 			"already defined in ~s:~w\n",
@@ -368,13 +388,15 @@ get_spec_info([{attribute, Ln, Contract, {Id, TypeSpec}}|Left],
 			  [Ln, Error])}
   end;
 get_spec_info([{attribute, _, file, {IncludeFile, _}}|Left],
-	      SpecDict, CallbackDict, RecordsDict, ModName, _File) ->
+	      SpecDict, CallbackDict, RecordsDict, ModName, OptCb, _File) ->
   get_spec_info(Left, SpecDict, CallbackDict,
-		RecordsDict, ModName, IncludeFile);
+		RecordsDict, ModName, OptCb, IncludeFile);
 get_spec_info([_Other|Left], SpecDict, CallbackDict,
-	      RecordsDict, ModName, File) ->
-  get_spec_info(Left, SpecDict, CallbackDict, RecordsDict, ModName, File);
-get_spec_info([], SpecDict, CallbackDict, _RecordsDict, _ModName, _File) ->
+	      RecordsDict, ModName, OptCb, File) ->
+  get_spec_info(Left, SpecDict, CallbackDict,
+                RecordsDict, ModName, OptCb, File);
+get_spec_info([], SpecDict, CallbackDict,
+              _RecordsDict, _ModName, _OptCb, _File) ->
   {ok, SpecDict, CallbackDict}.
 
 %% ============================================================================

lib/dialyzer/test/small_SUITE_data/results/behaviour_info

@@ -0,0 +1,2 @@
+
+with_bad_format_status.erl:12: The inferred type for the 1st argument of format_status/2 ('bad_arg') is not a supertype of 'normal' | 'terminate', which is expected type for this argument in the callback of the gen_server behaviour

lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_bad_format_status.erl

@@ -0,0 +1,12 @@
+-module(with_bad_format_status).
+
+-behaviour(gen_server).
+-export([handle_call/3,handle_cast/2,handle_info/2,
+         code_change/3, init/1, terminate/2, format_status/2]).
+handle_call(_, _, S) -> {noreply, S}.
+handle_cast(_, S) -> {noreply, S}.
+handle_info(_, S) -> {noreply, S}.
+code_change(_, _, _) -> {error, not_implemented}.
+init(_) -> {ok, state}.
+terminate(_, _) -> ok.
+format_status(bad_arg, _) -> ok. % optional callback

lib/dialyzer/test/small_SUITE_data/src/behaviour_info/with_format_status.erl

@@ -0,0 +1,13 @@
+-module(with_format_status).
+
+-behaviour(gen_server).
+-export([handle_call/3,handle_cast/2,handle_info/2,
+         code_change/3, init/1, terminate/2, format_status/2]).
+-export([handle_call/3,handle_cast/2,handle_info/2]).
+handle_call(_, _, S) -> {noreply, S}.
+handle_cast(_, S) -> {noreply, S}.
+handle_info(_, S) -> {noreply, S}.
+code_change(_, _, _) -> {error, not_implemented}.
+init(_) -> {ok, state}.
+terminate(_, _) -> ok.
+format_status(normal, _) -> ok. % optional callback