diff options
Diffstat (limited to 'lib/stdlib/test/erl_pp_SUITE.erl')
-rw-r--r-- | lib/stdlib/test/erl_pp_SUITE.erl | 1073 |
1 files changed, 1073 insertions, 0 deletions
diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl new file mode 100644 index 0000000000..0a119d1e38 --- /dev/null +++ b/lib/stdlib/test/erl_pp_SUITE.erl @@ -0,0 +1,1073 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% +%%%---------------------------------------------------------------- +%%% Purpose:Test Suite for the 'erl_pp' module. +%%%----------------------------------------------------------------- +-module(erl_pp_SUITE). + +%-define(debug, true). + +-ifdef(debug). +-define(line, put(line, ?LINE), ). +-define(config(X,Y), foo). +-define(datadir, "erl_pp_SUITE_data"). +-define(privdir, "erl_pp_SUITE_priv"). +-define(t, test_server). +-else. +-include("test_server.hrl"). +-define(datadir, ?config(data_dir, Config)). +-define(privdir, ?config(priv_dir, Config)). +-endif. + +-export([all/1, init_per_testcase/2, fin_per_testcase/2]). + +-export([expr/1, func/1, call/1, recs/1, try_catch/1, if_then/1, + receive_after/1, bits/1, head_tail/1, package/1, + cond1/1, block/1, case1/1, ops/1, messages/1, + old_mnemosyne_syntax/1, + attributes/1, import_export/1, misc_attrs/1, + hook/1, + neg_indent/1, + tickets/1, + otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1]). + +%% Internal export. +-export([ehook/6]). + +% Default timetrap timeout (set in init_per_testcase). +-define(default_timeout, ?t:minutes(2)). + +init_per_testcase(_Case, Config) -> + ?line Dog = ?t:timetrap(?default_timeout), + [{watchdog, Dog} | Config]. + +fin_per_testcase(_Case, _Config) -> + Dog = ?config(watchdog, _Config), + test_server:timetrap_cancel(Dog), + ok. + +all(suite) -> + [expr, attributes, hook, neg_indent, tickets]. + +expr(suite) -> + [func, call, recs, try_catch, if_then, receive_after, bits, head_tail, + package, cond1, block, case1, ops, messages, old_mnemosyne_syntax]. + +func(suite) -> + []; +func(Config) when is_list(Config) -> + Ts = [{func_1, + <<"-record(r1, {a,b}). + -record(r3, {a = fun(_) -> #r1{} end(1), b}). + + t() -> + fun(A) when record(A#r3.a, r1) -> 7 end(#r3{}). + ">>}, + {func_2, + <<"-record(r1, {a,b}). + -record(r3, {a = fun(_) -> #r1{} end(1), b}). + + t() -> + fsdfsdfjsdfjkljf:sdlfjdsfjlf( + fun(sdfsd) -> {sdkjsdf,sdfjsdkljfsdl,sdfkjdklf} end). + ">>}, + {func_3, + <<"t() -> fun t/0.">>}, + {func_4, + %% Has already been expanded away in sys_pre_expand. + <<"t() -> fun modul:foo/3.">>}, + {func_5, % 'when' is moved down one line + <<"tkjlksjflksdjflsdjlk() + when kljlsajflksjdfklsjdlkjfklsdklfjsdlf < + kljasjfdsjflsdjfklsdjfklsdjfklsd -> + foo.">>}, + {func_6, + <<"t() -> + (fun() -> + true + end)().">>} + ], + ?line compile(Config, Ts), + ok. + +call(suite) -> + []; +call(Config) when is_list(Config) -> + Ts = [{call_1, + <<"t() -> + fookjljsflj:barlkjlkjsdfj(kjdslfjsdl,hej,san,sa, + foo,sdfds,sdfsdf,sdfsd,sdfdsf,sdfdsf,sfdsf, + sfds,sdfsdf,sfds). + ">>} + ], + ?line compile(Config, Ts), + ok. + +recs(suite) -> + []; +recs(Config) when is_list(Config) -> + %% Evolved while testing strict record tests in guards... + Ts = [{recs_1, + <<"-compile(strict_record_tests). + -record(r, {a = 4,b}). + -record(r1, {a,b}). + -record(r2, {a = #r1{},b,c=length([1,2,3])}). + -record(r3, {a = fun(_) -> #r1{} end(1), b}). + + t() -> + foo = fun(A) when A#r1.a > A#r1.b -> foo end(#r1{b = 2}), + 0 = fun(A) when A#r2.a -> 0 end(#r2{a = true}), + 1 = fun(A) when (#r1{a = A})#r1.a > 2 -> 1 end(3), + 2 = fun(N) when ((#r2{a = #r{a = 4}, b = length([a,b,c])})#r2.a)#r.a > N -> + 2 end(2), + 3 = fun(A) when (A#r2.a)#r1.a =:= 3 -> 3 end(#r2{a = #r1{a = 3}}), + ok = fun() -> + F = fun(A) when record(A#r.a, r1) -> 4; + (A) when record(A#r1.a, r1) -> 5 + end, + 5 = F(#r1{a = #r1{}}), + 4 = F(#r{a = #r1{}}), + ok + end(), + 3 = fun(A) when record(A#r1.a, r), + (A#r1.a)#r.a > 3 -> 3 + end(#r1{a = #r{a = 4}}), + 7 = fun(A) when record(A#r3.a, r1) -> 7 end(#r3{}), + [#r1{a = 2,b = 1}] = + fun() -> + [A || A <- [#r1{a = 1, b = 3}, + #r2{a = 2,b = 1}, + #r1{a = 2, b = 1}], + A#r1.a > + A#r1.b] + end(), + {[_],b} = + fun(L) -> + %% A is checked only once: + R1 = [{A,B} || A <- L, A#r1.a, B <- L, A#r1.b], + A = #r2{a = true}, + %% A is checked again: + B = if A#r1.a -> a; true -> b end, + {R1,B} + end([#r1{a = true, b = true}]), + + p = fun(A) when (A#r1.a =:= 2) or (A#r2.a =:= 1) -> o; + (_) -> p + end(#r1{a = 2}), + + o = fun(A) when (A#r1.a =:= 2) orelse (A#r2.a =:= 1) -> o; + (_) -> p + end(#r1{a = 2}), + + %% The test done twice (an effect of doing the test as soon as possible). + 3 = fun(A) when A#r1.a > 3, + record(A, r1) -> 3 + end(#r1{a = 5}), + + ok = fun() -> + F = fun(A) when (A#r2.a =:= 1) orelse (A#r2.a) -> 2; + (A) when (A#r1.a =:= 1) orelse (A#r1.a) -> 1; + (A) when (A#r2.a =:= 2) andalso (A#r2.b) -> 3 + end, + 1 = F(#r1{a = 1}), + 2 = F(#r2{a = true}), + 3 = F(#r2{a = 2, b = true}), + ok + end(), + + b = fun(A) when false or not (A#r.a =:= 1) -> a; + (_) -> b + end(#r1{a = 1}), + b = fun(A) when not (A#r.a =:= 1) or false -> a; + (_) -> b + end(#r1{a = 1}), + + ok = fun() -> + F = fun(A) when not (A#r.a =:= 1) -> yes; + (_) -> no + end, + no = F(#r1{a = 2}), + yes = F(#r{a = 2}), + no = F(#r{a = 1}), + ok + end(), + + %% No extra check added: + a = fun(A) when record(A, r), + A#r.a =:= 1, + A#r.b =:= 2 ->a + end(#r{a = 1, b = 2}), + a = fun(A) when erlang:is_record(A, r), + A#r.a =:= 1, + A#r.b =:= 2 -> a + end(#r{a = 1, b = 2}), + a = fun(A) when is_record(A, r), + A#r.a =:= 1, + A#r.b =:= 2 -> a + end(#r{a = 1, b = 2}), + + nop = fun(A) when (is_record(A, r1) and (A#r1.a > 3)) or (A#r2.a < 1) -> + japp; + (_) -> + nop + end(#r2{a = 0}), + nop = fun(A) when (A#r1.a > 3) or (A#r2.a < 1) -> japp; + (_) -> + nop + end(#r2{a = 0}), + + ok = fun() -> + F = fun(A) when (A#r1.a =:= 2) or (A#r2.a =:= 1) -> o; + (_) -> p + end, + p = F(#r2{a = 1}), + p = F(#r1{a = 2}), + ok + end(), + + ok = fun() -> + F = fun(A) when fail, A#r1.a; A#r1.a -> ab; + (_) -> bu + end, + ab = F(#r1{a = true}), + bu = F(#r2{a = true}), + ok + end(), + + both = fun(A) when A#r.a, A#r.b -> both + end(#r{a = true, b = true}), + + ok = fun() -> + F = fun(A, B) when ((A#r1.a) orelse (B#r2.a)) + or (B#r2.b) or (A#r1.b) -> + true; + (_, _) -> false + end, + true = F(#r1{a = false, b = false}, + #r2{a = false, b = true}), + false = F(#r1{a = true, b = true}, + #r1{a = false, b = true}), + ok + end(), + + ok. + ">>}, + {recs_2, + <<"-record(r1, {a, b = foo:bar(kljlfjsdlf, kjlksdjf)}). + -record(r2, {c = #r1{}, d = #r1{a = bar:foo(kljklsjdf)}}). + + t() -> + R = #r2{}, + R#r2{c = R, d = #r1{}}.">>} + ], + ?line compile(Config, Ts), + + ?line ok = pp_expr(<<"case #r{a={1,2},b=#r{}} of + X=Y=#r{a=foo,b=bar} -> + {(foooo:baaaar(X))#r{a = rep},Y,#r.b} + end">>), + ?line ok = pp_expr(<<"R#r{a = {kljasdklf,sdkfjsdl,sdafjkllsdf,sdfkjsd, + sdafjsd,sdf,sdafsd,sdfdsf,sdfdsf,dsfds}}">>), + ok. + +try_catch(suite) -> + []; +try_catch(Config) when is_list(Config) -> + Ts = [{try_1, % copied from erl_eval_SUITE + <<"t() -> try 1 of 1 -> 2 catch _:_ -> 3 end.">>}, + {try_2, + <<"t() -> try 1 of 1 -> 2; 3 -> 4 catch _:_ -> 5 end.">>}, + {try_3, + <<"t() -> try 3 of 1 -> 2; 3 -> 4 catch _:_ -> 5 end.">>}, + {try_4, + <<"t() -> try 1 after put(try_catch, 2) end.">>}, + {try_5, + <<"t() -> try 1 of 1 -> 2; 3 -> 4 + after put(try_catch, 5) end.">>}, + {try_6, + <<"t() -> try 1=2 catch throw:{badmatch,2} -> 3 end.">>}, + {try_7, + <<"t() -> try 1=2 of 3 -> 4 + catch error:{badmatch,2} -> 5 end.">>}, + {try_8, + <<"t() -> try 1=2 + catch error:{badmatch,2} -> 3 + after put(try_catch, 4) end.">>}, + {try_9, + <<"t() -> try 1=2 + catch error:{badmatch,2} -> 3 + after put(try_catch, 4) end.">>}, + {try_10, + <<"t() -> try a,b,c + catch exit:_ -> d; + throw:_ -> t; + error:{foo,bar} -> foo, + bar + end.">>}, + + {catch_1, + <<"t() -> catch foo.">>}, + {catch_2, + <<"t() -> case catch foo of bar -> foo end.">>}, + {catch_3, + <<"t() -> catch begin begin foo, bar, foo:bar(kljsldkfjdls,kljsdl), + (catch bar:foo(foo)) end end.">>} + ], + ?line compile(Config, Ts), + ?line ok = pp_expr(<<"try + erl_internal:bif(M,F,length(Args)) + of + true -> + call(N,Args,Prec,Hook); + false -> + call(Name,Args,Prec,Hook) + after foo end">>), + ok. + +if_then(suite) -> + []; +if_then(Config) when is_list(Config) -> + Ts = [{if_1, + <<"t() -> if 1 > 2 -> 1; true -> b end.">>}, + {if_2, + <<"t() -> if true -> true end.">>}, + {if_3, + <<"t() -> if 1 == 2 -> a; 1 > 2 -> b; 1 < 2 -> c end.">>} + ], + ?line compile(Config, Ts), + ok. + +receive_after(suite) -> + []; +receive_after(Config) when is_list(Config) -> + Ts = [{rec_1, + <<"t() -> receive foo -> bar; bar -> foo end.">>}, + {rec_2, + <<"t() -> receive foo -> bar after foo:bar() -> 0 end.">>}, + {rec_3, + <<"t() -> receive after 1 -> ok end.">>}, + {rec_4, + <<"t() -> receive {X,Y} -> {a,X,Y} end.">>}, + {rec_5, + <<"t() -> receive + {X,Y} -> + {X,Y}; + Z -> + Z + after + foo:bar() -> + {3,4} + end.">>} + ], + ?line compile(Config, Ts), + ok. + +bits(suite) -> + []; +bits(Config) when is_list(Config) -> + Ts = [{bit_1, % copied from shell_SUITE + <<"t() -> <<(<<\"abc\">>):3/binary>>.">>}, + {bit_2, + <<"t() -> <<(<<\"abc\">>)/binary>>.">>}, + {bit_3, + <<"t() -> <<3.14:64/float>>.">>}, + {bit_4, + <<"t() -> <<-20/signed>> = <<-20>>.">>}, + {bit_5, + <<"t() -> <<-300:16/signed>> = <<-300:16>>.">>}, + {bit_6, + <<"t() -> <<-(1 bsl 29):32/signed>> = <<-(1 bsl 29):32>>.">>}, + {bit_7, + <<"t() -> <<A:4,B:4,C:4,D:4,E:4,F:4>> = <<\"hej\">>.">>}, + {bit_8, + <<"t() -> <<>>.">>}, + {bit_9, + <<"">>} + ], + ?line compile(Config, Ts), + ?line ok = pp_expr(<<"<<(list_to_binary([1,2]))/binary>>">>), + ?line ok = pp_expr( + <<"<<(list_to_binary([1,2])):all/binary-unit:8-unsigned-big>>">>), + ?line ok = pp_expr(<<"<<<<\"hej\">>/binary>>">>), + ?line ok = pp_expr(<<"<<(foo:bar())/binary>>">>), + ?line ok = pp_expr(<<"<<(a)/binary>>">>), + ?line ok = pp_expr(<<"<<a/binary>>">>), + ?line ok = pp_expr(<<"<<{a,b}/binary>>">>), + ?line ok = pp_expr(<<"<<{foo:bar(),b}/binary>>">>), + ?line ok = pp_expr(<<"<<(foo:bar()):(foo:bar())/binary>>">>), + ?line ok = pp_expr(<<"<<(foo.bar)/binary>>">>), + ?line ok = pp_expr(<<"<<(foo.bar):all/binary>>">>), + ?line ok = pp_expr(<<"<<(foo.bar):(foo.bar)/binary>>">>), + ok. + +head_tail(suite) -> + []; +head_tail(Config) when is_list(Config) -> + Ts = [{list_1, + <<"t() -> [a | b].">>}, + {list_2, + <<"t() -> [a,b,$\n].">>}, + {list_3, + <<"t() -> [].">>}, + {list_4, + <<"t() -> [a].">>}, + {list_5, + <<"t() -> + [foo:bar(lkjljlskdfj, klsdajflds, sdafkljsdlfkjdas, kjlsdadjl), + bar:foo(kljlkjsdf, lkjsdlfj, [kljsfj, sdfdsfsad])].">>} + ], + ?line compile(Config, Ts), + ok. + +package(suite) -> + []; +package(Config) when is_list(Config) -> + Ts = [{package_1, + <<"t() -> a.b:foo().">>}, + {package_2, + <<"t() -> .lists:sort([]).">>} + ], + ?line compile(Config, Ts), + ok. + +cond1(suite) -> + []; +cond1(Config) when is_list(Config) -> + C = {'cond',1,[{clause,2,[],[[{tuple,2,[{atom,2,foo},{atom,2,bar}]}]], + [{cons,3,{atom,3,a},{cons,3,{atom,3,b},{nil,3}}}]}, + {clause,4,[],[[{atom,4,true}]], + [{tuple,5,[{atom,5,x},{atom,5,y}]}]}]}, + ?line CChars = lists:flatten(erl_pp:expr(C)), +% ?line "cond {foo,bar} -> [a,b]; true -> {x,y} end" = CChars, + ?line "cond\n" + " {foo,bar} ->\n" + " [a,b];\n" + " true ->\n" + " {x,y}\n" + "end" = CChars, +% ?line ok = pp_expr(<<"cond +% {foo,bar} -> +% [a,b]; +% true -> +% {x,y} +% end">>), + ok. + +block(suite) -> + []; +block(Config) when is_list(Config) -> + Ts = [{block_1, + <<"t() -> begin a,{c,d} end.">>} + ], + ?line compile(Config, Ts), + ok. + +case1(suite) -> + []; +case1(Config) when is_list(Config) -> + Ts = [{case_1, + <<"t() -> case {foo,bar} of + {A,B} when true -> + [A,B]; + _ -> + foo + end.">>} + ], + ?line compile(Config, Ts), + ?line ok = pp_expr(<<"case + erl_internal:bif(M,F,length(Args)) + of + true -> + call(N,Args,Prec,Hook); + false -> + call(Name,Args,Prec,Hook) + end">>), + ok. + +ops(suite) -> + []; +ops(Config) when is_list(Config) -> + Ts = [{ops_1, + <<"t() -> {a,b} + (3 - 2) + 4.">>}, + {ops_2, + <<"t() -> a - (3 + 4).">>}, + {ops_3, + <<"t() -> - (- (- (- (- 3)))).">>} + ], + ?line compile(Config, Ts), + ok. + +messages(suite) -> + []; +messages(Config) when is_list(Config) -> + ?line true = "{error,{some,\"error\"}}\n" =:= + lists:flatten(erl_pp:form({error,{some,"error"}})), + ?line true = "{warning,{some,\"warning\"}}\n" =:= + lists:flatten(erl_pp:form({warning,{some,"warning"}})), + ?line true = "\n" =:= lists:flatten(erl_pp:form({eof,0})), + ok. + +old_mnemosyne_syntax(suite) -> + []; +old_mnemosyne_syntax(Config) when is_list(Config) -> + %% Since we have kept the 'query' syntax and ':-' token, + %% better test that we can pretty print it. + Q = {'query',6, + {lc,6, + {var,6,'X'}, + [{generate,6, + {var,6,'X'}, + {call,6,{atom,6,table},[{atom,6,tab}]}}, + {match,7, + {record_field,7,{var,7,'X'},{atom,7,foo}}, + {atom,7,bar}}]}}, + ?line "query\n" + " [ \n" % extra space... + " X ||\n" + " X <- table(tab),\n" + " X.foo = bar\n" + " ]\n" + "end" = + lists:flatten(erl_pp:expr(Q)), + + R = {rule,12,sales,2, + [{clause,12, + [{var,12,'E'},{atom,12,employee}], + [], + [{generate,13, + {var,13,'E'}, + {call,13,{atom,13,table},[{atom,13,employee}]}}, + {match,14, + {record_field,14,{var,14,'E'},{atom,14,salary}}, + {atom,14,sales}}]}]}, + ?line "sales(E, employee) :-\n" + " E <- table(employee),\n" + " E.salary = sales.\n" = + lists:flatten(erl_pp:form(R)), + ok. + + +attributes(suite) -> + [misc_attrs, import_export]. + +import_export(suite) -> + []; +import_export(Config) when is_list(Config) -> + Ts = [{import_1, + <<"-import(lists, [max/1, reverse/1]). + -import(sofs, []). + t(L) -> + max(reverse(L)).">>}, + {export_1, + <<"-export([t/0]). + -export([]). + t() -> [].">>}, + {qlc_1, + <<"-include_lib(\"stdlib/include/qlc.hrl\"). + t() -> qlc:q([X || X <- []]).">>} + ], + ?line compile(Config, Ts), + ok. + +misc_attrs(suite) -> + []; +misc_attrs(Config) when is_list(Config) -> + ?line ok = pp_forms(<<"-module(m). ">>), + ?line ok = pp_forms(<<"-module(m.p, [A,B]). ">>), + ?line ok = pp_forms(<<"-module(m, [Aafjlksfjdlsjflsdfjlsdjflkdsfjlk," + "Blsjfdlslfjsdf]). ">>), + ?line ok = pp_forms(<<"-export([]). ">>), + ?line ok = pp_forms(<<"-export([foo/2, bar/0]). ">>), + ?line ok = pp_forms(<<"-export([bar/0]). ">>), + ?line ok = pp_forms(<<"-import(.lists). ">>), + ?line ok = pp_forms(<<"-import(lists, []). ">>), + ?line ok = pp_forms(<<"-import(lists, [map/2]). ">>), + ?line ok = pp_forms(<<"-import(lists, [map/2, foreach/2]). ">>), + ?line ok = pp_forms(<<"-'wild '({attr2,3}). ">>), + ?line ok = pp_forms(<<"-record(a, {b,c}). ">>), + ?line ok = pp_forms(<<"-record(' a ', {}). ">>), + ?line ok = pp_forms(<<"-record(' a ', {foo = foo:bar()}). ">>), + + ok. + +hook(suite) -> + []; +hook(Config) when is_list(Config) -> + Lc = parse_expr(binary_to_list(<<"[X || X <- [1,2,3]].">>)), + H = fun hook/4, + Expr = {call,0,{atom,0,fff},[{foo,Lc},{foo,Lc},{foo,Lc}]}, + EChars = lists:flatten(erl_pp:expr(Expr, 0, H)), + Call = {call,0,{atom,0,foo},[Lc]}, + Expr2 = {call,0,{atom,0,fff},[Call,Call,Call]}, + EChars2 = erl_pp:exprs([Expr2]), + ?line true = EChars =:= lists:flatten(EChars2), + + EsChars = erl_pp:exprs([Expr], H), + ?line true = EChars =:= lists:flatten(EsChars), + + F = {function,1,ffff,0,[{clause,1,[],[],[Expr]}]}, + FuncChars = lists:flatten(erl_pp:function(F, H)), + F2 = {function,1,ffff,0,[{clause,1,[],[],[Expr2]}]}, + FuncChars2 = erl_pp:function(F2), + ?line true = FuncChars =:= lists:flatten(FuncChars2), + FFormChars = erl_pp:form(F, H), + ?line true = FuncChars =:= lists:flatten(FFormChars), + + A = {attribute,1,record,{r,[{record_field,1,{atom,1,a},Expr}]}}, + AChars = lists:flatten(erl_pp:attribute(A, H)), + A2 = {attribute,1,record,{r,[{record_field,1,{atom,1,a},Expr2}]}}, + AChars2 = erl_pp:attribute(A2), + ?line true = AChars =:= lists:flatten(AChars2), + AFormChars = erl_pp:form(A, H), + ?line true = AChars =:= lists:flatten(AFormChars), + + R = {rule,0,sales,0, + [{clause,0,[{var,0,'E'},{atom,0,employee}],[], + [{generate,2,{var,2,'E'}, + {call,2,{atom,2,table},[{atom,2,employee}]}}, + {match,3, + {record_field,3,{var,3,'E'},{atom,3,salary}}, + {foo,Expr}}]}]}, + RChars = lists:flatten(erl_pp:rule(R, H)), + R2 = {rule,0,sales,0, + [{clause,0,[{var,0,'E'},{atom,0,employee}],[], + [{generate,2,{var,2,'E'}, + {call,2,{atom,2,table},[{atom,2,employee}]}}, + {match,3, + {record_field,3,{var,3,'E'},{atom,3,salary}}, + {call,0,{atom,0,foo},[Expr2]}}]}]}, + RChars2 = erl_pp:rule(R2), + ?line true = RChars =:= lists:flatten(RChars2), + ARChars = erl_pp:form(R, H), + ?line true = RChars =:= lists:flatten(ARChars), + + ?line "INVALID-FORM:{foo,bar}:" = lists:flatten(erl_pp:expr({foo,bar})), + + %% A list (as before R6), not a list of lists. + G = [{op,1,'>',{atom,1,a},{foo,{atom,1,b}}}], % not a proper guard + GChars = lists:flatten(erl_pp:guard(G, H)), + G2 = [{op,1,'>',{atom,1,a}, + {call,0,{atom,0,foo},[{atom,1,b}]}}], % not a proper guard + GChars2 = erl_pp:guard(G2), + ?line true = GChars =:= lists:flatten(GChars2), + + EH = {?MODULE, ehook, [foo,bar]}, + XEChars = erl_pp:expr(Expr, -1, EH), + ?line true = remove_indentation(EChars) =:= lists:flatten(XEChars), + XEChars2 = erl_pp:expr(Expr, EH), + ?line true = EChars =:= lists:flatten(XEChars2), + + %% Note: no leading spaces before "begin". + Block = {block,0,[{match,0,{var,0,'A'},{integer,0,3}}, + {atom,0,true}]}, + ?line "begin\n A =" ++ _ = + lists:flatten(erl_pp:expr(Block, 17, none)), + + %% Special... + ?line true = + "{some,value}" =:= lists:flatten(erl_pp:expr({value,0,{some,value}})), + + %% Silly... + ?line true = + "if true -> 0 end" =:= + flat_expr({'if',0,[{clause,0,[],[],[{atom,0,0}]}]}), + + %% More compatibility: before R6 + OldIf = {'if',0,[{clause,0,[],[{atom,0,true}],[{atom,0,b}]}]}, + NewIf = {'if',0,[{clause,0,[],[[{atom,0,true}]],[{atom,0,b}]}]}, + OldIfChars = lists:flatten(erl_pp:expr(OldIf)), + NewIfChars = lists:flatten(erl_pp:expr(NewIf)), + ?line true = OldIfChars =:= NewIfChars, + + ok. + +remove_indentation(S) -> + %% T is for the very special leaf(" ") used for lc and bc. + T = re:replace(S, " \n *", "", [{return,list},global]), + re:replace(T, "\n *", " ", [{return,list},global]). + +ehook(HE, I, P, H, foo, bar) -> + hook(HE, I, P, H). + +hook({foo,E}, I, P, H) -> + erl_pp:expr({call,0,{atom,0,foo},[E]}, I, P, H). + +neg_indent(suite) -> + []; +neg_indent(Config) when is_list(Config) -> + ?line ok = pp_expr(<<"begin a end">>), + ?line ok = pp_expr(<<"begin a,b end">>), + ?line ok = pp_expr(<<"try a,b,c + catch exit:_ -> d; + throw:_ -> t; + error:{foo,bar} -> foo, + bar + end">>), + ?line ok = pp_expr( + <<"fun() -> + F = fun(A, B) when ((A#r1.a) orelse (B#r2.a)) + or (B#r2.b) or (A#r1.b) -> + true; + (_, _) -> false + end, + true = F(#r1{a = false, b = false}, + #r2{a = false, b = true}), + false = F(#r1{a = true, b = true}, + #r1{a = false, b = true}), + ok + end()">>), + + ?line ok = pp_expr(<<"[X || X <- a, true]">>), + ?line ok = pp_expr(<<"{[a,b,c],[d,e|f]}">>), + ?line ok = pp_expr(<<"f(a,b,c)">>), + ?line ok = pp_expr(<<"fun() when a,b;c,d -> a end">>), + ?line ok = pp_expr(<<"<<34:32,17:32>>">>), + ?line ok = pp_expr(<<"if a,b,c -> d; e,f,g -> h,i end">>), + ?line ok = pp_expr(<<"if a -> d; c -> d end">>), + ?line ok = pp_expr(<<"receive after 1 -> 2 end">>), + ?line ok = pp_expr(<<"begin a,b,c end">>), + + ?line "\"\"" = flat_expr({string,0,""}), + ?line ok = pp_expr(<<"\"abc\"">>), + ?line ok = pp_expr(<<"\"abc\n\n\n\n\nkjsd\n\n\n\n\nkljsddf\n\n\n\n\n" + "klafd\n\n\n\n\nkljsdf\n\n\n\n\nsdf\n\n\n\n\n\"">>), + ?line ok = pp_expr(<<"fkjlskljklkkljlkjlkjkljlkjsljklf" + "lsdjlfdsjlfjsdlfjdslfjdlsjfsdjfklsdkfjsdf(" + "\"abc\n\n\n\n\nkjsd\n\n\n\n\nkljsddf\n\n\n\n\n" + "kljsafd\n\n\n\n\nkljsdf\n\n\n\n\nkjsdf" + "\n\n\n\n\n\")">>), + + %% fun-info is skipped when everything is to fit on one single line + Fun1 = {'fun',1,{function,t,0},{0,45353021,'-t/0-fun-0-'}}, + ?line "fun t/0" = flat_expr(Fun1), + Fun2 = {'fun',2,{clauses,[{clause,2,[],[],[{atom,3,true}]}]}, + {0,108059557,'-t/0-fun-0-'}}, + ?line "fun() -> true end" = flat_expr(Fun2), + + ok. + +tickets(suite) -> + [otp_6321, otp_6911, otp_6914, otp_8150, otp_8238]. + +otp_6321(doc) -> + "OTP_6321. Bug fix of exprs()."; +otp_6321(suite) -> []; +otp_6321(Config) when is_list(Config) -> + Str = "S = hopp, {hej, S}. ", + {done, {ok, Tokens, _EndLine}, ""} = erl_scan:tokens("", Str, _L=1), + {ok, Exprs} = erl_parse:parse_exprs(Tokens), + "S = hopp, {hej,S}" = lists:flatten(erl_pp:exprs(Exprs)), + ok. + +otp_6911(doc) -> + "OTP_6911. More newlines."; +otp_6911(suite) -> []; +otp_6911(Config) when is_list(Config) -> + F = {function,5,thomas,1, + [{clause,5, + [{var,5,'X'}], + [], + [{'case',6, + {var,6,'X'}, + [{clause,7,[{atom,7,true}],[],[{integer,7,12}]}, + {clause,8,[{atom,8,false}],[],[{integer,8,14}]}]}]}]}, + ?line Chars = lists:flatten(erl_pp:form(F)), + ?line "thomas(X) ->\n" + " case X of\n" + " true ->\n" + " 12;\n" + " false ->\n" + " 14\n" + " end.\n" = Chars, + ?line ok = pp_expr(<<"case X of true -> 12; false -> 14 end">>), + ?line ok = pp_expr(<<"receive after 1 -> ok end">>), + ok. + +otp_6914(doc) -> + "OTP_6914. Binary comprehensions."; +otp_6914(suite) -> []; +otp_6914(Config) when is_list(Config) -> + ?line ok = pp_expr(<<"<< <<B:1>> || B <- [0,1,1] >>">>), + ?line ok = pp_expr(<<"[ B || <<B:1>> <= <<\"hi\">>]">>), + ?line ok = pp_expr(<<"<< <<1:1>> || true >>">>), + ok. + +otp_8150(doc) -> + "OTP_8150. Types."; +otp_8150(suite) -> []; +otp_8150(Config) when is_list(Config) -> + ?line _ = [{N,ok} = {N,pp_forms(B)} || + {N,B} <- type_examples() + ], + ok. + +otp_8238(doc) -> + "OTP_8238. Bugfix 'E'."; +otp_8238(suite) -> []; +otp_8238(Config) when is_list(Config) -> + Ex = [<<"-record(rec1, {}).\n" + "-record(rec2, {a, b}).\n" + "-record(rec3, {f123, g, h}).\n">>, + <<"-type line() :: integer().\n">>, + <<"-type info_line() :: integer() | term().\n">>, + <<"-type column() :: pos_integer().\n">>, + [["\n", B] || {_,B} <- type_examples()], + <<"t1(T) ->\n" + " foo:bar(#rec1{}, #rec2{}),\n" + " T.\n" + "t2() ->\n" + " #r{}.\n">> + ], + ?line compile(Config, [{otp_8238,iolist_to_binary(Ex)}]), + ok. + +type_examples() -> + [{ex1,<<"-type ann() :: Var :: integer(). ">>}, + {ex2,<<"-type ann2() :: Var :: " + "'return' | 'return_white_spaces' | 'return_comments'" + " | 'text' | ann(). ">>}, + {ex3,<<"-type paren() :: (ann2()). ">>}, + {ex4,<<"-type t1() :: atom(). ">>}, + {ex5,<<"-type t2() :: [t1()]. ">>}, + {ex6,<<"-type t3(Atom) :: integer(Atom). ">>}, + {ex7,<<"-type t4() :: t3(foobar). ">>}, + {ex8,<<"-type t5() :: {t1(), t3(foo)}. ">>}, + {ex9,<<"-type t6() :: 1 | 2 | 3 | 'foo' | 'bar'. ">>}, + {ex10,<<"-type t7() :: []. ">>}, + {ex11,<<"-type t71() :: [_]. ">>}, + {ex12,<<"-type t8() :: {any(),none(),pid(),port()," + "reference(),float()}. ">>}, + {ex13,<<"-type t9() :: [1|2|3|foo|bar] | " + "list(a | b | c) | t71(). ">>}, + {ex14,<<"-type t10() :: {1|2|3|foo|t9()} | {}. ">>}, + {ex15,<<"-type t11() :: 1..2. ">>}, + {ex16,<<"-type t13() :: maybe_improper_list(integer(), t11()). ">>}, + {ex17,<<"-type t14() :: [erl_scan:foo() | " + "erl_scan:bar(34, 92) | t13() | m:f(integer() | <<_:_*16>>)]. ">>}, + {ex18,<<"-type t15() :: {binary(),<<>>,<<_:34>>,<<_:_*42>>," + "<<_:3,_:_*14>>,<<>>} | [<<>>|<<_:34>>|<<_:16>>|" + "<<_:3,_:_*1472>>|<<_:19,_:_*14>>| <<_:34>>|" + "<<_:34>>|<<_:34>>|<<_:34>>]. ">>}, + {ex19,<<"-type t16() :: fun(). ">>}, + {ex20,<<"-type t17() :: fun((...) -> paren()). ">>}, + {ex21,<<"-type t18() :: fun(() -> t17() | t16()). ">>}, + {ex22,<<"-type t19() :: fun((t18()) -> t16()) |" + "fun((nonempty_maybe_improper_list('integer', any())|" + "1|2|3|a|b|<<_:3,_:_*14>>|integer()) ->" + "nonempty_maybe_improper_list('integer', any())|" + "1|2|3|a|b|<<_:3,_:_*14>>|integer()). ">>}, + {ex23,<<"-type t20() :: [t19(), ...]. ">>}, + {ex24,<<"-type t21() :: tuple(). ">>}, + {ex25,<<"-type t21(A) :: A. ">>}, + {ex26,<<"-type t22() :: t21(integer()). ">>}, + {ex27,<<"-type t23() :: #rec1{}. ">>}, + {ex28,<<"-type t24() :: #rec2{a :: t23(), b :: [atom()]}. ">>}, + {ex29,<<"-type t25() :: #rec3{f123 :: [t24() | " + "1|2|3|4|a|b|c|d| " + "nonempty_maybe_improper_list(integer, any())]}. ">>}, + {ex30,<<"-type t99() ::" + "{t2(),t4(),t5(),t6(),t7(),t8(),t10(),t14()," + "t15(),t20(),t21(), t22(),t25()}. ">>}, + {ex31,<<"-spec t1(FooBar :: t99()) -> t99();" + "(t2()) -> t2();" + "(t4()) -> t4() when is_subtype(t4(), 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(), t4()).">>}, + {ex32,<<"-spec mod:t2() -> any(). ">>}, + {ex33,<<"-opaque attributes_data() :: " + "[{'column', column()} | {'line', info_line()} |" + " {'text', string()}] | {line(),column()}. ">>}, + {ex34,<<"-record(r,{" + "f1 :: attributes_data()," + "f222 = foo:bar(34, #rec3{}, 234234234423, " + " aassdsfsdfsdf, 2234242323) :: " + " [t24() | 1|2|3|4|a|b|c|d| " + " nonempty_maybe_improper_list(integer, any())]," + "f333 :: [t24() | 1|2|3|4|a|b|c|d| " + " nonempty_maybe_improper_list(integer, any())]," + "f3 = x:y()," + "f4 = x:z() :: t99()," + "f17 :: 'undefined'," + "f18 :: 1 | 2 | 'undefined'," + "f19 = 3 :: integer()|undefined," + "f5 = 3 :: undefined|integer()}). ">>}]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +compile(Config, Tests) -> + F = fun({N,P}, BadL) -> + case catch compile_file(Config, P) of + ok -> + case pp_forms(P) of + ok -> + BadL; + not_ok -> + ?t:format("~nTest ~p failed.~n", [N]), + fail() + end; + Bad -> + ?t:format("~nTest ~p failed. got~n ~p~n", + [N, Bad]), + fail() + end + end, + lists:foldl(F, [], Tests). + +compile_file(Config, Test0) -> + case compile_file(Config, Test0, ['E']) of + {ok, RootFile} -> + File = RootFile ++ ".E", + {ok, Bin0} = file:read_file(File), + Bin = strip_module_info(Bin0), + %% A very simple check: just try to compile the output. + case compile_file(Config, Bin, []) of + {ok, RootFile2} -> + File2 = RootFile2 ++ ".E", + {ok, Bin1} = file:read_file(File2), + case Bin0 =:= Bin1 of + true -> + test_max_line(binary_to_list(Bin)); + false -> + {error, file_contents_modified, {Bin0, Bin1}} + end; + Error -> + {error, could_not_compile_E_file, Error} + end; + Error -> + Error + end. + +compile_file(Config, Test0, Opts0) -> + FileName = filename('erl_pp_test.erl', Config), + Test = list_to_binary(["-module(erl_pp_test). " + "-compile(export_all). ", + Test0]), + Opts = [export_all,return,nowarn_unused_record,{outdir,?privdir} | Opts0], + ok = file:write_file(FileName, Test), + case compile:file(FileName, Opts) of + {ok, _M, _Ws} -> + {ok, filename:rootname(FileName)}; + Error -> Error + end. + +strip_module_info(Bin) -> + {match, [{Start,_Len}|_]} = re:run(Bin, "module_info"), + <<R:Start/binary,_/binary>> = Bin, + R. + +flat_expr(Expr) -> + lists:flatten(erl_pp:expr(Expr, -1, none)). + +pp_forms(Bin) -> + pp_forms(Bin, none). + +pp_forms(Bin, Hook) -> + PP1 = (catch parse_and_pp_forms(binary_to_list(Bin), Hook)), + PP2 = (catch parse_and_pp_forms(PP1, Hook)), + case PP1 =:= PP2 of % same line numbers + true -> + test_max_line(PP1); + false -> + not_ok + end. + +parse_and_pp_forms(String, Hook) -> + lists:append(lists:map(fun(AF) -> erl_pp:form(AF, Hook) + end, parse_forms(String))). + +parse_forms(Chars) -> + String = lists:flatten(Chars), + parse_forms2(String, [], 1, []). + +parse_forms2([], _Cont, _Line, Forms) -> + lists:reverse(Forms); +parse_forms2(String, Cont0, Line, Forms) -> + case erl_scan:tokens(Cont0, String, Line) of + {done, {ok, Tokens, EndLine}, Chars} -> + {ok, Form} = erl_parse:parse_form(Tokens), + parse_forms2(Chars, [], EndLine, [Form | Forms]); + {more, Cont} when element(3, Cont) =:= [] -> + %% extra spaces after forms... + parse_forms2([], Cont, Line, Forms); + {more, Cont} -> + %% final dot needs a space... + parse_forms2(" ", Cont, Line, Forms) + end. + +pp_expr(Bin) -> + pp_expr(Bin, none). + +%% Final dot is added. +pp_expr(Bin, Hook) -> + PP1 = (catch parse_and_pp_expr(binary_to_list(Bin), 0, Hook)), + PPneg = (catch parse_and_pp_expr(binary_to_list(Bin), -1, Hook)), + PP2 = (catch parse_and_pp_expr(PPneg, 0, Hook)), + if + PP1 =:= PP2 -> % same line numbers + case + (test_max_line(PP1) =:= ok) and (test_new_line(PPneg) =:= ok) + of + true -> + ok; + false -> + not_ok + end; + true -> + not_ok + end. + +parse_and_pp_expr(String, Indent, Hook) -> + StringDot = lists:flatten(String) ++ ".", + erl_pp:expr(parse_expr(StringDot), Indent, Hook). + +parse_expr(Chars) -> + {ok, Tokens, _} = erl_scan:string(Chars), + {ok, [Expr]} = erl_parse:parse_exprs(Tokens), + Expr. + +test_new_line(String) -> + case string:chr(String, $\n) of + 0 -> ok; + _ -> not_ok + end. + +test_max_line(String) -> + case max_line(String) of + ML when ML > 100 -> + {error, max_line_too_big, {ML,String}}; + _ML -> + ok + end. + +max_line(String) -> + lists:max([0 | [length(Sub) || + Sub <- string:tokens(String, "\n"), + string:substr(Sub, 1, 5) =/= "-file"]]). + +filename(Name, Config) when is_atom(Name) -> + filename(atom_to_list(Name), Config); +filename(Name, Config) -> + filename:join(?privdir, Name). + +fail() -> + io:format("failed~n"), + ?t:fail(). |