Merge branch 'maint'

* maint:
  dialyzer: Substitute 'opacity' for 'opaqueness'
  dialyzer: Improve a warning message
  dialyzer: Improve a warning message
  dialyzer: Correct a warnings message

5 files changed, 84 insertions, 32 deletions

diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl
index 7f86520c06..d25ffd02a2 100644
--- a/lib/dialyzer/src/dialyzer.erl
+++ b/lib/dialyzer/src/dialyzer.erl
@@ -2,7 +2,7 @@
 %%-----------------------------------------------------------------------
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2006-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -407,6 +407,10 @@ message_to_string({contract_range, [Contract, M, F, ArgStrings, Line, CRet]}) ->
 message_to_string({invalid_contract, [M, F, A, Sig]}) ->
   io_lib:format("Invalid type specification for function ~w:~w/~w."
 		" The success typing is ~s\n", [M, F, A, Sig]);
+message_to_string({contract_with_opaque, [M, F, A, OpaqueType, SigType]}) ->
+  io_lib:format("The specification for ~w:~w/~w"
+                " has an opaque subtype ~s which is violated by the"
+                " success typing ~s\n", [M, F, A, OpaqueType, SigType]);
 message_to_string({extra_range, [M, F, A, ExtraRanges, SigRange]}) ->
   io_lib:format("The specification for ~w:~w/~w states that the function"
 		" might also return ~s but the inferred return is ~s\n",
@@ -432,25 +436,25 @@ message_to_string({opaque_guard, [Arg1, Infix, Arg2, ArgNs]}) ->
   io_lib:format("Guard test ~s ~s ~s contains ~s\n",
 		[Arg1, Infix, Arg2, form_positions(ArgNs)]);
 message_to_string({opaque_guard, [Guard, Args]}) ->
-  io_lib:format("Guard test ~w~s breaks the opaqueness of its argument\n",
+  io_lib:format("Guard test ~w~s breaks the opacity of its argument\n",
 		[Guard, Args]);
 message_to_string({opaque_match, [Pat, OpaqueType, OpaqueTerm]}) ->
   Term = if OpaqueType =:= OpaqueTerm -> "the term";
 	    true -> OpaqueTerm
 	 end,
   io_lib:format("The attempt to match a term of type ~s against the ~s"
-		" breaks the opaqueness of ~s\n", [OpaqueType, Pat, Term]);
+		" breaks the opacity of ~s\n", [OpaqueType, Pat, Term]);
 message_to_string({opaque_neq, [Type, _Op, OpaqueType]}) ->
   io_lib:format("Attempt to test for inequality between a term of type ~s"
 		" and a term of opaque type ~s\n", [Type, OpaqueType]);
 message_to_string({opaque_type_test, [Fun, Args, Arg, ArgType]}) ->
-  io_lib:format("The type test ~s~s breaks the opaqueness of the term ~s~s\n",
+  io_lib:format("The type test ~s~s breaks the opacity of the term ~s~s\n",
                 [Fun, Args, Arg, ArgType]);
 message_to_string({opaque_size, [SizeType, Size]}) ->
-  io_lib:format("The size ~s breaks the opaqueness of ~s\n",
+  io_lib:format("The size ~s breaks the opacity of ~s\n",
                 [SizeType, Size]);
 message_to_string({opaque_call, [M, F, Args, Culprit, OpaqueType]}) ->
-  io_lib:format("The call ~s:~s~s breaks the opaqueness of the term ~s :: ~s\n",
+  io_lib:format("The call ~s:~s~s breaks the opacity of the term ~s :: ~s\n",
                 [M, F, Args, Culprit, OpaqueType]);
 %%----- Warnings for concurrency errors --------------------
 message_to_string({race_condition, [M, F, Args, Reason]}) ->
diff --git a/lib/dialyzer/src/dialyzer_cl_parse.erl b/lib/dialyzer/src/dialyzer_cl_parse.erl
index 934351aeeb..f668b81cd3 100644
--- a/lib/dialyzer/src/dialyzer_cl_parse.erl
+++ b/lib/dialyzer/src/dialyzer_cl_parse.erl
@@ -2,7 +2,7 @@
 %%-----------------------------------------------------------------------
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2006-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -510,7 +510,7 @@ warning_options_msg() ->
   -Wno_match
      Suppress warnings for patterns that are unused or cannot match.
   -Wno_opaque
-     Suppress warnings for violations of opaqueness of data types.
+     Suppress warnings for violations of opacity of data types.
   -Wno_fail_call
      Suppress warnings for failing calls.
   -Wno_contracts
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index a72368f9f8..73b04b305b 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -232,7 +232,7 @@ check_contract(#contract{contracts = Contracts}, SuccType, Opaques) ->
       error ->
 	{error, {overlapping_contract, []}};
       ok ->
-	InfList = [erl_types:t_inf(Contract, SuccType, Opaques)
+	InfList = [{Contract, erl_types:t_inf(Contract, SuccType, Opaques)}
 		   || Contract <- Contracts2],
 	case check_contract_inf_list(InfList, SuccType, Opaques) of
 	  {error, _} = Invalid -> Invalid;
@@ -256,10 +256,21 @@ check_domains([Dom|Doms]) ->
 %% Allow a contract if one of the overloaded contracts is possible.
 %% We used to be more strict, e.g., all overloaded contracts had to be
 %% possible.
-check_contract_inf_list([FunType|Left], SuccType, Opaques) ->
+check_contract_inf_list(List, SuccType, Opaques) ->
+  case check_contract_inf_list(List, SuccType, Opaques, []) of
+    ok -> ok;
+    {error, []} -> {error, invalid_contract};
+    {error, [{SigRange, ContrRange}|_]} ->
+      case erl_types:t_find_opaque_mismatch(SigRange, ContrRange, Opaques) of
+        error -> {error, invalid_contract};
+        {ok, _T1, T2} -> {error, {opaque_mismatch, T2}}
+      end
+  end.
+
+check_contract_inf_list([{Contract, FunType}|Left], SuccType, Opaques, OM) ->
   FunArgs = erl_types:t_fun_args(FunType),
   case lists:any(fun erl_types:t_is_none_or_unit/1, FunArgs) of
-    true -> check_contract_inf_list(Left, SuccType, Opaques);
+    true -> check_contract_inf_list(Left, SuccType, Opaques, OM);
     false ->
       STRange = erl_types:t_fun_range(SuccType),
       case erl_types:t_is_none_or_unit(STRange) of
@@ -267,13 +278,16 @@ check_contract_inf_list([FunType|Left], SuccType, Opaques) ->
 	false ->
 	  Range = erl_types:t_fun_range(FunType),
 	  case erl_types:t_is_none(erl_types:t_inf(STRange, Range)) of
-	    true -> check_contract_inf_list(Left, SuccType, Opaques);
+	    true ->
+              CR = erl_types:t_fun_range(Contract),
+              NewOM = [{STRange, CR}|OM],
+              check_contract_inf_list(Left, SuccType, Opaques, NewOM);
 	    false -> ok
 	  end
       end
   end;
-check_contract_inf_list([], _SuccType, _Opaques) ->
-  {error, invalid_contract}.
+check_contract_inf_list([], _SuccType, _Opaques, OM) ->
+  {error, OM}.
 
 check_extraneous([], _SuccType) -> ok;
 check_extraneous([C|Cs], SuccType) ->
@@ -687,6 +701,9 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left],
 	case check_contract(Contract, Sig, Opaques) of
 	  {error, invalid_contract} ->
 	    [invalid_contract_warning(MFA, WarningInfo, Sig, RecDict)|Acc];
+          {error, {opaque_mismatch, T2}} ->
+            W = contract_opaque_warning(MFA, WarningInfo, T2, Sig, RecDict),
+            [W|Acc];
 	  {error, {overlapping_contract, []}} ->
 	    [overlapping_contract_warning(MFA, WarningInfo)|Acc];
 	  {error, {extra_range, ExtraRanges, STRange}} ->
@@ -740,6 +757,12 @@ invalid_contract_warning({M, F, A}, WarningInfo, SuccType, RecDict) ->
   SuccTypeStr = dialyzer_utils:format_sig(SuccType, RecDict),
   {?WARN_CONTRACT_TYPES, WarningInfo, {invalid_contract, [M, F, A, SuccTypeStr]}}.
 
+contract_opaque_warning({M, F, A}, WarningInfo, OpType, SuccType, RecDict) ->
+  OpaqueStr = erl_types:t_to_string(OpType),
+  SuccTypeStr = dialyzer_utils:format_sig(SuccType, RecDict),
+  {?WARN_CONTRACT_TYPES, WarningInfo,
+   {contract_with_opaque, [M, F, A, OpaqueStr, SuccTypeStr]}}.
+
 overlapping_contract_warning({M, F, A}, WarningInfo) ->
   {?WARN_CONTRACT_TYPES, WarningInfo, {overlapping_contract, [M, F, A]}}.
 
diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl
index c0372a47e8..2bc93220e1 100644
--- a/lib/dialyzer/src/dialyzer_dataflow.erl
+++ b/lib/dialyzer/src/dialyzer_dataflow.erl
@@ -1211,7 +1211,7 @@ handle_tuple(Tree, Map, State) ->
 	      TagVal = cerl:atom_val(Tag),
               case state__lookup_record(TagVal, length(Left), State1) of
                 error -> {State1, Map1, TupleType};
-                {ok, RecType} ->
+                {ok, RecType, FieldNames} ->
                   InfTupleType = t_inf(RecType, TupleType),
                   case t_is_none(InfTupleType) of
                     true ->
@@ -1232,10 +1232,13 @@ handle_tuple(Tree, Map, State) ->
                                                       Tree, Msg),
                           {State2, Map1, t_none()};
                         {error, opaque, ErrorPat, ErrorType, OpaqueType} ->
+                          OpaqueStr = format_type(OpaqueType, State1),
+                          Name = field_name(Elements, ErrorPat, FieldNames),
                           Msg = {opaque_match,
-                                 [format_patterns(ErrorPat),
-                                  format_type(ErrorType, State1),
-                                  format_type(OpaqueType, State1)]},
+                                 ["record field" ++ Name ++
+                                  " declared to be of type " ++
+                                    format_type(ErrorType, State1),
+                                  OpaqueStr, OpaqueStr]},
                           State2 = state__add_warning(State1, ?WARN_OPAQUE,
                                                       Tree, Msg),
                           {State2, Map1, t_none()};
@@ -1252,6 +1255,15 @@ handle_tuple(Tree, Map, State) ->
       end
   end.
 
+field_name(Elements, ErrorPat, FieldNames) ->
+  try
+    [Pat] = ErrorPat,
+    Take = lists:takewhile(fun(X) -> X =/= Pat end, Elements),
+    " " ++ format_atom(lists:nth(length(Take), FieldNames))
+  catch
+    _:_ -> ""
+  end.
+
 %%----------------------------------------
 %% Clauses
 %%
@@ -1632,7 +1644,7 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) ->
 		  TagAtom = cerl:atom_val(Tag),
 		  case state__lookup_record(TagAtom, length(Left), State) of
 		    error -> {false, t_tuple(length(Es))};
-		    {ok, Record} ->
+		    {ok, Record, _FieldNames} ->
 		      [_Head|AnyTail] = [t_any() || _ <- Es],
 		      UntypedRecord = t_tuple([t_atom(TagAtom)|AnyTail]),
 		      {not t_is_equal(Record, UntypedRecord), Record}
@@ -2160,7 +2172,7 @@ handle_guard_is_record(Guard, Map, Env, Eval, State) ->
       TupleType =
         case state__lookup_record(Tag, ArityMin1, State) of
           error -> Tuple;
-          {ok, Prototype} -> Prototype
+          {ok, Prototype, _FieldNames} -> Prototype
         end,
       Type = t_inf(TupleType, RecType, State#state.opaques),
       case t_is_none(Type) of
@@ -2610,7 +2622,7 @@ bind_guard_case_clauses(Arg, Clauses, Map0, Env, Eval, State) ->
   Map = join_maps_begin(Map0),
   {GenMap, GenArgType} = bind_guard(Arg, Map, Env, dont_know, State),
   bind_guard_case_clauses(GenArgType, GenMap, Arg, Clauses1, Map, Env, Eval,
-			  t_none(), [], State).
+			  t_none(), [], [], State).
 
 filter_fail_clauses([Clause|Left]) ->
   case (cerl:clause_pats(Clause) =:= []) of
@@ -2629,7 +2641,7 @@ filter_fail_clauses([]) ->
   [].
 
 bind_guard_case_clauses(GenArgType, GenMap, ArgExpr, [Clause|Left],
-			Map, Env, Eval, AccType, AccMaps, State) ->
+			Map, Env, Eval, AccType, AccMaps, Throws, State) ->
   Pats = cerl:clause_pats(Clause),
   {NewMap0, ArgType} =
     case Pats of
@@ -2673,9 +2685,9 @@ bind_guard_case_clauses(GenArgType, GenMap, ArgExpr, [Clause|Left],
   case (NewMap1 =:= none) orelse t_is_none(GenArgType) of
     true ->
       bind_guard_case_clauses(NewGenArgType, GenMap, ArgExpr, Left, Map, Env,
-			      Eval, AccType, AccMaps, State);
+			      Eval, AccType, AccMaps, Throws, State);
     false ->
-      {NewAccType, NewAccMaps} =
+      {NewAccType, NewAccMaps, NewThrows} =
 	try
 	  {NewMap2, GuardType} = bind_guard(Guard, NewMap1, Env, pos, State),
 	  case t_is_none(t_inf(t_atom(true), GuardType)) of
@@ -2699,17 +2711,26 @@ bind_guard_case_clauses(GenArgType, GenMap, ArgExpr, [Clause|Left],
 	    dont_know ->
 	      ok
 	  end,
-	  {t_sup(AccType, CType), [NewMap3|AccMaps]}
+	  {t_sup(AccType, CType), [NewMap3|AccMaps], Throws}
 	catch
-	  throw:{fail, _What} -> {AccType, AccMaps}
+	  throw:{fail, Reason} ->
+            Throws1 = case Reason of
+                        none -> Throws;
+                        _ -> Throws ++ [Reason]
+                      end,
+            {AccType, AccMaps, Throws1}
 	end,
       bind_guard_case_clauses(NewGenArgType, GenMap, ArgExpr, Left, Map, Env,
-			      Eval, NewAccType, NewAccMaps, State)
+			      Eval, NewAccType, NewAccMaps, NewThrows, State)
   end;
 bind_guard_case_clauses(_GenArgType, _GenMap, _ArgExpr, [], Map, _Env, _Eval,
-			AccType, AccMaps, _State) ->
+			AccType, AccMaps, Throws, _State) ->
   case t_is_none(AccType) of
