[stdlib] Fix pretty printing of invalid forms

Thanks to Tomáš Janoušek.

2 files changed, 58 insertions, 18 deletions

diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl
index 7c7566e4ec..c0596e5ba6 100644
--- a/lib/stdlib/src/erl_pp.erl
+++ b/lib/stdlib/src/erl_pp.erl
@@ -35,7 +35,7 @@
                        | fun((Expr :: erl_parse:abstract_expr(),
                               CurrentIndentation :: integer(),
                               CurrentPrecedence :: non_neg_integer(),
-                              HookFunction :: hook_function()) ->
+                              Options :: options()) ->
                                    io_lib:chars())).
 
 -type(option() :: {hook, hook_function()}
@@ -225,7 +225,7 @@ lattribute(module, {M,Vs}, _Opts, _State) ->
 lattribute(module, M, _Opts, _State) ->
     attr("module", [{var,0,pname(M)}]);
 lattribute(export, Falist, _Opts, _State) ->
-    call({var,0,"-export"}, [falist(Falist)], 0, none);
+    call({var,0,"-export"}, [falist(Falist)], 0, options(none));
 lattribute(import, Name, _Opts, _State) when is_list(Name) ->
     attr("import", [{var,0,pname(Name)}]);
 lattribute(import, {From,Falist}, _Opts, _State) ->
@@ -240,10 +240,10 @@ lattribute(Name, Arg, #options{encoding = Encoding}, _State) ->
 
 typeattr(Tag, {TypeName,Type,Args}, _Opts) ->
     {first,leaf("-"++atom_to_list(Tag)++" "),
-     typed(call({atom,0,TypeName}, Args, 0, none), Type)}.
+     typed(call({atom,0,TypeName}, Args, 0, options(none)), Type)}.
 
 ltype({ann_type,_Line,[V,T]}) ->
-    typed(lexpr(V, none), T);
+    typed(lexpr(V, options(none)), T);
 ltype({paren_type,_Line,[T]}) ->
     [$(,ltype(T),$)];
 ltype({type,_Line,union,Ts}) ->
@@ -253,7 +253,7 @@ ltype({type,_Line,list,[T]}) ->
 ltype({type,_Line,nonempty_list,[T]}) ->
     {seq,$[,$],[$,],[ltype(T),leaf("...")]};
 ltype({type,Line,nil,[]}) ->
-    lexpr({nil,Line}, 0, none);
+    lexpr({nil,Line}, 0, options(none));
 ltype({type,Line,tuple,any}) ->
     simple_type({atom,Line,tuple}, []);
 ltype({type,_Line,tuple,Ts}) ->
@@ -261,7 +261,7 @@ ltype({type,_Line,tuple,Ts}) ->
 ltype({type,_Line,record,[{atom,_,N}|Fs]}) ->
     record_type(N, Fs);
 ltype({type,_Line,range,[_I1,_I2]=Es}) ->
-    expr_list(Es, '..', fun lexpr/2, none);
+    expr_list(Es, '..', fun lexpr/2, options(none));
 ltype({type,_Line,binary,[I1,I2]}) ->
     binary_type(I1, I2); % except binary()
 ltype({type,_Line,'fun',[]}) ->
@@ -277,14 +277,14 @@ ltype({remote_type,Line,[M,F,Ts]}) ->
 ltype({atom,_,T}) ->
     leaf(write(T));
 ltype(E) ->
-    lexpr(E, 0, none).
+    lexpr(E, 0, options(none)).
 
 binary_type(I1, I2) ->
     B = [[] || {integer,_,0} <- [I1]] =:= [],
     U = [[] || {integer,_,0} <- [I2]] =:= [],
     P = max_prec(),
-    E1 = [[leaf("_:"),lexpr(I1, P, none)] || B],
-    E2 = [[leaf("_:_*"),lexpr(I2, P, none)] || U],
+    E1 = [[leaf("_:"),lexpr(I1, P, options(none))] || B],
+    E2 = [[leaf("_:_*"),lexpr(I2, P, options(none))] || U],
     {seq,'<<','>>',[$,],E1++E2}.
 
 record_type(Name, Fields) ->
@@ -294,7 +294,7 @@ field_types(Fs) ->
     tuple_type(Fs, fun field_type/1).
 
 field_type({type,_Line,field_type,[Name,Type]}) ->
-    typed(lexpr(Name, none), Type).
+    typed(lexpr(Name, options(none)), Type).
 
 typed(B, {type,_,union,Ts}) ->
     %% Special layout for :: followed by union.
@@ -330,7 +330,8 @@ sig_type(FunType) ->
     fun_type([], FunType).
 
 guard_type(Before, Gs) ->
-    Gl = {list,[{step,'when',expr_list(Gs, [$,], fun constraint/2, none)}]},
+    Opts = options(none),
+    Gl = {list,[{step,'when',expr_list(Gs, [$,], fun constraint/2, Opts)}]},
     {list,[{step,Before,Gl}]}.
 
 constraint({type,_Line,constraint,[Tag,As]}, _Opts) ->
@@ -345,7 +346,7 @@ type_args({type,_line,product,Ts}) ->
     targs(Ts).
 
 simple_type(Tag, Types) ->
-    {first,lexpr(Tag, 0, none),targs(Types)}.
+    {first,lexpr(Tag, 0, options(none)),targs(Types)}.
 
 targs(Ts) ->
     {seq,$(,$),[$,],ltypes(Ts)}.
@@ -357,7 +358,7 @@ ltypes(Ts, F) ->
     [F(T) || T <- Ts].
 
 attr(Name, Args) ->
-    call({var,0,format("-~s", [Name])}, Args, 0, none).
+    call({var,0,format("-~s", [Name])}, Args, 0, options(none)).
 
 pname(['' | As]) ->
     [$. | pname(As)];
@@ -632,11 +633,11 @@ bit_elem_types([T | Rest]) ->
     [bit_elem_type(T), $-|bit_elem_types(Rest)].
 
 bit_elem_type({A,B}) ->
-    [lexpr(erl_parse:abstract(A), none),
+    [lexpr(erl_parse:abstract(A), options(none)),
      $:,
-     lexpr(erl_parse:abstract(B), none)];
+     lexpr(erl_parse:abstract(B), options(none))];
 bit_elem_type(T) ->
-    lexpr(erl_parse:abstract(T), none).
+    lexpr(erl_parse:abstract(T), options(none)).
 
 %% end of BITS
 
diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl
index 9c0a43abcc..ff3470349e 100644
--- a/lib/stdlib/test/erl_pp_SUITE.erl
+++ b/lib/stdlib/test/erl_pp_SUITE.erl
@@ -49,7 +49,7 @@
 
 	  otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1,
 	  otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1,
-          otp_10302/1, otp_10820/1]).
+          otp_10302/1, otp_10820/1, otp_11100/1]).
 
 %% Internal export.
 -export([ehook/6]).
