dialyzer: Refine the test for overspecified functions

The -Woverspecs (-Wspecdiffs) option generates warnings in a few more
cases. The refinement is analogous to the test that -Wunderspecs
already does: it checks if the contract has nothing in common with
some element (see erl_types:t_elements/1) of the success typing.

13 files changed, 255 insertions, 25 deletions

diff --git a/lib/dialyzer/src/dialyzer.erl b/lib/dialyzer/src/dialyzer.erl
index 1538174d4a..185c8c9ae6 100644
--- a/lib/dialyzer/src/dialyzer.erl
+++ b/lib/dialyzer/src/dialyzer.erl
@@ -409,6 +409,10 @@ message_to_string({extra_range, [M, F, A, ExtraRanges, SigRange]}) ->
   io_lib:format("The specification for ~w:~tw/~w states that the function"
 		" might also return ~ts but the inferred return is ~ts\n",
 		[M, F, A, ExtraRanges, SigRange]);
+message_to_string({missing_range, [M, F, A, ExtraRanges, ContrRange]}) ->
+  io_lib:format("The success typing for ~w:~tw/~w implies that the function"
+		" might also return ~ts but the specification return is ~ts\n",
+		[M, F, A, ExtraRanges, ContrRange]);
 message_to_string({overlapping_contract, [M, F, A]}) ->
   io_lib:format("Overloaded contract for ~w:~tw/~w has overlapping domains;"
 		" such contracts are currently unsupported and are simply ignored\n",
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index 0df15e55f9..af7f4385ad 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -197,9 +197,11 @@ check_contracts(Contracts, Callgraph, FunTypes, ModOpaques) ->
 		      false ->
 			[{MFA, Contract}|NewContracts]
 		    end;
-                  {error, {extra_range, _, _}} ->
-                    %% do not treat extra range as an error in this check
-                    %% since that prevents discovering other actual errors
+                  {range_warnings, _} ->
+                    %% do not treat extra range, either in contract or
+                    %% in success typing, as an error in this check
+                    %% since that prevents discovering other actual
+                    %% errors
                     [{MFA, Contract}|NewContracts];
 		  {error, _Error} -> NewContracts
 		end;
@@ -210,14 +212,26 @@ check_contracts(Contracts, Callgraph, FunTypes, ModOpaques) ->
     end,
   orddict:from_list(lists:foldl(FoldFun, [], orddict:to_list(FunTypes))).
 
+-type check_contract_return() ::
+        'ok'
+      | {'error',
+             'invalid_contract'
+           | {'opaque_mismatch', erl_types:erl_type()}
+           | {'overlapping_contract', [module() | atom() | byte()]}
+           | string()}
+      | {'range_warnings',
+         [{'error', {'extra_range' | 'missing_range',
+                     erl_types:erl_type(),
+                     erl_types:erl_type()}}]}.
+
 %% Checks all components of a contract
--spec check_contract(#contract{}, erl_types:erl_type()) -> 'ok' | {'error', term()}.
+-spec check_contract(#contract{}, erl_types:erl_type()) -> check_contract_return().
 
 check_contract(Contract, SuccType) ->
   check_contract(Contract, SuccType, 'universe').
 
 -spec check_contract(#contract{}, erl_types:erl_type(), erl_types:opaques()) ->
-                        'ok' | {'error', term()}.
+                        check_contract_return().
 
 check_contract(#contract{contracts = Contracts}, SuccType, Opaques) ->
   try
@@ -290,15 +304,23 @@ check_contract_inf_list([], _SuccType, _Opaques, OM) ->
 check_extraneous([], _SuccType) -> ok;
 check_extraneous([C|Cs], SuccType) ->
   case check_extraneous_1(C, SuccType) of
-    ok -> check_extraneous(Cs, SuccType);
-    Error -> Error
+    {error, invalid_contract} = Error ->
+      Error;
+    {error, {extra_range, _, _}} = Error ->
+      {range_warnings, [Error | check_missing(C, SuccType)]};
+    ok ->
+      case check_missing(C, SuccType) of
+        [] -> check_extraneous(Cs, SuccType);
+        ErrorL -> {range_warnings, ErrorL}
+      end
   end.
 
 check_extraneous_1(Contract, SuccType) ->
   CRng = erl_types:t_fun_range(Contract),
   CRngs = erl_types:t_elements(CRng),
   STRng = erl_types:t_fun_range(SuccType),
-  ?debug("CR = ~tp\nSR = ~tp\n", [CRngs, STRng]),
+  ?debug("\nCR = ~ts\nSR = ~ts\n", [erl_types:t_to_string(CRng),
+                                    erl_types:t_to_string(STRng)]),
   case [CR || CR <- CRngs,
               erl_types:t_is_none(erl_types:t_inf(CR, STRng))] of
     [] ->
@@ -341,6 +363,18 @@ map_part(Type) ->
 is_empty_map(Type) ->
   erl_types:t_is_equal(Type, erl_types:t_from_term(#{})).
 
+check_missing(Contract, SuccType) ->
+  CRng = erl_types:t_fun_range(Contract),
+  STRng = erl_types:t_fun_range(SuccType),
+  STRngs = erl_types:t_elements(STRng),
+  ?debug("\nCR = ~ts\nSR = ~ts\n", [erl_types:t_to_string(CRng),
+                                    erl_types:t_to_string(STRng)]),
+  case [STR || STR <- STRngs,
+              erl_types:t_is_none(erl_types:t_inf(STR, CRng))] of
+    [] -> [];
+    STRs -> [{error, {missing_range, erl_types:t_sup(STRs), CRng}}]
+  end.
+
 %% This is the heart of the "range function"
 -spec process_contracts([contract_pair()], [erl_types:erl_type()]) ->
                            erl_types:erl_type().
@@ -712,22 +746,30 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left],
             [W|Acc];
 	  {error, {overlapping_contract, []}} ->
 	    [overlapping_contract_warning(MFA, WarningInfo)|Acc];
-	  {error, {extra_range, ExtraRanges, STRange}} ->
-	    Warn =
-	      case t_from_forms_without_remote(Contract#contract.forms,
-					       MFA, RecDict) of
-		{ok, NoRemoteType} ->
-		  CRet = erl_types:t_fun_range(NoRemoteType),
-		  erl_types:t_is_subtype(ExtraRanges, CRet);
-		unsupported ->
-		  true
-	      end,
-	    case Warn of
-	      true ->
-		[extra_range_warning(MFA, WarningInfo, ExtraRanges, STRange)|Acc];
-	      false ->
-		Acc
-	    end;
+	  {range_warnings, Errors} ->
+            Fun =
+              fun({error, {extra_range, ExtraRanges, STRange}}, Acc0) ->
+                  Warn =
+                    case t_from_forms_without_remote(Contract#contract.forms,
+                                                     MFA, RecDict) of
+                      {ok, NoRemoteType} ->
+                        CRet = erl_types:t_fun_range(NoRemoteType),
+                        erl_types:t_is_subtype(ExtraRanges, CRet);
+                      unsupported ->
+                        true
+                    end,
+                  case Warn of
+                    true ->
+                      [extra_range_warning(MFA, WarningInfo,
+                                           ExtraRanges, STRange)|Acc0];
+                    false ->
+                      Acc0
+                  end;
+                 ({error, {missing_range, ExtraRanges, CRange}}, Acc0) ->
+                  [missing_range_warning(MFA, WarningInfo,
+                                         ExtraRanges, CRange)|Acc0]
+              end,
+            lists:foldl(Fun, Acc, Errors);
 	  {error, Msg} ->
 	    [{?WARN_CONTRACT_SYNTAX, WarningInfo, Msg}|Acc];
 	  ok ->
@@ -745,6 +787,9 @@ get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract, _Xtra}}|Left],
 		  {error, _} ->
 		    [invalid_contract_warning(MFA, WarningInfo, BifSig, RecDict)
 		     |Acc];
+                  {range_warnings, _} ->
+		    picky_contract_check(CSig, BifSig, MFA, WarningInfo,
+					 Contract, RecDict, Acc);
 		  ok ->
 		    picky_contract_check(CSig, BifSig, MFA, WarningInfo,
 					 Contract, RecDict, Acc)
@@ -778,6 +823,12 @@ extra_range_warning({M, F, A}, WarningInfo, ExtraRanges, STRange) ->
   {?WARN_CONTRACT_SUPERTYPE, WarningInfo,
    {extra_range, [M, F, A, ERangesStr, STRangeStr]}}.
 
+missing_range_warning({M, F, A}, WarningInfo, ExtraRanges, CRange) ->
+  ERangesStr = erl_types:t_to_string(ExtraRanges),
+  CRangeStr = erl_types:t_to_string(CRange),
+  {?WARN_CONTRACT_SUBTYPE, WarningInfo,
+   {missing_range, [M, F, A, ERangesStr, CRangeStr]}}.
+
 picky_contract_check(CSig0, Sig0, MFA, WarningInfo, Contract, RecDict, Acc) ->
   CSig = erl_types:t_abstract_records(CSig0, RecDict),
   Sig = erl_types:t_abstract_records(Sig0, RecDict),
diff --git a/lib/dialyzer/src/typer.erl b/lib/dialyzer/src/typer.erl
index 9d3d9ce438..4b99f5f72e 100644
--- a/lib/dialyzer/src/typer.erl
+++ b/lib/dialyzer/src/typer.erl
@@ -401,7 +401,7 @@ get_type({{M, F, A} = MFA, Range, Arg}, CodeServer, Records) ->
       Sig = erl_types:t_fun(Arg, Range),
       case dialyzer_contracts:check_contract(Contract, Sig) of
 	ok -> {{F, A}, {contract, Contract}};
-	{error, {extra_range, _, _}} ->
+        {range_warnings, _} ->
 	  {{F, A}, {contract, Contract}};
 	{error, {overlapping_contract, []}} ->
 	  {{F, A}, {contract, Contract}};
diff --git a/lib/dialyzer/test/overspecs_SUITE_data/dialyzer_options b/lib/dialyzer/test/overspecs_SUITE_data/dialyzer_options
new file mode 100644
index 0000000000..ff4517e59d
--- /dev/null
+++ b/lib/dialyzer/test/overspecs_SUITE_data/dialyzer_options
@@ -0,0 +1 @@
+{dialyzer_options, [{warnings, [overspecs]}]}.
diff --git a/lib/dialyzer/test/overspecs_SUITE_data/results/iodata b/lib/dialyzer/test/overspecs_SUITE_data/results/iodata
new file mode 100644
index 0000000000..d9c70330ec
--- /dev/null
+++ b/lib/dialyzer/test/overspecs_SUITE_data/results/iodata
@@ -0,0 +1,2 @@
+
+iodata.erl:7: The success typing for iodata:encode/2 implies that the function might also return integer() but the specification return is binary() | maybe_improper_list(binary() | maybe_improper_list(any(),binary() | []) | byte(),binary() | [])
diff --git a/lib/dialyzer/test/overspecs_SUITE_data/results/iolist b/lib/dialyzer/test/overspecs_SUITE_data/results/iolist
new file mode 100644
index 0000000000..ca556f017c
--- /dev/null
+++ b/lib/dialyzer/test/overspecs_SUITE_data/results/iolist
@@ -0,0 +1,2 @@
+
+iolist.erl:7: The success typing for iolist:encode/2 implies that the function might also return integer() but the specification return is maybe_improper_list(binary() | maybe_improper_list(any(),binary() | []) | byte(),binary() | [])
diff --git a/lib/dialyzer/test/overspecs_SUITE_data/src/iodata.erl b/lib/dialyzer/test/overspecs_SUITE_data/src/iodata.erl
new file mode 100644
index 0000000000..caa44f6c91
--- /dev/null
+++ b/lib/dialyzer/test/overspecs_SUITE_data/src/iodata.erl
@@ -0,0 +1,41 @@
+-module(iodata).
+
+%% A small part of beam_asm.
+
+-export([encode/2]).
+
+-spec encode(non_neg_integer(), integer()) -> iodata(). % extra range binary()
+
+encode(Tag, N) when Tag >= 0, N < 0 ->
+    encode1(Tag, negative_to_bytes(N));
+encode(Tag, N) when Tag >= 0, N < 16 ->
+    (N bsl 4) bor Tag; % not in the specification
+encode(Tag, N) when Tag >= 0, N < 16#800  ->
+    [((N bsr 3) band 2#11100000) bor Tag bor 2#00001000, N band 16#ff];
+encode(Tag, N) when Tag >= 0 ->
+    encode1(Tag, to_bytes(N)).
+
+encode1(Tag, Bytes) ->
+    case iolist_size(Bytes) of
+	Num when 2 =< Num, Num =< 8 ->
+	    [((Num-2) bsl 5) bor 2#00011000 bor Tag| Bytes];
+	Num when 8 < Num ->
+	    [2#11111000 bor Tag, encode(0, Num-9)| Bytes]
+    end.
+
+to_bytes(N) ->
+    Bin = binary:encode_unsigned(N),
+    case Bin of
+	<<0:1,_/bits>> -> Bin;
+	<<1:1,_/bits>> -> [0,Bin]
+    end.
+
+negative_to_bytes(N) when N >= -16#8000 ->
+    <<N:16>>;
+negative_to_bytes(N) ->
+    Bytes = byte_size(binary:encode_unsigned(-N)),
+    Bin = <<N:Bytes/unit:8>>,
+    case Bin of
+	<<0:1,_/bits>> -> [16#ff,Bin];
+	<<1:1,_/bits>> -> Bin
+    end.
diff --git a/lib/dialyzer/test/overspecs_SUITE_data/src/iolist.erl b/lib/dialyzer/test/overspecs_SUITE_data/src/iolist.erl
new file mode 100644
index 0000000000..7cceeda24e
--- /dev/null
+++ b/lib/dialyzer/test/overspecs_SUITE_data/src/iolist.erl
@@ -0,0 +1,41 @@
+-module(iolist).
+
+%% A small part of beam_asm.
+
+-export([encode/2]).
+
+-spec encode(non_neg_integer(), integer()) -> iolist().
+
+encode(Tag, N) when Tag >= 0, N < 0 ->
+    encode1(Tag, negative_to_bytes(N));
+encode(Tag, N) when Tag >= 0, N < 16 ->
+    (N bsl 4) bor Tag; % not in the specification
+encode(Tag, N) when Tag >= 0, N < 16#800  ->
+    [((N bsr 3) band 2#11100000) bor Tag bor 2#00001000, N band 16#ff];
+encode(Tag, N) when Tag >= 0 ->
+    encode1(Tag, to_bytes(N)).
+
+encode1(Tag, Bytes) ->
+    case iolist_size(Bytes) of
+	Num when 2 =< Num, Num =< 8 ->
+	    [((Num-2) bsl 5) bor 2#00011000 bor Tag| Bytes];
+	Num when 8 < Num ->
+	    [2#11111000 bor Tag, encode(0, Num-9)| Bytes]
+    end.
+
+to_bytes(N) ->
+    Bin = binary:encode_unsigned(N),
+    case Bin of
+	<<0:1,_/bits>> -> Bin;
+	<<1:1,_/bits>> -> [0,Bin]
+    end.
+
+negative_to_bytes(N) when N >= -16#8000 ->
+    <<N:16>>;
+negative_to_bytes(N) ->
+    Bytes = byte_size(binary:encode_unsigned(-N)),
+    Bin = <<N:Bytes/unit:8>>,
+    case Bin of
+	<<0:1,_/bits>> -> [16#ff,Bin];
+	<<1:1,_/bits>> -> Bin
+    end.
diff --git a/lib/dialyzer/test/specdiffs_SUITE_data/dialyzer_options b/lib/dialyzer/test/specdiffs_SUITE_data/dialyzer_options
new file mode 100644
index 0000000000..56b36f2ed4
--- /dev/null
+++ b/lib/dialyzer/test/specdiffs_SUITE_data/dialyzer_options
@@ -0,0 +1 @@
+{dialyzer_options, [{warnings, [specdiffs]}]}.
diff --git a/lib/dialyzer/test/specdiffs_SUITE_data/results/iodata b/lib/dialyzer/test/specdiffs_SUITE_data/results/iodata
new file mode 100644
index 0000000000..3fb12fe000
--- /dev/null
+++ b/lib/dialyzer/test/specdiffs_SUITE_data/results/iodata
@@ -0,0 +1,3 @@
+
+iodata.erl:7: The specification for iodata:encode/2 states that the function might also return binary() but the inferred return is nonempty_maybe_improper_list(<<_:8,_:_*8>> | nonempty_maybe_improper_list(<<_:8,_:_*8>> | nonempty_maybe_improper_list(any(),<<_:8,_:_*8>> | []) | byte(),<<_:8,_:_*8>> | []) | integer(),<<_:8,_:_*8>> | []) | integer()
+iodata.erl:7: The success typing for iodata:encode/2 implies that the function might also return integer() but the specification return is binary() | maybe_improper_list(binary() | maybe_improper_list(any(),binary() | []) | byte(),binary() | [])
diff --git a/lib/dialyzer/test/specdiffs_SUITE_data/results/iolist b/lib/dialyzer/test/specdiffs_SUITE_data/results/iolist
new file mode 100644
index 0000000000..ca556f017c
--- /dev/null
+++ b/lib/dialyzer/test/specdiffs_SUITE_data/results/iolist
@@ -0,0 +1,2 @@
+
+iolist.erl:7: The success typing for iolist:encode/2 implies that the function might also return integer() but the specification return is maybe_improper_list(binary() | maybe_improper_list(any(),binary() | []) | byte(),binary() | [])
diff --git a/lib/dialyzer/test/specdiffs_SUITE_data/src/iodata.erl b/lib/dialyzer/test/specdiffs_SUITE_data/src/iodata.erl
new file mode 100644
index 0000000000..caa44f6c91
--- /dev/null
+++ b/lib/dialyzer/test/specdiffs_SUITE_data/src/iodata.erl
@@ -0,0 +1,41 @@
+-module(iodata).
+
+%% A small part of beam_asm.
+
+-export([encode/2]).
+
+-spec encode(non_neg_integer(), integer()) -> iodata(). % extra range binary()
+
+encode(Tag, N) when Tag >= 0, N < 0 ->
+    encode1(Tag, negative_to_bytes(N));
+encode(Tag, N) when Tag >= 0, N < 16 ->
+    (N bsl 4) bor Tag; % not in the specification
+encode(Tag, N) when Tag >= 0, N < 16#800  ->
+    [((N bsr 3) band 2#11100000) bor Tag bor 2#00001000, N band 16#ff];
+encode(Tag, N) when Tag >= 0 ->
+    encode1(Tag, to_bytes(N)).
+
+encode1(Tag, Bytes) ->
+    case iolist_size(Bytes) of
+	Num when 2 =< Num, Num =< 8 ->
+	    [((Num-2) bsl 5) bor 2#00011000 bor Tag| Bytes];
+	Num when 8 < Num ->
+	    [2#11111000 bor Tag, encode(0, Num-9)| Bytes]
+    end.
+
+to_bytes(N) ->
+    Bin = binary:encode_unsigned(N),
+    case Bin of
+	<<0:1,_/bits>> -> Bin;
+	<<1:1,_/bits>> -> [0,Bin]
+    end.
+
+negative_to_bytes(N) when N >= -16#8000 ->
+    <<N:16>>;
+negative_to_bytes(N) ->
+    Bytes = byte_size(binary:encode_unsigned(-N)),
+    Bin = <<N:Bytes/unit:8>>,
+    case Bin of
+	<<0:1,_/bits>> -> [16#ff,Bin];
+	<<1:1,_/bits>> -> Bin
+    end.
diff --git a/lib/dialyzer/test/specdiffs_SUITE_data/src/iolist.erl b/lib/dialyzer/test/specdiffs_SUITE_data/src/iolist.erl
new file mode 100644
index 0000000000..7cceeda24e
--- /dev/null
+++ b/lib/dialyzer/test/specdiffs_SUITE_data/src/iolist.erl
@@ -0,0 +1,41 @@
+-module(iolist).
+
+%% A small part of beam_asm.
+
+-export([encode/2]).
+
+-spec encode(non_neg_integer(), integer()) -> iolist().
+
+encode(Tag, N) when Tag >= 0, N < 0 ->
+    encode1(Tag, negative_to_bytes(N));
+encode(Tag, N) when Tag >= 0, N < 16 ->
+    (N bsl 4) bor Tag; % not in the specification
+encode(Tag, N) when Tag >= 0, N < 16#800  ->
+    [((N bsr 3) band 2#11100000) bor Tag bor 2#00001000, N band 16#ff];
+encode(Tag, N) when Tag >= 0 ->
+    encode1(Tag, to_bytes(N)).
+
+encode1(Tag, Bytes) ->
+    case iolist_size(Bytes) of
+	Num when 2 =< Num, Num =< 8 ->
+	    [((Num-2) bsl 5) bor 2#00011000 bor Tag| Bytes];
+	Num when 8 < Num ->
+	    [2#11111000 bor Tag, encode(0, Num-9)| Bytes]
+    end.
+
+to_bytes(N) ->
+    Bin = binary:encode_unsigned(N),
+    case Bin of
+	<<0:1,_/bits>> -> Bin;
+	<<1:1,_/bits>> -> [0,Bin]
+    end.
+
+negative_to_bytes(N) when N >= -16#8000 ->
+    <<N:16>>;
+negative_to_bytes(N) ->
+    Bytes = byte_size(binary:encode_unsigned(-N)),
+    Bin = <<N:Bytes/unit:8>>,
+    case Bin of
+	<<0:1,_/bits>> -> [16#ff,Bin];
+	<<1:1,_/bits>> -> Bin
+    end.