Report spec discrepancy on mismatching lists

This patch enables Dialyzer to detect cases where a function has a specification
for a return type containing some list with elements different than the ones
Dialyzer's own algorithm can infer e.g. a function specified to return [atom()]
when actually [[atom()]] is returned.

Previously Dialyzer remained silent, under normal operation, seeing that these
two types have the empty list as a common element, so they were not 'completely
irrelevant'.

3 files changed, 83 insertions, 3 deletions

diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index 0b932d5a1f..157c951f77 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -254,14 +254,35 @@ check_extraneous([C|Cs], SuccType) ->
   end.
 
 check_extraneous_1(Contract, SuccType) ->
-  CRngs = erl_types:t_elements(erl_types:t_fun_range(Contract)),
+  CRng = erl_types:t_fun_range(Contract),
+  CRngs = erl_types:t_elements(CRng),
   STRng = erl_types:t_fun_range(SuccType),
   ?debug("CR = ~p\nSR = ~p\n", [CRngs, STRng]),
-  case [CR || CR <- CRngs, erl_types:t_is_none(erl_types:t_inf(CR, STRng, opaque))] of
-    [] -> ok;
+  case [CR || CR <- CRngs,
+              erl_types:t_is_none(erl_types:t_inf(CR, STRng, opaque))] of
+    [] ->
+      CRngList = list_part(CRng),
+      STRngList = list_part(STRng),
+      case is_not_nil_list(CRngList) andalso is_not_nil_list(STRngList) of
+        false -> ok;
+        true ->
+          CRngElements = erl_types:t_list_elements(CRngList),
+          STRngElements = erl_types:t_list_elements(STRngList),
+          Inf = erl_types:t_inf(CRngElements, STRngElements, opaque),
+          case erl_types:t_is_none(Inf) of
+            true -> {error, invalid_contract};
+            false -> ok
+          end
+      end;
     CRs -> {error, {extra_range, erl_types:t_sup(CRs), STRng}}
   end.
 
+list_part(Type) ->
+  erl_types:t_inf(erl_types:t_list(), Type, opaque).
+
+is_not_nil_list(Type) ->
+  erl_types:t_is_list(Type) andalso not erl_types:t_is_nil(Type).
+
 %% This is the heart of the "range function"
 -spec process_contracts([contract_pair()], [erl_types:erl_type()]) -> erl_types:erl_type().
 
diff --git a/lib/dialyzer/test/small_SUITE_data/results/empty_list_infimum b/lib/dialyzer/test/small_SUITE_data/results/empty_list_infimum
new file mode 100644
index 0000000000..a59986cba5
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/results/empty_list_infimum
@@ -0,0 +1,2 @@
+
+empty_list_infimum.erl:39: Invalid type specification for function empty_list_infimum:list_vhost_permissions/1. The success typing is (_) -> [[{_,_}]]
diff --git a/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl b/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl
new file mode 100644
index 0000000000..b58fa732cb
--- /dev/null
+++ b/lib/dialyzer/test/small_SUITE_data/src/empty_list_infimum.erl
@@ -0,0 +1,57 @@
+%%
+%% The Original Code is RabbitMQ.
+%%
+%% The Initial Developer of the Original Code is VMware, Inc.
+%%
+
+-module(empty_list_infimum).
+
+-record(permission, {configure, write, read}).
+-record(user_vhost, {username, virtual_host}).
+-record(user_permission, {user_vhost, permission}).
+
+%%----------------------------------------------------------------------------
+
+-export([i_delete/1]).
+
+-type(vhost() :: binary()).
+
+-type(info_key() :: atom()).
+-type(info_keys() :: [info_key()]).
+
+-type(info() :: {info_key(), any()}).
+-type(infos() :: [info()]).
+
+%%----------------------------------------------------------------------------
+
+-spec i_delete(vhost()) -> 'ok'.
+
+i_delete(VHostPath) ->
+    [ok || _ <- list_vhost_permissions(VHostPath)],
+    ok.
+
+%%----------------------------------------------------------------------------
+
+vhost_perms_info_keys() ->
+    [user, configure, write, read].
+
+-spec list_vhost_permissions(vhost()) -> infos().
+
+list_vhost_permissions(VHostPath) ->
+    list_permissions(vhost_perms_info_keys(), rabbit_foo:some_list()).
+
+filter_props(Keys, Props) ->
+    [T || T = {K, _} <- Props, lists:member(K, Keys)].
+
+list_permissions(Keys, SomeList) ->
+    [filter_props(Keys, [{user,      Username},
+                         {vhost,     VHostPath},
+                         {configure, ConfigurePerm},
+                         {write,     WritePerm},
+                         {read,      ReadPerm}]) ||
+        #user_permission{user_vhost = #user_vhost{username     = Username,
+                                                  virtual_host = VHostPath},
+                         permission = #permission{configure = ConfigurePerm,
+						  write     = WritePerm,
+						  read      = ReadPerm}} <-
+           SomeList].