stdilb: Check for bad type constraints in function types

The parser recognizes the 'is_subtype(V, T)' syntax for constraints,
and of course the new 'V :: T' syntax, but other variants result in an
error message. Up to now, the parser and linter have let badly formed
constraints through, and relied upon Dialyzer to emit warnings.

is_subtype/2 cannot easily be taken out from the parser. Not only
would we need find a way to emit a (linter) warning, but there also
needs to be an option for suppressing the linter warning as
compilation with +warnings_as_errors has to work. (Notice that the
abstract format representation for 'V :: T' is the same as for
'is_subtype(V, T)'.)

This correction was triggered by an email from Robert, and Kostis
created pull request 1214 to provide a fix. However, Kostis' fix
disallowed is_subtype() altogether, which breaks backward
compatibility.

As of Erlang/OTP 19.0 (ticket OTP-11879), the 'is_subtype(V, T)' is no
longer documented.

4 files changed, 80 insertions, 24 deletions

diff --git a/erts/doc/src/absform.xml b/erts/doc/src/absform.xml
index ab00d47425..fe8e3b30e7 100644
--- a/erts/doc/src/absform.xml
+++ b/erts/doc/src/absform.xml
@@ -886,7 +886,7 @@
         Rep(Fc) = <c>[Rep(C_1), ..., Rep(C_k)]</c>.</p>
 
       <list type="bulleted">
-        <item>If C is a constraint <c>is_subtype(V, T)</c> or <c>V :: T</c>,
+        <item>If C is a constraint <c>V :: T</c>,
           where <c>V</c> is a type variable
           and <c>T</c> is a type, then Rep(C) =
           <c>{type,LINE,constraint,[{atom,LINE,is_subtype},[Rep(V),Rep(T)]]}</c>.
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 9cd95705af..a0bc21fbc5 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -33,7 +33,6 @@ list tail
 list_comprehension lc_expr lc_exprs
 binary_comprehension
 tuple
-%struct
 record_expr record_tuple record_field record_fields
 map_expr map_tuple map_field map_field_assoc map_field_exact map_fields map_key
 if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr
@@ -108,9 +107,8 @@ type_sig -> fun_type 'when' type_guards   : {type, ?anno('$1'), bounded_fun,
 type_guards -> type_guard                 : ['$1'].
 type_guards -> type_guard ',' type_guards : ['$1'|'$3'].
 
-type_guard -> atom '(' top_types ')'      : {type, ?anno('$1'), constraint,
-                                             ['$1', '$3']}.
-type_guard -> var '::' top_type           : build_def('$1', '$3').
+type_guard -> atom '(' top_types ')'   : build_compat_constraint('$1', '$3').
+type_guard -> var '::' top_type        : build_constraint('$1', '$3').
 
 top_types -> top_type                     : ['$1'].
 top_types -> top_type ',' top_types       : ['$1'|'$3'].
@@ -268,7 +266,6 @@ expr_max -> binary : '$1'.
 expr_max -> list_comprehension : '$1'.
 expr_max -> binary_comprehension : '$1'.
 expr_max -> tuple : '$1'.
-%%expr_max -> struct : '$1'.
 expr_max -> '(' expr ')' : '$2'.
 expr_max -> 'begin' exprs 'end' : {block,?anno('$1'),'$2'}.
 expr_max -> if_expr : '$1'.
@@ -327,10 +324,6 @@ lc_expr -> binary '<=' expr : {b_generate,?anno('$2'),'$1','$3'}.
 tuple -> '{' '}' : {tuple,?anno('$1'),[]}.
 tuple -> '{' exprs '}' : {tuple,?anno('$1'),'$2'}.
 
-
-%%struct -> atom tuple :
-%%	{struct,?anno('$1'),element(3, '$1'),element(3, '$2')}.
-
 map_expr -> '#' map_tuple :
 	{map, ?anno('$1'),'$2'}.
 map_expr -> expr_max '#' map_tuple :
@@ -1056,13 +1049,13 @@ build_typed_attribute({atom,Aa,Attr},_) ->
     end.
 
 build_type_spec({Kind,Aa}, {SpecFun, TypeSpecs})
-  when (Kind =:= spec) or (Kind =:= callback) ->
+  when Kind =:= spec ; Kind =:= callback ->
     NewSpecFun =
 	case SpecFun of
 	    {atom, _, Fun} ->
 		{Fun, find_arity_from_specs(TypeSpecs)};
-	    {{atom,_, Mod}, {atom,_, Fun}} ->
-		{Mod,Fun,find_arity_from_specs(TypeSpecs)}
+	    {{atom, _, Mod}, {atom, _, Fun}} ->
+		{Mod, Fun, find_arity_from_specs(TypeSpecs)}
         end,
     {attribute,Aa,Kind,{NewSpecFun, TypeSpecs}}.
 
@@ -1076,11 +1069,24 @@ find_arity_from_specs([Spec|_]) ->
     {type, _, 'fun', [{type, _, product, Args},_]} = Fun,
     length(Args).
 
-build_def({var, A, '_'}, _Types) ->
+%% The 'is_subtype(V, T)' syntax is not supported as of Erlang/OTP
+%% 19.0, but is kept for backward compatibility.
+build_compat_constraint({atom, _, is_subtype}, [{var, _, _}=LHS, Type]) ->
+    build_constraint(LHS, Type);
+build_compat_constraint({atom, _, is_subtype}, [LHS, _Type]) ->
+    ret_err(?anno(LHS), "bad type variable");
+build_compat_constraint({atom, A, Atom}, _Types) ->
+    ret_err(A, io_lib:format("unsupported constraint ~w", [Atom])).
+
+build_constraint({atom, _, is_subtype}, [{var, _, _}=LHS, Type]) ->
+    build_constraint(LHS, Type);
+build_constraint({atom, A, Atom}, _Foo) ->
+    ret_err(A, io_lib:format("unsupported constraint ~w", [Atom]));
+build_constraint({var, A, '_'}, _Types) ->
     ret_err(A, "bad type variable");
-build_def(LHS, Types) ->
+build_constraint(LHS, Type) ->
     IsSubType = {atom, ?anno(LHS), is_subtype},
-    {type, ?anno(LHS), constraint, [IsSubType, [LHS, Types]]}.
+    {type, ?anno(LHS), constraint, [IsSubType, [LHS, Type]]}.
 
 lift_unions(T1, {type, _Aa, union, List}) ->
     {type, ?anno(T1), union, [T1|List]};
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index 4ee3950882..1dc7c58337 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -64,7 +64,7 @@
          predef/1,
          maps/1,maps_type/1,maps_parallel_match/1,
          otp_11851/1,otp_11879/1,otp_13230/1,
-         record_errors/1]).
+         record_errors/1, otp_xxxxx/1]).
 
 suite() ->
     [{ct_hooks,[ts_install_cth]},
@@ -84,7 +84,7 @@ all() ->
      too_many_arguments, basic_errors, bin_syntax_errors, predef,
      maps, maps_type, maps_parallel_match,
      otp_11851, otp_11879, otp_13230,
-     record_errors].
+     record_errors, otp_xxxxx].
 
 groups() -> 
     [{unused_vars_warn, [],
@@ -3869,6 +3869,55 @@ record_errors(Config) when is_list(Config) ->
 		    {3,erl_lint,{redefine_field,r,a}}],[]}}],
     run(Config, Ts).
 