-    true -> throw({fail, none});
+    true ->
+      case Throws of
+        [Throw|_] -> throw({fail, Throw});
+        [] -> throw({fail, none})
+      end;
     false -> {join_maps_end(AccMaps, Map), AccType}
   end.
 
@@ -3207,7 +3228,8 @@ state__lookup_record(Tag, Arity, #state{records = Records}) ->
       RecType =
         t_tuple([t_atom(Tag)|
                  [FieldType || {_FieldName, _Abstr, FieldType} <- Fields]]),
-      {ok, RecType};
+      FieldNames = [FieldName || {FieldName, _Abstr, _FieldType} <- Fields],
+      {ok, RecType, FieldNames};
     error ->
       error
   end.
@@ -3662,6 +3684,9 @@ map_pats(Pats) ->
 fold_literals(TreeList) ->
   [cerl:fold_literal(Tree) || Tree <- TreeList].
 
+format_atom(A) ->
+  format_cerl(cerl:c_atom(A)).
+
 type(Tree) ->
   Folded = cerl:fold_literal(Tree),
   case cerl:type(Folded) of
diff --git a/lib/dialyzer/src/dialyzer_gui_wx.erl b/lib/dialyzer/src/dialyzer_gui_wx.erl
index 30d2bdeca4..4caf64d007 100644
--- a/lib/dialyzer/src/dialyzer_gui_wx.erl
+++ b/lib/dialyzer/src/dialyzer_gui_wx.erl
@@ -2,7 +2,7 @@
 %%------------------------------------------------------------------------
 %% %CopyrightBegin%
 %%
-%% Copyright Ericsson AB 2009-2015. All Rights Reserved.
+%% Copyright Ericsson AB 2009-2016. All Rights Reserved.
 %%
 %% Licensed under the Apache License, Version 2.0 (the "License");
 %% you may not use this file except in compliance with the License.
@@ -310,7 +310,7 @@ createWarningsMenu() ->
   addCheckedItem(WarningsMenu, ?menuID_WARN_FAIL_FUN_CALLS,
 		 "Failing function calls"),
   addCheckedItem(WarningsMenu, ?menuID_WARN_BAD_FUN, "Bad fun applications"),
-  addCheckedItem(WarningsMenu, ?menuID_WARN_OPAQUE, "Opaqueness violations"),
+  addCheckedItem(WarningsMenu, ?menuID_WARN_OPAQUE, "Opacity violations"),
   addCheckedItem(WarningsMenu, ?menuID_WARN_LIST_CONSTR,
 		 "Improper list constructions"),
   addCheckedItem(WarningsMenu, ?menuID_WARN_UNUSED_FUN, "Unused functions"),