@@ -81,7 +81,7 @@ groups() ->
      {tickets, [],
       [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238,
        otp_8473, otp_8522, otp_8567, otp_8664, otp_9147,
-       otp_10302, otp_10820]}].
+       otp_10302, otp_10820, otp_11100]}].
 
 init_per_suite(Config) ->
     Config.
@@ -1103,6 +1103,45 @@ file_attr_is_string("-file(\"" ++ _) -> true;
 file_attr_is_string([_ | L]) ->
     file_attr_is_string(L).
 
+otp_11100(doc) ->
+    "OTP-11100. Fix printing of invalid forms.";
+otp_11100(suite) -> [];
+otp_11100(Config) when is_list(Config) ->
+    %% There are a few places where the added code ("options(none)")
+    %% doesn't make a difference (pp:bit_elem_type/1 is an example).
+
+    %% Cannot trigger the use of the hook function with export/import.
+    "-export([{fy,a}/b]).\n" =
+        pf({attribute,1,export,[{{fy,a},b}]}),
+    "-type foo() :: integer(INVALID-FORM:{foo,bar}:).\n" =
+        pf({attribute,1,type,{foo,{type,1,integer,[{foo,bar}]},[]}}),
+    pf({attribute,1,type,
+        {a,{type,1,range,[{integer,1,1},{foo,bar}]},[]}}),
+    "-type foo(INVALID-FORM:{foo,bar}:) :: A.\n" =
+        pf({attribute,1,type,{foo,{var,1,'A'},[{foo,bar}]}}),
+    "-type foo() :: (INVALID-FORM:{foo,bar}: :: []).\n" =
+        pf({attribute,1,type,
+            {foo,{paren_type,1,
+                  [{ann_type,1,[{foo,bar},{type,1,nil,[]}]}]},
+             []}}),
+    "-type foo() :: <<_:INVALID-FORM:{foo,bar}:>>.\n" =
+        pf({attribute,1,type,
+            {foo,{type,1,binary,[{foo,bar},{integer,1,0}]},[]}}),
+    "-type foo() :: <<_:10, _:_*INVALID-FORM:{foo,bar}:>>.\n" =
+        pf({attribute,1,type,
+            {foo,{type,1,binary,[{integer,1,10},{foo,bar}]},[]}}),
+    "-type foo() :: #r{INVALID-FORM:{foo,bar}: :: integer()}.\n" =
+        pf({attribute,1,type,
+            {foo,{type,1,record,
+                  [{atom,1,r},
+                   {type,1,field_type,
+                    [{foo,bar},{type,1,integer,[]}]}]},
+             []}}),
+    ok.
+
+pf(Form) ->
+    lists:flatten(erl_pp:form(Form,none)).
+
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 compile(Config, Tests) ->