+otp_xxxxx(Config) ->
+    Ts = [{constraint1,
+           <<"-export([t/1]).
+              -spec t(X) -> X when is_subtype(integer()).
+              t(a) -> foo:bar().
+             ">>,
+           [],
+           {errors,
+            [{2,erl_parse,"unsupported constraint " ++ ["is_subtype"]}],
+            []}},
+          {constraint2,
+           <<"-export([t/1]).
+              -spec t(X) -> X when bad_atom(X, integer()).
+              t(a) -> foo:bar().
+             ">>,
+           [],
+           {errors,
+            [{2,erl_parse,"unsupported constraint " ++ ["bad_atom"]}],
+            []}},
+          {constraint3,
+           <<"-export([t/1]).
+              -spec t(X) -> X when is_subtype(bad_variable, integer()).
+              t(a) -> foo:bar().
+             ">>,
+           [],
+           {errors,[{2,erl_parse,"bad type variable"}],[]}},
+          {constraint4,
+           <<"-export([t/1]).
+              -spec t(X) -> X when is_subtype(atom(), integer()).
+              t(a) -> foo:bar().
+             ">>,
+           [],
+           {errors,[{2,erl_parse,"bad type variable"}],[]}},
+          {constraint5,
+           <<"-export([t/1]).
+              -spec t(X) -> X when is_subtype(X, integer()).
+              t(a) -> foo:bar().
+             ">>,
+           [],
+           []},
+          {constraint6,
+           <<"-export([t/1]).
+              -spec t(X) -> X when X :: integer().
+              t(a) -> foo:bar().
+             ">>,
+           [],
+           []}],
+    run(Config, Ts).
+
 run(Config, Tests) ->
     F = fun({N,P,Ws,E}, BadL) ->
                 case catch run_test(Config, P, Ws) of
diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl
index 13c5662741..31ea3210a8 100644
--- a/lib/stdlib/test/erl_pp_SUITE.erl
+++ b/lib/stdlib/test/erl_pp_SUITE.erl
@@ -825,12 +825,13 @@ type_examples() ->
      %% is_subtype(V, T) syntax, we need a few examples of the syntax.
      {ex31,<<"-spec t1(FooBar :: t99()) -> t99();"
 	     "(t2()) -> t2();"
-	     "('\\'t::4'()) -> '\\'t::4'() when is_subtype('\\'t::4'(), t24);"
-	     "(t23()) -> t23() when is_subtype(t23(), atom()),"
-	     "                      is_subtype(t23(), t14());"
-	     "(t24()) -> t24() when is_subtype(t24(), atom()),"
-	     "                      is_subtype(t24(), t14()),"
-	     "                      is_subtype(t24(), '\\'t::4'()).">>},
+	     "('\\'t::4'()) -> {'\\'t::4'(), B}"
+             "             when is_subtype(B, '\\'t::4'());"
+	     "(t23()) -> C when is_subtype(C, atom()),"
+	     "                      is_subtype(C, t14());"
+	     "(t24()) -> D when is_subtype(D, atom()),"
+	     "                      is_subtype(D, t14()),"
+	     "                      is_subtype(D, '\\'t::4'()).">>},
      {ex32,<<"-spec mod:t2() -> any(). ">>},
      {ex33,<<"-opaque attributes_data() :: "
        "[{'column', column()} | {'line', info_line()} |"