diff options
Diffstat (limited to 'lib/compiler/test')
20 files changed, 1358 insertions, 87 deletions
| diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 63763f31b2..da5d207db9 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -22,6 +22,7 @@ MODULES= \  	bs_construct_SUITE \  	bs_match_SUITE \  	bs_utf_SUITE \ +	core_alias_SUITE \  	core_fold_SUITE \  	compile_SUITE \  	compilation_SUITE \ diff --git a/lib/compiler/test/beam_block_SUITE.erl b/lib/compiler/test/beam_block_SUITE.erl index 55d5f2dbe8..38ead96cc8 100644 --- a/lib/compiler/test/beam_block_SUITE.erl +++ b/lib/compiler/test/beam_block_SUITE.erl @@ -22,7 +22,7 @@  -export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,  	 init_per_group/2,end_per_group/2,  	 get_map_elements/1,otp_7345/1,move_opt_across_gc_bif/1, -	 erl_202/1,repro/1]). +	 erl_202/1,repro/1,local_cse/1,second_block_pass/1]).  %% The only test for the following functions is that  %% the code compiles and is accepted by beam_validator. @@ -40,7 +40,9 @@ groups() ->         otp_7345,         move_opt_across_gc_bif,         erl_202, -       repro +       repro, +       local_cse, +       second_block_pass        ]}].  init_per_suite(Config) -> @@ -237,6 +239,72 @@ find_operands(Cfg,XsiGraph,ActiveList,Count) ->      [Count+1, length(NewActiveList), length(digraph:vertices(XsiGraph))],      find_operands(NewCfg,XsiGraph,NewActiveList,Count+1). +%% Some tests of local common subexpression elimination (CSE). + +local_cse(_Config) -> +    {Self,{ok,Self}} = local_cse_1(), + +    local_cse_2([]), +    local_cse_2(lists:seq(1, 512)), +    local_cse_2(?MODULE:module_info()), + +    {[b],[a,b]} = local_cse_3(a, b), + +    {2000,Self,{Self,write_cache}} = local_cse_4(), + +    ok. + +local_cse_1() -> +    %% Cover handling of unsafe tuple construction in +    %% eliminate_use_of_from_reg/4. It became necessary to handle +    %% unsafe tuples when local CSE was introduced. + +    {self(),{ok,self()}}. + +local_cse_2(Term) -> +    case cse_make_binary(Term) of +        <<Size:8,BinTerm:Size/binary>> -> +            Term = binary_to_term(BinTerm); +        <<Size:8,SizeTerm:Size/binary,BinTerm/binary>> -> +            {'$size',TermSize} = binary_to_term(SizeTerm), +            TermSize = byte_size(BinTerm), +            Term = binary_to_term(BinTerm) +    end. + +%% Copy of observer_backend:ttb_make_binary/1. During development of +%% the local CSE optimization this function was incorrectly optimized. + +cse_make_binary(Term) -> +    B = term_to_binary(Term), +    SizeB = byte_size(B), +    if SizeB > 255 -> +            SB = term_to_binary({'$size',SizeB}), +            <<(byte_size(SB)):8, SB/binary, B/binary>>; +       true -> +            <<SizeB:8, B/binary>> +    end. + +local_cse_3(X, Y) -> +    %% The following expression was incorrectly transformed to {[X,Y],[X,Y]} +    %% during development of the local CSE optimization. + +    {[Y],[X,Y]}. + +local_cse_4() -> +    do_local_cse_4(2000, self(), {self(), write_cache}). + +do_local_cse_4(X, Y, Z) -> +    {X,Y,Z}. + +%% Tests previously found bugs when running beam_block the second time. + +second_block_pass(_Config) -> +    [#{dts:=5.0}] = second_1([#{dts => 10.0}], 2.0), +    ok. + +second_1(Fs, TS) -> +    [F#{dts=>DTS / TS} || #{dts:=DTS} = F <- Fs]. +  %%%  %%% Common functions.  %%% diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index d44fa60997..541075af2a 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -23,7 +23,7 @@  	 init_per_group/2,end_per_group/2,  	 integers/1,coverage/1,booleans/1,setelement/1,cons/1,  	 tuple/1,record_float/1,binary_float/1,float_compare/1, -	 arity_checks/1]). +	 arity_checks/1,elixir_binaries/1]).  suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -42,7 +42,8 @@ groups() ->         record_float,         binary_float,         float_compare, -       arity_checks +       arity_checks, +       elixir_binaries        ]}].  init_per_suite(Config) -> @@ -121,7 +122,7 @@ do_integers_5(X0, Y0) ->          3 -> three      end. -coverage(_Config) -> +coverage(Config) ->      {'EXIT',{badarith,_}} = (catch id(1) bsl 0.5),      {'EXIT',{badarith,_}} = (catch id(2.0) bsl 2),      {'EXIT',{badarith,_}} = (catch a + 0.5), @@ -132,6 +133,29 @@ coverage(_Config) ->      id(id(42) band 387439739874298734983787934283479243879),      id(-1 band id(13)), +    error = if +                is_map(Config), is_integer(Config) -> ok; +                true -> error +            end, +    error = if +                is_map(Config), is_atom(Config) -> ok; +                true -> error +            end, +    error = if +                is_map(Config), is_tuple(Config) -> ok; +                true -> error +            end, +    error = if +                is_integer(Config), is_bitstring(Config) -> ok; +                true -> error +            end, + +    ok = case Config of +             <<_>> when is_binary(Config) -> +                 impossible; +             [_|_] -> +                 ok +         end,      ok.  booleans(_Config) -> @@ -232,5 +256,42 @@ do_tuple_arity_check(RGB) when is_tuple(RGB),          _ -> ok      end. +elixir_binaries(_Config) -> +    <<"foo blitzky baz">> = elixir_binary_1(<<"blitzky">>), +    <<"foo * baz">> = elixir_binary_2($*), +    <<7:4,755:10>> = elixir_bitstring_3(<<755:10>>), +    ok. + +elixir_binary_1(Bar) when is_binary(Bar) -> +    <<"foo ", +      case Bar of +          Rewrite when is_binary(Rewrite) -> +              Rewrite; +          Rewrite -> +              list_to_binary(Rewrite) +      end/binary, +      " baz">>. + +elixir_binary_2(Arg) -> +    Bin = <<Arg>>, +    <<"foo ", +      case Bin of +          Rewrite when is_binary(Rewrite) -> +              Rewrite; +          Rewrite -> +              list_to_binary:to_string(Rewrite) +      end/binary, +      " baz">>. + +elixir_bitstring_3(Bar) when is_bitstring(Bar) -> +    <<7:4, +      case Bar of +          Rewrite when is_bitstring(Rewrite) -> +              Rewrite; +          Rewrite -> +              list_to_bitstring(Rewrite) +      end/bitstring>>. + +  id(I) ->      I. diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl index 710cb050d4..7686e69b63 100644 --- a/lib/compiler/test/beam_utils_SUITE.erl +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -24,7 +24,8 @@  	 apply_fun/1,apply_mf/1,bs_init/1,bs_save/1,  	 is_not_killed/1,is_not_used_at/1,  	 select/1,y_catch/1,otp_8949_b/1,liveopt/1,coverage/1, -	 y_registers/1]). +         y_registers/1,user_predef/1,scan_f/1,cafu/1, +         receive_label/1,read_size_file_version/1]).  -export([id/1]).  suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -46,7 +47,11 @@ groups() ->         otp_8949_b,         liveopt,         coverage, -       y_registers +       y_registers, +       user_predef, +       scan_f, +       cafu, +       read_size_file_version        ]}].  init_per_suite(Config) -> @@ -117,6 +122,15 @@ bs_init(_Config) ->      {'EXIT',{badarg,_}} = (catch do_bs_init_2([0.5])),      {'EXIT',{badarg,_}} = (catch do_bs_init_2([-1])),      {'EXIT',{badarg,_}} = (catch do_bs_init_2([1 bsl 32])), + +    <<>> = do_bs_init_3({tag,0}, 0, 0), +    <<0>> = do_bs_init_3({tag,0}, 2, 1), + +    <<"_build/shared">> = do_bs_init_4([], false), +    <<"abc/shared">> = do_bs_init_4(<<"abc">>, false), +    <<"foo/foo">> = do_bs_init_4(<<"foo">>, true), +    error = do_bs_init_4([], not_boolean), +      ok.  do_bs_init_1([?MODULE], Sz) -> @@ -134,6 +148,45 @@ do_bs_init_2(SigNos) ->  	    erlang:error(badarg)      >>. +do_bs_init_3({tag,Pos}, Offset, Len) -> +    N0 = Offset - Pos, +    N = if N0 > Len -> Len; +           true -> N0 +        end, +    <<0:N/unit:8>>. + +do_bs_init_4(Arg1, Arg2) -> +    Build = +        case id(Arg1) of +            X when X =:= [] orelse X =:= false -> <<"_build">>; +            X -> X +        end, +    case id(Arg2) of +        true -> +            id(<<case Build of +                     Rewrite when is_binary(Rewrite) -> +                         Rewrite; +                     Rewrite -> +                         id(Rewrite) +                 end/binary, +                 "/", +                 case id(<<"foo">>) of +                     Rewrite when is_binary(Rewrite) -> +                         Rewrite; +                     Rewrite -> +                         id(Rewrite) +                 end/binary>>); +        false -> +            id(<<case Build of +                     Rewrite when is_binary(Rewrite) -> +                         Rewrite; +                     Rewrite -> +                         id(Rewrite) +                 end/binary, +                 "/shared">>); +        Other -> +            error +    end.  bs_save(_Config) ->      {a,30,<<>>} = do_bs_save(<<1:1,30:5>>), @@ -376,5 +429,83 @@ do(A, B) -> {A,B}.  appointment(#{"resolution" := Url}) ->      do(receive _ -> Url end, #{true => Url}). +%% From epp.erl. +user_predef(_Config) -> +    #{key:="value"} = user_predef({key,"value"}, #{}), +    #{key:="value"} = user_predef({key,"value"}, #{key=>defined}), +    error = user_predef({key,"value"}, #{key=>[defined]}), +    ok. + +user_predef({M,Val}, Ms) -> +    case Ms of +	#{M:=Defs} when is_list(Defs) -> +	    error; +	_ -> +	    Ms#{M=>Val} +    end. + +%% From disk_log_1.erl. +scan_f(_Config) -> +    {1,<<>>,[]} = scan_f(<<1:32>>, 1, []), +    {1,<<>>,[<<156>>]} = scan_f(<<1:32,156,1:32>>, 1, []), +    ok. + +scan_f(<<Size:32,Tail/binary>>, FSz, Acc) when Size =< FSz -> +    case Tail of +        <<BinTerm:Size/binary,Tail2/binary>> -> +            scan_f(Tail2, FSz, [BinTerm | Acc]); +        _ -> +            {Size,Tail,Acc} +    end. + +%% From file_io_server.erl. +cafu(_Config) -> +    error = cafu(<<42:32>>, -1, 0, {utf32,big}), +    error = cafu(<<42:32>>, 10, 0, {utf32,big}), +    error = cafu(<<42:32>>, -1, 0, {utf32,little}), +    ok. + +cafu(<<_/big-utf32,Rest/binary>>, N, Count, {utf32,big}) when N < 0 -> +    cafu(Rest, -1, Count+1, {utf32,big}); +cafu(<<_/big-utf32,Rest/binary>>, N, Count, {utf32,big}) -> +    cafu(Rest, N-1, Count+1, {utf32,big}); +cafu(<<_/little-utf32,Rest/binary>>, N, Count, {utf32,little}) when N < 0 -> +    cafu(Rest, -1, Count+1, {utf32,little}); +cafu(_, _, _, _) -> +    error. + +-record(rec_label, {bool}). + +receive_label(_Config) -> +    Pid = spawn_link(fun() -> do_receive_label(#rec_label{bool=true}) end), +    Msg = {a,b,c}, +    Pid ! {self(),Msg}, +    receive +        {ok,Msg} -> +            unlink(Pid), +            exit(Pid, die), +            ok +    end. + +do_receive_label(Rec) -> +    receive +        {From,Message} when Rec#rec_label.bool -> +            From ! {ok,Message}, +            do_receive_label(Rec) +    end. + +read_size_file_version(_Config) -> +    ok = do_read_size_file_version({ok,<<42>>}), +    {ok,7777} = do_read_size_file_version({ok,<<7777:32>>}), +    ok. + +do_read_size_file_version(E) -> +    case E of +	{ok,<<Version>>} when Version =:= 42 -> +            ok; +	{ok,<<MaxFiles:32>>} -> +            {ok,MaxFiles} +    end. +  %% The identity function.  id(I) -> I. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index c23514b36b..b8fff7b100 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -33,8 +33,8 @@  	 state_after_fault_in_catch/1,no_exception_in_catch/1,  	 undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1,  	 map_field_lists/1,cover_bin_opt/1, -	 val_dsetel/1]). -	  +	 val_dsetel/1,bad_tuples/1,bad_try_catch_nesting/1]). +  -include_lib("common_test/include/ct.hrl").  init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) -> @@ -61,7 +61,8 @@ groups() ->         freg_state,bad_bin_match,bad_dsetel,         state_after_fault_in_catch,no_exception_in_catch,         undef_label,illegal_instruction,failing_gc_guard_bif, -       map_field_lists,cover_bin_opt,val_dsetel]}]. +       map_field_lists,cover_bin_opt,val_dsetel, +       bad_tuples,bad_try_catch_nesting]}].  init_per_suite(Config) ->      Config. @@ -421,9 +422,9 @@ try_bin_opt(Mod) ->      try  	do_bin_opt(Mod)      catch -	Class:Error -> +	Class:Error:Stk ->  	    io:format("~p: ~p ~p\n~p\n", -		      [Mod,Class,Error,erlang:get_stacktrace()]), +		      [Mod,Class,Error,Stk]),  	    error      end. @@ -509,6 +510,27 @@ destroy_reg({Tag,N}) ->  	    {y,N+1}      end. +bad_tuples(Config) -> +    Errors = do_val(bad_tuples, Config), +    [{{bad_tuples,heap_overflow,1}, +      {{put,{x,0}},8,{heap_overflow,{left,0},{wanted,1}}}}, +     {{bad_tuples,long,2}, +      {{put,{atom,too_long}},8,not_building_a_tuple}}, +     {{bad_tuples,self_referential,1}, +      {{put,{x,1}},7,{tuple_in_progress,{x,1}}}}, +     {{bad_tuples,short,1}, +      {{move,{x,1},{x,0}},7,{tuple_in_progress,{x,1}}}}] = Errors, + +    ok. + +bad_try_catch_nesting(Config) -> +    Errors = do_val(bad_try_catch_nesting, Config), +    [{{bad_try_catch_nesting,main,2}, +      {{'try',{y,2},{f,3}}, +       7, +       {bad_try_catch_nesting,{y,2},[{{y,1},{trytag,[5]}}]}}}] = Errors, +    ok. +  %%%-------------------------------------------------------------------------  transform_remove(Remove, Module) -> diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_try_catch_nesting.S b/lib/compiler/test/beam_validator_SUITE_data/bad_try_catch_nesting.S new file mode 100644 index 0000000000..9f1b21a17b --- /dev/null +++ b/lib/compiler/test/beam_validator_SUITE_data/bad_try_catch_nesting.S @@ -0,0 +1,64 @@ +{module, bad_try_catch_nesting}.  %% version = 0 + +{exports, [{main,2},{module_info,0},{module_info,1}]}. + +{attributes, []}. + +{labels, 11}. + + +{function, main, 2, 2}. +  {label,1}. +    {line,[{location,"bad_try_catch_nesting.erl",4}]}. +    {func_info,{atom,bad_try_catch_nesting},{atom,main},2}. +  {label,2}. +    {allocate_zero,3,2}. +    {'try',{y,1},{f,5}}. +    {move,{x,1},{y,0}}. +    {'try',{y,2},{f,3}}. +    {line,[{location,"bad_try_catch_nesting.erl",7}]}. +    {call_fun,0}. +    {try_end,{y,2}}. +    {jump,{f,4}}. +  {label,3}. +    {try_case,{y,2}}. +    {test,is_ne_exact,{f,4},[{x,0},{atom,error}]}. +    {line,[]}. +    {bif,raise,{f,0},[{x,2},{x,1}],{x,0}}. +  {label,4}. +    {move,{y,0},{x,0}}. +    {kill,{y,0}}. +    {line,[{location,"bad_try_catch_nesting.erl",12}]}. +    {call_fun,0}. +    {try_end,{y,1}}. +    {deallocate,3}. +    return. +  {label,5}. +    {try_case,{y,1}}. +    {test,is_eq_exact,{f,6},[{x,0},{atom,throw}]}. +    {deallocate,3}. +    return. +  {label,6}. +    {line,[]}. +    {bif,raise,{f,0},[{x,2},{x,1}],{x,0}}. + + +{function, module_info, 0, 8}. +  {label,7}. +    {line,[]}. +    {func_info,{atom,bad_try_catch_nesting},{atom,module_info},0}. +  {label,8}. +    {move,{atom,bad_try_catch_nesting},{x,0}}. +    {line,[]}. +    {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. + + +{function, module_info, 1, 10}. +  {label,9}. +    {line,[]}. +    {func_info,{atom,bad_try_catch_nesting},{atom,module_info},1}. +  {label,10}. +    {move,{x,0},{x,1}}. +    {move,{atom,bad_try_catch_nesting},{x,0}}. +    {line,[]}. +    {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. diff --git a/lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S b/lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S new file mode 100644 index 0000000000..7980241c37 --- /dev/null +++ b/lib/compiler/test/beam_validator_SUITE_data/bad_tuples.S @@ -0,0 +1,88 @@ +{module, bad_tuples}.  %% version = 0 + +{exports, [{heap_overflow,1}, +           {long,2}, +           {module_info,0}, +           {module_info,1}, +           {self_referential,1}, +           {short,1}]}. + +{attributes, []}. + +{labels, 13}. + + +{function, short, 1, 2}. +  {label,1}. +    {line,[{location,"bad_tuples.erl",4}]}. +    {func_info,{atom,bad_tuples},{atom,short},1}. +  {label,2}. +    {test_heap,3,1}. +    {put_tuple,2,{x,1}}. +    {put,{atom,ok}}. +    {move,{x,1},{x,0}}. +    return. + + +{function, long, 2, 4}. +  {label,3}. +    {line,[{location,"bad_tuples.erl",7}]}. +    {func_info,{atom,bad_tuples},{atom,long},2}. +  {label,4}. +    {test_heap,6,2}. +    {put_tuple,2,{x,2}}. +    {put,{x,0}}. +    {put,{x,1}}. +    {put,{atom,too_long}}. +    {put_tuple,2,{x,0}}. +    {put,{atom,ok}}. +    {put,{x,2}}. +    return. + + +{function, heap_overflow, 1, 6}. +  {label,5}. +    {line,[{location,"bad_tuples.erl",10}]}. +    {func_info,{atom,bad_tuples},{atom,heap_overflow},1}. +  {label,6}. +    {test_heap,3,1}. +    {put_tuple,2,{x,1}}. +    {put,{atom,ok}}. +    {put,{x,0}}. +    {put,{x,0}}. +    {move,{x,1},{x,0}}. +    return. + + +{function, self_referential, 1, 8}. +  {label,7}. +    {line,[{location,"bad_tuples.erl",13}]}. +    {func_info,{atom,bad_tuples},{atom,self_referential},1}. +  {label,8}. +    {test_heap,3,1}. +    {put_tuple,2,{x,1}}. +    {put,{atom,ok}}. +    {put,{x,1}}. +    {move,{x,1},{x,0}}. +    return. + + +{function, module_info, 0, 10}. +  {label,9}. +    {line,[]}. +    {func_info,{atom,bad_tuples},{atom,module_info},0}. +  {label,10}. +    {move,{atom,bad_tuples},{x,0}}. +    {line,[]}. +    {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. + + +{function, module_info, 1, 12}. +  {label,11}. +    {line,[]}. +    {func_info,{atom,bad_tuples},{atom,module_info},1}. +  {label,12}. +    {move,{x,0},{x,1}}. +    {move,{atom,bad_tuples},{x,0}}. +    {line,[]}. +    {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index 2fe8cd0cff..235956a714 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -39,7 +39,8 @@  	 match_string_opt/1,select_on_integer/1,  	 map_and_binary/1,unsafe_branch_caching/1,  	 bad_literals/1,good_literals/1,constant_propagation/1, -	 parse_xml/1,get_payload/1,num_slots_different/1]). +	 parse_xml/1,get_payload/1,escape/1,num_slots_different/1, +         beam_bsm/1,guard/1,is_ascii/1,non_opt_eq/1]).  -export([coverage_id/1,coverage_external_ignore/2]). @@ -71,7 +72,8 @@ groups() ->         match_string_opt,select_on_integer,         map_and_binary,unsafe_branch_caching,         bad_literals,good_literals,constant_propagation,parse_xml, -       get_payload,num_slots_different]}]. +       get_payload,escape,num_slots_different, +       beam_bsm,guard,is_ascii,non_opt_eq]}].  init_per_suite(Config) -> @@ -676,6 +678,10 @@ coverage(Config) when is_list(Config) ->      <<>> = coverage_per_key(<<4:32>>),      <<$a,$b,$c>> = coverage_per_key(<<7:32,"abc">>), +    binary = coverage_bitstring(<<>>), +    binary = coverage_bitstring(<<7>>), +    bitstring = coverage_bitstring(<<7:4>>), +    other = coverage_bitstring([a]),      ok.  coverage_fold(Fun, Acc, <<H,T/binary>>) -> @@ -766,6 +772,10 @@ coverage_per_key(<<BinSize:32,Bin/binary>> = B) ->      true = (byte_size(B) =:= BinSize),      Bin. +coverage_bitstring(Bin) when is_binary(Bin) -> binary; +coverage_bitstring(<<_/bitstring>>) -> bitstring; +coverage_bitstring(_) -> other. +  multiple_uses(Config) when is_list(Config) ->      {344,62879,345,<<245,159,1,89>>} = multiple_uses_1(<<1,88,245,159,1,89>>),      true = multiple_uses_2(<<0,0,197,18>>), @@ -799,7 +809,7 @@ multiple_uses_cmp(<<_:16>>, <<_:16>>) -> false.  first_after(Data, Offset) ->      case byte_size(Data) > Offset of  	false -> -	    {First, Rest} = {ok, ok}, +	    {_First, _Rest} = {ok, ok},  	    ok;  	true ->  	    <<_:Offset/binary, Rest/binary>> = Data, @@ -1513,7 +1523,7 @@ is_next_char_whitespace(<<C/utf8,_/binary>>) ->          {this_hdr = 17,           ext_hdr_opts}). -get_payload(Config) -> +get_payload(_Config) ->      <<3445:48>> = do_get_payload(#ext_header{ext_hdr_opts = <<3445:48>>}),      {'EXIT',_} = (catch do_get_payload(#ext_header{})),      ok. @@ -1524,6 +1534,21 @@ do_get_payload(ExtHdr) ->      <<_:13,_:35>> = ExtHdr#ext_header.ext_hdr_opts,      ExtHdrOptions. +escape(_Config) -> +    0 = escape(<<>>, 0), +    1 = escape(<<128>>, 0), +    2 = escape(<<128,255>>, 0), +    42 = escape(<<42>>, 0), +    50 = escape(<<42,8>>, 0), +    ok. + +escape(<<Byte, Rest/bits>>, Pos) when Byte >= 127 -> +    escape(Rest, Pos + 1); +escape(<<Byte, Rest/bits>>, Pos) -> +    escape(Rest, Pos + Byte); +escape(<<_Rest/bits>>, Pos) -> +    Pos. +  %% ERL-490  num_slots_different(_Config) ->      Ts = [{<<"de">>, <<"default">>, <<"Remove">>, <<"a">>}, @@ -1557,6 +1582,101 @@ lgettext(<<"de">>, <<"navigation">>, <<"Results">>) ->  lgettext(<<"de">>, <<"navigation">>, <<"Resources">>) ->      {ok, <<"Ressourcen">>}. +%% Test more code in beam_bsm. +beam_bsm(_Config) -> +    true = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [1,0,1,1]), +    false = check_bitstring_list(<<1:1,0:1,1:1,1:1>>, [0]), + +    true = bsm_validate_scheme(<<>>), +    true = bsm_validate_scheme(<<5,10>>), +    false = bsm_validate_scheme(<<5,10,11,12>>), +    true = bsm_validate_scheme([]), +    true = bsm_validate_scheme([5,10]), +    false = bsm_validate_scheme([5,6,7]), + +    <<1,2,3>> = bsm_must_save_and_not_save(<<1,2,3>>, []), +    D = fun(N) -> 2*N end, +    [2,4|<<3>>] = bsm_must_save_and_not_save(<<1,2,3>>, [D,D]), + +    ok. + +check_bitstring_list(<<H:1,T1/bitstring>>, [H|T2]) -> +    check_bitstring_list(T1, T2); +check_bitstring_list(<<>>, []) -> +    true; +check_bitstring_list(_, _) -> +    false. + +bsm_validate_scheme([]) -> true; +bsm_validate_scheme([H|T]) -> +    case bsm_is_scheme(H) of +        true -> bsm_validate_scheme(T); +        false -> false +    end; +bsm_validate_scheme(<<>>) -> true; +bsm_validate_scheme(<<H, Rest/binary>>) -> +    case bsm_is_scheme(H) of +        true -> bsm_validate_scheme(Rest); +        false -> false +    end. + +bsm_is_scheme(Int) -> +    Int rem 5 =:= 0. + +%% NOT OPTIMIZED: different control paths use different positions in the binary +bsm_must_save_and_not_save(Bin, []) -> +    Bin; +bsm_must_save_and_not_save(<<H,T/binary>>, [F|Fs]) -> +    [F(H)|bsm_must_save_and_not_save(T, Fs)]; +bsm_must_save_and_not_save(<<>>, []) -> +    []. + +guard(_Config) -> +    _Tuple = id({a,b}), +    ok = guard_1(<<1,2,3>>, {1,2,3}), +    ok = guard_2(<<42>>, #{}), +    ok. + +%% Cover handling of #k_put{} in v3_codegen:bsm_rename_ctx/4. +guard_1(<<A,B,C>>, Tuple) when Tuple =:= {A,B,C} -> +    ok. + +%% Cover handling of #k_call{} in v3_codegen:bsm_rename_ctx/4. +guard_2(<<_>>, Healing) when Healing#{[] => Healing} =:= #{[] => #{}} -> +    ok. + +is_ascii(_Config) -> +    true = do_is_ascii(<<>>), +    true = do_is_ascii(<<"string">>), +    false = do_is_ascii(<<1024/utf8>>), +    {'EXIT',{function_clause,_}} = (catch do_is_ascii(<<$A,0:3>>)), +    {'EXIT',{function_clause,_}} = (catch do_is_ascii(<<16#80,0:3>>)), +    ok. + +do_is_ascii(<<>>) -> +    true; +do_is_ascii(<<C,_/binary>>) when C >= 16#80 -> +    %% This clause must fail to match if the size of the argument in +    %% bits is not divisible by 8. Beware of unsafe optimizations. +    false; +do_is_ascii(<<_, T/binary>>) -> +    do_is_ascii(T). + +non_opt_eq(_Config) -> +    true = non_opt_eq([], <<>>), +    true = non_opt_eq([$a], <<$a>>), +    false = non_opt_eq([$a], <<$b>>), +    ok. + +%% An example from the Efficiency Guide. It used to be not optimized, +%% but now it can be optimized. + +non_opt_eq([H|T1], <<H,T2/binary>>) -> +    non_opt_eq(T1, T2); +non_opt_eq([_|_], <<_,_/binary>>) -> +    false; +non_opt_eq([], <<>>) -> +    true.  check(F, R) ->      R = F(). diff --git a/lib/compiler/test/compilation_SUITE_data/opt_crash.erl b/lib/compiler/test/compilation_SUITE_data/opt_crash.erl index f1607cca68..c65ec31593 100644 --- a/lib/compiler/test/compilation_SUITE_data/opt_crash.erl +++ b/lib/compiler/test/compilation_SUITE_data/opt_crash.erl @@ -33,7 +33,7 @@ test() ->                 {userinfo,nil},                 fun() -> nil end},              nil}, -         {'query',nil}}}, +         {query,nil}}},     {absoluteURI,        {scheme,_}, @@ -43,7 +43,7 @@ test() ->                 {userinfo,nil},                 HostportBefore},              nil}, -         {'query',nil}}} = URI_Before, +         {query,nil}}} = URI_Before,     %% ... some funky code ommitted, not relevant ... @@ -55,7 +55,7 @@ test() ->                 {userinfo,nil},                 HostportAfter},              nil}, -         {'query',nil}}} = URI_Before, +         {query,nil}}} = URI_Before,     %% NOTE: I intended to write URI_After instead of URI_Before     %% but the accident revealed that when you add the line below,     %% it causes internal error in v3_codegen on compilation diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index 96897d612d..eee5bc733f 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -27,12 +27,12 @@  -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,   	 init_per_group/2,end_per_group/2,  	 app_test/1,appup_test/1, -	 debug_info/4, custom_debug_info/1, +	 debug_info/4, custom_debug_info/1, custom_compile_info/1,  	 file_1/1, forms_2/1, module_mismatch/1, big_file/1, outdir/1,  	 binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1,  	 other_output/1, kernel_listing/1, encrypted_abstr/1,  	 strict_record/1, utf8_atoms/1, utf8_functions/1, extra_chunks/1, -	 cover/1, env/1, core_pp/1, +	 cover/1, env/1, core_pp/1, tuple_calls/1,  	 core_roundtrip/1, asm/1, optimized_guards/1,  	 sys_pre_attributes/1, dialyzer/1,  	 warnings/1, pre_load_check/1, env_compiler_options/1, @@ -49,11 +49,12 @@ all() ->      test_lib:recompile(?MODULE),      [app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir,       binary, makedep, cond_and_ifdef, listings, listings_big, -     other_output, kernel_listing, encrypted_abstr, +     other_output, kernel_listing, encrypted_abstr, tuple_calls,       strict_record, utf8_atoms, utf8_functions, extra_chunks,       cover, env, core_pp, core_roundtrip, asm, optimized_guards,       sys_pre_attributes, dialyzer, warnings, pre_load_check, -     env_compiler_options, custom_debug_info, bc_options]. +     env_compiler_options, custom_debug_info, bc_options, +     custom_compile_info].  groups() ->       []. @@ -384,7 +385,6 @@ do_file_listings(DataDir, PrivDir, [File|Files]) ->      do_listing(Simple, TargetDir, dcbsm, ".core_bsm"),      do_listing(Simple, TargetDir, dsetel, ".dsetel"),      do_listing(Simple, TargetDir, dkern, ".kernel"), -    do_listing(Simple, TargetDir, dlife, ".life"),      do_listing(Simple, TargetDir, dcg, ".codegen"),      do_listing(Simple, TargetDir, dblk, ".block"),      do_listing(Simple, TargetDir, dexcept, ".except"), @@ -500,9 +500,8 @@ do_kernel_listing({M,A}) ->  	    io:format("*** compilation failure '~p' for module ~s\n",  		      [Error,M]),  	    error; -	Class:Error -> -	    io:format("~p: ~p ~p\n~p\n", -		      [M,Class,Error,erlang:get_stacktrace()]), +	Class:Error:Stk -> +	    io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]),  	    error      end. @@ -661,6 +660,23 @@ custom_debug_info(Config) when is_list(Config) ->      {ok,{simple,[{debug_info,{debug_info_v1,?MODULE,error}}]}} =  	beam_lib:chunks(ErrorBin, [debug_info]). +custom_compile_info(Config) when is_list(Config) -> +    Anno = erl_anno:new(1), +    Forms = [{attribute,Anno,module,custom_compile_info}], +    Opts = [binary,{compile_info,[{another,version}]}], + +    {ok,custom_compile_info,Bin} = compile:forms(Forms, Opts), +    {ok,{custom_compile_info,[{compile_info,CompileInfo}]}} = +	beam_lib:chunks(Bin, [compile_info]), +    version = proplists:get_value(another, CompileInfo), +    CompileOpts = proplists:get_value(options, CompileInfo), +    undefined = proplists:get_value(compile_info, CompileOpts), + +    {ok,custom_compile_info,DetBin} = compile:forms(Forms, [deterministic|Opts]), +    {ok,{custom_compile_info,[{compile_info,DetInfo}]}} = +	beam_lib:chunks(DetBin, [compile_info]), +    version = proplists:get_value(another, DetInfo). +  cover(Config) when is_list(Config) ->      io:format("~p\n", [compile:options()]),      ok. @@ -793,6 +809,37 @@ extra_chunks(Config) when is_list(Config) ->      {ok,{extra_chunks,[{"ExCh",<<"Contents">>}]}} =  	beam_lib:chunks(ExtraChunksBinary, ["ExCh"]). +tuple_calls(Config) when is_list(Config) -> +    Anno = erl_anno:new(1), +    Forms = [{attribute,Anno,export,[{size,1},{store,1}]}, +	     {function,Anno,size,1, +	      [{clause,Anno,[{var,[],mod}],[], +	       [{call,[],{remote,[],{var,[],mod},{atom,[],size}},[]}]}]}, +	     {function,Anno,store,1, +	      [{clause,Anno,[{var,[],mod}],[], +	       [{call,[],{remote,[],{var,[],mod},{atom,[],store}},[{atom,[],key},{atom,[],value}]}]}]}], + +    TupleCallsFalse = [{attribute,Anno,module,tuple_calls_false}|Forms], +    {ok,_,TupleCallsFalseBinary} = compile:forms(TupleCallsFalse, [binary]), +    code:load_binary(tuple_calls_false, "compile_SUITE.erl", TupleCallsFalseBinary), +    {'EXIT',{badarg,_}} = (catch tuple_calls_false:store(dict())), +    {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(dict())), +    {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(empty_tuple())), + +    TupleCallsTrue = [{attribute,Anno,module,tuple_calls_true}|Forms], +    {ok,_,TupleCallsTrueBinary} = compile:forms(TupleCallsTrue, [binary,tuple_calls]), +    code:load_binary(tuple_calls_true, "compile_SUITE.erl", TupleCallsTrueBinary), +    Dict = tuple_calls_true:store(dict()), +    1 = tuple_calls_true:size(Dict), +    {'EXIT',{badarg,_}} = (catch tuple_calls_true:size(empty_tuple())), + +    ok. + +dict() -> +    dict:new(). +empty_tuple() -> +    {}. +  env(Config) when is_list(Config) ->      {Simple,Target} = get_files(Config, simple, env),      {ok,Cwd} = file:get_cwd(), @@ -854,9 +901,8 @@ do_core_pp({M,A}, Outdir) ->  	    io:format("*** compilation failure '~p' for module ~s\n",  		      [Error,M]),  	    error; -	Class:Error -> -	    io:format("~p: ~p ~p\n~p\n", -		      [M,Class,Error,erlang:get_stacktrace()]), +	Class:Error:Stk -> +	    io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]),  	    error      end. @@ -913,9 +959,8 @@ do_core_roundtrip(Beam, Outdir) ->  	    io:format("*** compilation failure '~p' for file ~s\n",  		      [Error,Beam]),  	    error; -	Class:Error -> -	    io:format("~p: ~p ~p\n~p\n", -		      [Beam,Class,Error,erlang:get_stacktrace()]), +	Class:Error:Stk -> +	    io:format("~p: ~p ~p\n~p\n", [Beam,Class,Error,Stk]),  	    error      end. @@ -1100,9 +1145,8 @@ do_asm(Beam, Outdir) ->  			  [Other,AsmFile]),  		error  	end -    catch Class:Error -> -	    io:format("~p: ~p ~p\n~p\n", -		      [M,Class,Error,erlang:get_stacktrace()]), +    catch Class:Error:Stk -> +	    io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]),  	    error      end. @@ -1119,9 +1163,8 @@ do_opt_guards(Beam) ->      try  	{ok,M,Asm} = compile:forms(A, ['S']),  	do_opt_guards_mod(Asm) -    catch Class:Error -> -	    io:format("~p: ~p ~p\n~p\n", -		      [M,Class,Error,erlang:get_stacktrace()]), +    catch Class:Error:Stk -> +	    io:format("~p: ~p ~p\n~p\n", [M,Class,Error,Stk]),  	    error      end. @@ -1282,10 +1325,13 @@ do_warnings_2([], Next, F) ->  %% pre-loads the modules that are used by a typical compilation.  pre_load_check(Config) -> -    case test_server:is_cover() of -	true -> +    case {test_server:is_cover(),code:module_info(native)} of +	{true,_} ->  	    {skip,"Cover is running"}; -	false -> +        {false,true} -> +            %% Tracing won't work. +            {skip,"'code' is native-compiled"}; +	{false,false} ->  	    try  		do_pre_load_check(Config)  	    after @@ -1409,19 +1455,21 @@ env_compiler_options(_Config) ->  bc_options(Config) ->      DataDir = proplists:get_value(data_dir, Config), -    101 = highest_opcode(DataDir, small_float, [no_line_info]), +    101 = highest_opcode(DataDir, small_float, [no_get_hd_tl,no_line_info]),      103 = highest_opcode(DataDir, big, -                         [no_record_opt,no_line_info,no_stack_trimming]), +                         [no_get_hd_tl,no_record_opt, +                          no_line_info,no_stack_trimming]), -    125 = highest_opcode(DataDir, small_float, [no_line_info,no_float_opt]), +    125 = highest_opcode(DataDir, small_float, +                         [no_get_hd_tl,no_line_info,no_float_opt]),      132 = highest_opcode(DataDir, small, -                         [no_record_opt,no_float_opt,no_line_info]), +                         [no_get_hd_tl,no_record_opt,no_float_opt,no_line_info]), -    136 = highest_opcode(DataDir, big, [no_record_opt,no_line_info]), +    136 = highest_opcode(DataDir, big, [no_get_hd_tl,no_record_opt,no_line_info]), -    153 = highest_opcode(DataDir, big, [no_record_opt]), +    153 = highest_opcode(DataDir, big, [no_get_hd_tl,no_record_opt]),      153 = highest_opcode(DataDir, big, [r16]),      153 = highest_opcode(DataDir, big, [r17]),      153 = highest_opcode(DataDir, big, [r18]), @@ -1432,9 +1480,10 @@ bc_options(Config) ->      158 = highest_opcode(DataDir, small_maps, [r17]),      158 = highest_opcode(DataDir, small_maps, [r18]),      158 = highest_opcode(DataDir, small_maps, [r19]), +    158 = highest_opcode(DataDir, small_maps, [r20]),      158 = highest_opcode(DataDir, small_maps, []), -    159 = highest_opcode(DataDir, big, []), +    163 = highest_opcode(DataDir, big, []),      ok. diff --git a/lib/compiler/test/compile_SUITE_data/big.erl b/lib/compiler/test/compile_SUITE_data/big.erl index 2e54ee8660..1db07755a1 100644 --- a/lib/compiler/test/compile_SUITE_data/big.erl +++ b/lib/compiler/test/compile_SUITE_data/big.erl @@ -741,3 +741,7 @@ snmp_access(suite) ->  debug_support(suite) ->      [  info, schema, schema, kill, lkill ]. +%% Cover translation of get_hd/2 to get_list/3 when option no_get_hd_tl +%% is given. +cover_get_hd([Hd|_]) -> +    Hd. diff --git a/lib/compiler/test/core_alias_SUITE.erl b/lib/compiler/test/core_alias_SUITE.erl new file mode 100644 index 0000000000..f3f15ef0f8 --- /dev/null +++ b/lib/compiler/test/core_alias_SUITE.erl @@ -0,0 +1,195 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%%     http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +-module(core_alias_SUITE). + +-export([all/0, suite/0, groups/0,init_per_suite/1, end_per_suite/1, +         init_per_group/2, end_per_group/2, +         tuples/1, cons/1]). + +-include_lib("common_test/include/ct.hrl"). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> +    test_lib:recompile(?MODULE), +    [{group,p}]. + +groups() -> +    [{p,[parallel], +      [tuples, cons]}]. + +init_per_suite(Config) -> +    Config. + +end_per_suite(_Config) -> +    ok. + +init_per_group(_GroupName, Config) -> +    Config. + +end_per_group(_GroupName, Config) -> +    Config. + + +id(X) -> X. + +tuples(Config) when is_list(Config) -> +    Tuple = {ok,id(value)}, + +    true = erts_debug:same(Tuple, simple_tuple(Tuple)), +    true = erts_debug:same(Tuple, simple_tuple_in_map(#{hello => Tuple})), +    true = erts_debug:same(Tuple, simple_tuple_case_repeated(Tuple, Tuple)), +    true = erts_debug:same(Tuple, simple_tuple_fun_repeated(Tuple, Tuple)), +    true = erts_debug:same(Tuple, simple_tuple_twice_head(Tuple, Tuple)), + +    {Tuple1, Tuple2} = simple_tuple_twice_body(Tuple), +    true = erts_debug:same(Tuple, Tuple1), +    true = erts_debug:same(Tuple, Tuple2), + +    Nested = {nested,Tuple}, +    true = erts_debug:same(Tuple, nested_tuple_part(Nested)), +    true = erts_debug:same(Nested, nested_tuple_whole(Nested)), +    true = erts_debug:same(Nested, nested_tuple_with_alias(Nested)), + +    true = erts_debug:same(Tuple, tuple_rebinding_after(Tuple)), + +    Tuple = unaliased_tuple_rebinding_before(Tuple), +    false = erts_debug:same(Tuple, unaliased_tuple_rebinding_before(Tuple)), +    Nested = unaliased_literal_tuple_head(Nested), +    false = erts_debug:same(Nested, unaliased_literal_tuple_head(Nested)), +    Nested = unaliased_literal_tuple_body(Nested), +    false = erts_debug:same(Nested, unaliased_literal_tuple_body(Nested)), +    Nested = unaliased_different_var_tuple(Nested, Tuple), +    false = erts_debug:same(Nested, unaliased_different_var_tuple(Nested, Tuple)). + +simple_tuple({ok,X}) -> +    {ok,X}. +simple_tuple_twice_head({ok,X}, {ok,X}) -> +    {ok,X}. +simple_tuple_twice_body({ok,X}) -> +    {{ok,X},{ok,X}}. +simple_tuple_in_map(#{hello := {ok,X}}) -> +    {ok,X}. +simple_tuple_fun_repeated({ok,X}, Y) -> +    io:format("~p~n", [X]), +    (fun({ok,X}) -> {ok,X} end)(Y). +simple_tuple_case_repeated({ok,X}, Y) -> +    io:format("~p~n", [X]), +    case Y of {ok,X} -> {ok,X} end. + +nested_tuple_part({nested,{ok,X}}) -> +    {ok,X}. +nested_tuple_whole({nested,{ok,X}}) -> +    {nested,{ok,X}}. +nested_tuple_with_alias({nested,{ok,_}=Y}) -> +    {nested,Y}. + +tuple_rebinding_after(Y) -> +    (fun(X) -> {ok,X} end)(Y), +    case Y of {ok,X} -> {ok,X} end. +unaliased_tuple_rebinding_before({ok,X}) -> +    io:format("~p~n", [X]), +    (fun(X) -> {ok,X} end)(value). +unaliased_literal_tuple_head({nested,{ok,value}=X}) -> +    io:format("~p~n", [X]), +    {nested,{ok,value}}. +unaliased_literal_tuple_body({nested,{ok,value}=X}) -> +    Res = {nested,Y={ok,value}}, +    io:format("~p~n", [[X,Y]]), +    Res. +unaliased_different_var_tuple({nested,{ok,value}=X}, Y) -> +    io:format("~p~n", [X]), +    {nested,Y}. + +cons(Config) when is_list(Config) -> +    Cons = [ok|id(value)], + +    true = erts_debug:same(Cons, simple_cons(Cons)), +    true = erts_debug:same(Cons, simple_cons_in_map(#{hello => Cons})), +    true = erts_debug:same(Cons, simple_cons_case_repeated(Cons, Cons)), +    true = erts_debug:same(Cons, simple_cons_fun_repeated(Cons, Cons)), +    true = erts_debug:same(Cons, simple_cons_twice_head(Cons, Cons)), + +    {Cons1,Cons2} = simple_cons_twice_body(Cons), +    true = erts_debug:same(Cons, Cons1), +    true = erts_debug:same(Cons, Cons2), + +    Nested = [nested,Cons], +    true = erts_debug:same(Cons, nested_cons_part(Nested)), +    true = erts_debug:same(Nested, nested_cons_whole(Nested)), +    true = erts_debug:same(Nested, nested_cons_with_alias(Nested)), +    true = erts_debug:same(Cons, cons_rebinding_after(Cons)), + +    Unstripped = id([a,b]), +    Stripped = cons_with_binary([<<>>|Unstripped]), +    true = erts_debug:same(Unstripped, Stripped), + +    Cons = unaliased_cons_rebinding_before(Cons), +    false = erts_debug:same(Cons, unaliased_cons_rebinding_before(Cons)), +    Nested = unaliased_literal_cons_head(Nested), +    false = erts_debug:same(Nested, unaliased_literal_cons_head(Nested)), +    Nested = unaliased_literal_cons_body(Nested), +    false = erts_debug:same(Nested, unaliased_literal_cons_body(Nested)), +    Nested = unaliased_different_var_cons(Nested, Cons), +    false = erts_debug:same(Nested, unaliased_different_var_cons(Nested, Cons)). + +simple_cons([ok|X]) -> +    [ok|X]. +simple_cons_twice_head([ok|X], [ok|X]) -> +    [ok|X]. +simple_cons_twice_body([ok|X]) -> +    {[ok|X],[ok|X]}. +simple_cons_in_map(#{hello := [ok|X]}) -> +    [ok|X]. +simple_cons_fun_repeated([ok|X], Y) -> +    io:format("~p~n", [X]), +    (fun([ok|X]) -> [ok|X] end)(Y). +simple_cons_case_repeated([ok|X], Y) -> +    io:format("~p~n", [X]), +    case Y of [ok|X] -> [ok|X] end. + +nested_cons_part([nested,[ok|X]]) -> +    [ok|X]. +nested_cons_whole([nested,[ok|X]]) -> +    [nested,[ok|X]]. +nested_cons_with_alias([nested,[ok|_]=Y]) -> +    [nested,Y]. + +cons_with_binary([<<>>,X|Y]) -> +    cons_with_binary([X|Y]); +cons_with_binary(A) -> +    A. + +cons_rebinding_after(Y) -> +    (fun(X) -> [ok|X] end)(Y), +    case Y of [ok|X] -> [ok|X] end. +unaliased_cons_rebinding_before([ok|X]) -> +    io:format("~p~n", [X]), +    (fun(X) -> [ok|X] end)(value). +unaliased_literal_cons_head([nested,[ok|value]=X]) -> +    io:format("~p~n", [X]), +    [nested,[ok|value]]. +unaliased_literal_cons_body([nested,[ok|value]=X]) -> +    Res = [nested,Y=[ok|value]], +    io:format("~p~n", [[X, Y]]), +    Res. +unaliased_different_var_cons([nested,[ok|value]=X], Y) -> +    io:format("~p~n", [X]), +    [nested,Y]. diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index 0097e28d4d..4fd1f84569 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -26,7 +26,8 @@  	 unused_multiple_values_error/1,unused_multiple_values/1,  	 multiple_aliases/1,redundant_boolean_clauses/1,  	 mixed_matching_clauses/1,unnecessary_building/1, -	 no_no_file/1,configuration/1,supplies/1]). +	 no_no_file/1,configuration/1,supplies/1, +         redundant_stack_frame/1,export_from_case/1]).  -export([foo/0,foo/1,foo/2,foo/3]). @@ -45,7 +46,8 @@ groups() ->         unused_multiple_values_error,unused_multiple_values,         multiple_aliases,redundant_boolean_clauses,         mixed_matching_clauses,unnecessary_building, -       no_no_file,configuration,supplies]}]. +       no_no_file,configuration,supplies, +       redundant_stack_frame,export_from_case]}].  init_per_suite(Config) -> @@ -527,4 +529,60 @@ supplies(_Config) ->  do_supplies(#{1 := Value}) when byte_size(Value), byte_size(kg) -> working. +redundant_stack_frame(_Config) -> +    {1,2} = do_redundant_stack_frame(#{x=>1,y=>2}), +    {'EXIT',{{badkey,_,x},_}} = (catch do_redundant_stack_frame(#{y=>2})), +    {'EXIT',{{badkey,_,y},_}} = (catch do_redundant_stack_frame(#{x=>1})), +    ok. + +do_redundant_stack_frame(Map) -> +    %% There should not be a stack frame for this function. +    X = case Map of +            #{x := X0} -> +                X0; +            #{} -> +                erlang:error({badkey, Map, x}) +        end, +    Y = case Map of +            #{y := Y0} -> +                Y0; +            #{} -> +                erlang:error({badkey, Map, y}) +        end, +    {X, Y}. + +%% Cover some clauses in sys_core_fold:remove_first_value/2. + +-record(export_from_case, {val}). + +export_from_case(_Config) -> +    a = export_from_case_1(true), +    b = export_from_case_1(false), + +    R = #export_from_case{val=0}, +    {ok,R} = export_from_case_2(false, R), +    {ok,#export_from_case{val=42}} = export_from_case_2(true, R), + +    ok. + +export_from_case_1(Bool) -> +    case Bool of +        true -> +            id(42), +            Result = a; +        false -> +            Result = b +    end, +    id(Result). + +export_from_case_2(Bool, Rec) -> +    case Bool of +        false -> +            Result = Rec; +        true -> +            Result = Rec#export_from_case{val=42} +    end, +    {ok,Result}. + +  id(I) -> I. diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl index ccb9b58225..0d6f8c6f98 100644 --- a/lib/compiler/test/guard_SUITE.erl +++ b/lib/compiler/test/guard_SUITE.erl @@ -35,7 +35,8 @@  	 basic_andalso_orelse/1,traverse_dcd/1,  	 check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1,  	 bad_constants/1,bad_guards/1, -	 guard_in_catch/1,beam_bool_SUITE/1]). +         guard_in_catch/1,beam_bool_SUITE/1, +         cover_beam_dead/1]).  suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -54,7 +55,8 @@ groups() ->         rel_ops,rel_op_combinations,         literal_type_tests,basic_andalso_orelse,traverse_dcd,         check_qlc_hrl,andalso_semi,t_tuple_size,binary_part, -       bad_constants,bad_guards,guard_in_catch,beam_bool_SUITE]}]. +       bad_constants,bad_guards,guard_in_catch,beam_bool_SUITE, +       cover_beam_dead]}].  init_per_suite(Config) ->      Config. @@ -1291,6 +1293,10 @@ rel_ops(Config) when is_list(Config) ->      true = any_atom /= id(42),      true = [] /= id(42), +    %% Coverage of beam_utils:bif_to_test/3 +    Empty = id([]), +    ?T(==, [], Empty), +      ok.  -undef(TestOp). @@ -1615,7 +1621,9 @@ type_tests() ->       is_reference,       is_port,       is_binary, -     is_function]. +     is_bitstring, +     is_function, +     is_map].  basic_andalso_orelse(Config) when is_list(Config) ->      T = id({type,integers,23,42}), @@ -2198,7 +2206,31 @@ maps() ->  evidence(#{0 := Charge}) when 0; #{[] => Charge} == #{[] => 42} ->      ok. +cover_beam_dead(_Config) -> +    Mod = ?FUNCTION_NAME, +    Attr = [], +    Fs = [{function,test,1,2, +           [{label,1}, +            {line,[]}, +            {func_info,{atom,Mod},{atom,test},1}, +            {label,2}, +            %% Cover beam_dead:turn_op/1 using swapped operand order. +            {test,is_ne_exact,{f,3},[{integer,1},{x,0}]}, +            {test,is_eq_exact,{f,1},[{atom,a},{x,0}]}, +            {label,3}, +            {move,{atom,ok},{x,0}}, +            return]}], +    Exp = [{test,1}], +    Asm = {Mod,Exp,Attr,Fs,3}, +    {ok,Mod,Beam} = compile:forms(Asm, [from_asm,binary,report]), +    {module,Mod} = code:load_binary(Mod, Mod, Beam), +    ok = Mod:test(1), +    ok = Mod:test(a), +    {'EXIT',_} = (catch Mod:test(other)), +    true = code:delete(Mod), +    _ = code:purge(Mod), +    ok.  %% Call this function to turn off constant propagation.  id(I) -> I. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 5e90b79aa2..f15917e3cb 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -695,8 +695,28 @@ t_is_map(Config) when is_list(Config) ->      if is_map(#{b=>1}) -> ok end,      if not is_map([1,2,3]) -> ok end,      if not is_map(x) -> ok end, + +    ok = do_t_is_map(map, #{}), +    error = do_t_is_map(map, {a,b,c}), +    ok = do_t_is_map(number, 42), +    ok = do_t_is_map(number, 42.0), +    error = do_t_is_map(number, {a,b,c}),      ok. +do_t_is_map(What, X) -> +    B = case What of +            map -> +                %% Cover conversion of is_map/1 BIF to test instruction +                %% in beam_utils:bif_to_test/3. +                is_map(X); +            number -> +                is_number(X) +        end, +    case B of +        true -> ok; +        false -> error +    end. +  % test map updates without matching  t_update_literals(Config) when is_list(Config) ->      Map = #{x=>1,y=>2,z=>3,q=>4}, diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 52b2da05f7..4b26a8dcdc 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -23,8 +23,9 @@  	 init_per_group/2,end_per_group/2,  	 pmatch/1,mixed/1,aliases/1,non_matching_aliases/1,  	 match_in_call/1,untuplify/1,shortcut_boolean/1,letify_guard/1, -	 selectify/1,underscore/1,match_map/1,map_vars_used/1, -	 coverage/1,grab_bag/1,literal_binary/1]). +	 selectify/1,deselectify/1,underscore/1,match_map/1,map_vars_used/1, +	 coverage/1,grab_bag/1,literal_binary/1, +         unary_op/1]).  -include_lib("common_test/include/ct.hrl"). @@ -38,9 +39,9 @@ groups() ->      [{p,[parallel],        [pmatch,mixed,aliases,non_matching_aliases,         match_in_call,untuplify, -       shortcut_boolean,letify_guard,selectify, +       shortcut_boolean,letify_guard,selectify,deselectify,         underscore,match_map,map_vars_used,coverage, -       grab_bag,literal_binary]}]. +       grab_bag,literal_binary,unary_op]}].  init_per_suite(Config) -> @@ -466,6 +467,66 @@ sel_same_value2(V) when V =:= 42; V =:= 43 ->  sel_same_value2(_) ->      error. +%% Test deconstruction of select_val instructions in beam_peep into +%% regular tests with just one possible value left. Hitting proper cases +%% in beam_peep relies on unification of labels by beam_jump. + +deselectify(Config) when is_list(Config) -> +    one_or_other = desel_tuple_arity({1}), +    two = desel_tuple_arity({1,1}), +    one_or_other = desel_tuple_arity({1,1,1}), + +    one_or_other = dsel_integer(1), +    two = dsel_integer(2), +    one_or_other = dsel_integer(3), + +    one_or_other = dsel_integer_typecheck(1), +    two = dsel_integer_typecheck(2), +    one_or_other = dsel_integer_typecheck(3), + +    one_or_other = dsel_atom(one), +    two = dsel_atom(two), +    one_or_other = dsel_atom(three), + +    one_or_other = dsel_atom_typecheck(one), +    two = dsel_atom_typecheck(two), +    one_or_other = dsel_atom_typecheck(three). + +desel_tuple_arity(Tuple) when is_tuple(Tuple) -> +    case Tuple of +        {_} -> one_or_other; +        {_,_} -> two; +        _ -> one_or_other +    end. + +dsel_integer(Val) -> +    case Val of +        1 -> one_or_other; +        2 -> two; +        _ -> one_or_other +    end. + +dsel_integer_typecheck(Val) when is_integer(Val) -> +    case Val of +        1 -> one_or_other; +        2 -> two; +        _ -> one_or_other +    end. + +dsel_atom(Val) -> +    case Val of +        one -> one_or_other; +        two -> two; +        _ -> one_or_other +    end. + +dsel_atom_typecheck(Val) when is_atom(Val) -> +    case Val of +        one -> one_or_other; +        two -> two; +        _ -> one_or_other +    end. +  underscore(Config) when is_list(Config) ->      case Config of  	[] -> @@ -557,6 +618,10 @@ grab_bag(_Config) ->  	 {bad,16#555555555555555555555555555555555555555555555555555}],      ok = grab_bag_remove_failure(L, unit, 0), +    {42,<<43,44>>} = grab_bag_single_valued(<<42,43,44>>), +    empty_list = grab_bag_single_valued([]), +    empty_tuple = grab_bag_single_valued({}), +      ok.  grab_bag_remove_failure([], _Unit, _MaxFailure) -> @@ -574,6 +639,12 @@ grab_bag_remove_failure([{stretch,_,Mi}=Stretch | Specs], Unit, _MaxFailure) ->  	    ok      end. +%% Cover a line v3_kernel that places binary matching first. +grab_bag_single_valued(<<H,T/bytes>>) -> {H,T}; +grab_bag_single_valued([]) -> empty_list; +grab_bag_single_valued({}) -> empty_tuple. + +  %% Regression in 19.0, reported by Alexei Sholik  literal_binary(_Config) ->      3 = literal_binary_match(bar, <<"y">>), @@ -592,5 +663,74 @@ literal_binary_match(_, <<"x">>) -> 2;  literal_binary_match(_, <<"y">>) -> 3;  literal_binary_match(_, _) -> fail. +unary_op(Config) -> +    %% ERL-514. This test case only verifies that the code +    %% calculates the correct result, not that the generated +    %% code is optimial. + +    {non_associative,30} = unary_op_1('&'), +    {non_associative,300} = unary_op_1('^'), +    {non_associative,300} = unary_op_1('not'), +    {non_associative,300} = unary_op_1('+'), +    {non_associative,300} = unary_op_1('-'), +    {non_associative,300} = unary_op_1('~~~'), +    {non_associative,300} = unary_op_1('!'), +    {non_associative,320} = unary_op_1('@'), + +    error = unary_op_1(Config), +    error = unary_op_1(abc), +    error = unary_op_1(42), + +    ok. + +unary_op_1(Vop@1) -> +    %% If all optimizations are working as they should, there should +    %% be no stack frame and all '=:=' tests should be coalesced into +    %% a single select_val instruction. + +    case Vop@1 =:= '&' of +        true -> +            {non_associative,30}; +        false -> +            case +                case Vop@1 =:= '^' of +                    true -> +                        true; +                    false -> +                        case Vop@1 =:= 'not' of +                            true -> +                                true; +                            false -> +                                case Vop@1 =:= '+' of +                                    true -> +                                        true; +                                    false -> +                                        case Vop@1 =:= '-' of +                                            true -> +                                                true; +                                            false -> +                                                case Vop@1 =:= '~~~' of +                                                    true -> +                                                        true; +                                                    false -> +                                                        Vop@1 =:= '!' +                                                end +                                        end +                                end +                        end +                end +            of +                true -> +                    {non_associative,300}; +                false -> +                    case Vop@1 =:= '@' of +                        true -> +                            {non_associative,320}; +                        false -> +                            error +                    end +            end +    end. +  id(I) -> I. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 4bd884d86b..4e39f4663e 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -161,16 +161,17 @@ md5_1(Beam) ->  %% Cover some code that handles internal errors.  silly_coverage(Config) when is_list(Config) -> -    %% sys_core_fold, sys_core_bsm, sys_core_setel, v3_kernel +    %% sys_core_fold, sys_core_alias, sys_core_bsm, sys_core_setel, v3_kernel      BadCoreErlang = {c_module,[],  		     name,[],[],  		     [{{c_var,[],{foo,2}},seriously_bad_body}]},      expect_error(fun() -> sys_core_fold:module(BadCoreErlang, []) end), +    expect_error(fun() -> sys_core_alias:module(BadCoreErlang, []) end),      expect_error(fun() -> sys_core_bsm:module(BadCoreErlang, []) end),      expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end),      expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end), -    %% v3_life +    %% v3_codegen      BadKernel = {k_mdef,[],?MODULE,  		 [{foo,0}],  		 [], @@ -178,11 +179,7 @@ silly_coverage(Config) when is_list(Config) ->  		   {k,[],[],[]},  		   f,0,[],  		   seriously_bad_body}]}, -    expect_error(fun() -> v3_life:module(BadKernel, []) end), - -    %% v3_codegen -    CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b,[]}]}, -    expect_error(fun() -> v3_codegen:module(CodegenInput, []) end), +    expect_error(fun() -> v3_codegen:module(BadKernel, []) end),      %% beam_a      BeamAInput = {?MODULE,[{foo,0}],[], @@ -321,8 +318,7 @@ expect_error(Fun) ->  	    io:format("~p", [Any]),  	    ct:fail(call_was_supposed_to_fail)      catch -	Class:Reason -> -	    Stk = erlang:get_stacktrace(), +	Class:Reason:Stk ->  	    io:format("~p:~p\n~p\n", [Class,Reason,Stk]),  	    case {Class,Reason} of  		{error,undef} -> @@ -363,9 +359,7 @@ integer_encoding_1(Config) ->      io:put_chars(Src, "t(Last) ->[\n"),      io:put_chars(Data, "[\n"), -    do_integer_encoding(-(id(1) bsl 10000), Src, Data), -    do_integer_encoding(id(1) bsl 10000, Src, Data), -    do_integer_encoding(1024, 0, Src, Data), +    do_integer_encoding(137, 0, Src, Data),      _ = [begin  	     B = 1 bsl I,  	     do_integer_encoding(-B-1, Src, Data), @@ -374,7 +368,7 @@ integer_encoding_1(Config) ->  	     do_integer_encoding(B-1, Src, Data),  	     do_integer_encoding(B, Src, Data),  	     do_integer_encoding(B+1, Src, Data) -	 end || I <- lists:seq(1, 128)], +	 end || I <- lists:seq(1, 130)],      io:put_chars(Src, "Last].\n\n"),      ok = file:close(Src),      io:put_chars(Data, "0].\n\n"), @@ -388,8 +382,6 @@ integer_encoding_1(Config) ->      %% Compare lists.      List = Mod:t(0),      {ok,[List]} = file:consult(DataFile), -    OneBsl10000 = id(1) bsl 10000, -    [-(1 bsl 10000),OneBsl10000|_] = List,      %% Cleanup.      file:delete(SrcFile), @@ -408,7 +400,3 @@ do_integer_encoding(I, Src, Data) ->      Str = integer_to_list(I),      io:put_chars(Src, [Str,",\n"]),      io:put_chars(Data, [Str,",\n"]). - -     -id(I) -> I. -     diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 8304672558..5e386790c0 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -222,9 +222,8 @@ do_ref_opt(Source, PrivDir) ->  		    collect_recv_opt_instrs(Code)  	end,  	ok -    catch Class:Error -> -	    io:format("~s: ~p ~p\n~p\n", -		      [Source,Class,Error,erlang:get_stacktrace()]), +    catch Class:Error:Stk -> +	    io:format("~s: ~p ~p\n~p\n", [Source,Class,Error,Stk]),  	    error      end. @@ -265,6 +264,10 @@ export(Config) when is_list(Config) ->      self() ! {result,Ref,42},      42 = export_1(Ref),      {error,timeout} = export_1(Ref), + +    self() ! {result,Ref}, +    {ok,Ref} = export_2(), +      ok.  export_1(Reference) -> @@ -281,6 +284,10 @@ export_1(Reference) ->      id({build,self()}),      Result. +export_2() -> +    receive {result,Result} -> ok end, +    {ok,Result}. +  wait(Config) when is_list(Config) ->      self() ! <<42>>,      <<42>> = wait_1(r, 1, 2), diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index a591d6cc93..d5a1dc642f 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -26,7 +26,8 @@  	 nested_of/1,nested_catch/1,nested_after/1,  	 nested_horrid/1,last_call_optimization/1,bool/1,  	 plain_catch_coverage/1,andalso_orelse/1,get_in_try/1, -	 hockey/1,handle_info/1,catch_in_catch/1,grab_bag/1]). +	 hockey/1,handle_info/1,catch_in_catch/1,grab_bag/1, +         stacktrace/1,nested_stacktrace/1,raise/1]).  -include_lib("common_test/include/ct.hrl"). @@ -42,7 +43,8 @@ groups() ->         after_oops,eclectic,rethrow,nested_of,nested_catch,         nested_after,nested_horrid,last_call_optimization,         bool,plain_catch_coverage,andalso_orelse,get_in_try, -       hockey,handle_info,catch_in_catch,grab_bag]}]. +       hockey,handle_info,catch_in_catch,grab_bag, +       stacktrace,nested_stacktrace,raise]}].  init_per_suite(Config) -> @@ -115,6 +117,16 @@ basic(Conf) when is_list(Conf) ->  	 catch nisse -> erro  	 end, +    %% Unmatchable clauses. +    try +        throw(thrown) +    catch +        {a,b}={a,b,c} ->                        %Intentionally no match. +            ok; +        thrown -> +            ok +    end, +      ok.  after_call() -> @@ -324,11 +336,11 @@ eclectic(Conf) when is_list(Conf) ->      {{error,{exit,V},{'EXIT',V}},V} =  	eclectic_1({foo,{error,{exit,V}}}, error, {value,V}),      {{value,{value,V},V}, -	   {'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}} = +	   {'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}} =  	eclectic_1({foo,{value,{value,V}}}, undefined, {'add',{0,a}}),      {{'EXIT',V},V} =  	eclectic_1({catch_foo,{exit,V}}, undefined, {throw,V}), -    {{error,{'div',{1,0}},{'EXIT',{badarith,[{?MODULE,my_div,2,_}|_]}}}, +    {{error,{'div',{1,0}},{'EXIT',{badarith,[{erlang,'div',[1,0],_},{?MODULE,my_div,2,_}|_]}}},  	   {'EXIT',V}} =  	eclectic_1({foo,{error,{'div',{1,0}}}}, error, {exit,V}),      {{{error,V},{'EXIT',{V,[{?MODULE,foo,1,_}|_]}}}, @@ -345,7 +357,7 @@ eclectic(Conf) when is_list(Conf) ->  	eclectic_2({error,{value,V}}, throw, {error,V}),      {{caught,{'EXIT',{badarg,[{erlang,abs,[V],_}|_]}}},V} =  	eclectic_2({value,{'abs',V}}, undefined, {value,V}), -    {{caught,{'EXIT',{badarith,[{?MODULE,my_add,2,_}|_]}}},V} = +    {{caught,{'EXIT',{badarith,[{erlang,'+',[0,a],_},{?MODULE,my_add,2,_}|_]}}},V} =  	eclectic_2({exit,{'add',{0,a}}}, exit, {value,V}),      {{caught,{'EXIT',V}},undefined} =  	eclectic_2({value,{error,V}}, undefined, {exit,V}), @@ -1039,5 +1051,217 @@ grab_bag(_Config) ->      ok. +stacktrace(_Config) -> +    V = [make_ref()|self()], +    case ?MODULE:module_info(native) of +        false -> +            {value2,{caught1,badarg,[{erlang,abs,[V],_}|_]}} = +                stacktrace_1({'abs',V}, error, {value,V}), +            {caught2,{error,badarith},[{erlang,'+',[0,a],_}, +                                       {?MODULE,my_add,2,_}|_]} = +                stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}); +        true -> +            {value2,{caught1,badarg,[{?MODULE,my_abs,1,_}|_]}} = +                stacktrace_1({'abs',V}, error, {value,V}), +            {caught2,{error,badarith},[{?MODULE,my_add,2,_}|_]} = +                stacktrace_1({'div',{1,0}}, error, {'add',{0,a}}) +    end, +    {caught2,{error,{try_clause,V}},[{?MODULE,stacktrace_1,3,_}|_]} = +        stacktrace_1({value,V}, error, {value,V}), +    {caught2,{throw,V},[{?MODULE,foo,1,_}|_]} = +        stacktrace_1({value,V}, error, {throw,V}), + +    try +        stacktrace_2() +    catch +        error:{badmatch,_}:Stk2 -> +            [{?MODULE,stacktrace_2,0,_}, +             {?MODULE,stacktrace,1,_}|_] = Stk2, +            Stk2 = erlang:get_stacktrace(), +            ok +    end, + +    try +        stacktrace_3(a, b) +    catch +        error:function_clause:Stk3 -> +            Stk3 = erlang:get_stacktrace(), +            case lists:module_info(native) of +                false -> +                    [{lists,prefix,[a,b],_}|_] = Stk3; +                true -> +                    [{lists,prefix,2,_}|_] = Stk3 +            end +    end, + +    try +        throw(x) +    catch +        throw:x:IntentionallyUnused -> +            ok +    end. + +stacktrace_1(X, C1, Y) -> +    try try foo(X) of +            C1 -> value1 +        catch +            C1:D1:Stk1 -> +                Stk1 = erlang:get_stacktrace(), +                {caught1,D1,Stk1} +        after +            foo(Y) +        end of +        V2 -> {value2,V2} +    catch +        C2:D2:Stk2 -> {caught2,{C2,D2},Stk2=erlang:get_stacktrace()} +    end. + +stacktrace_2() -> +    ok = erlang:process_info(self(), current_function), +    ok. + +stacktrace_3(A, B) -> +    {ok,lists:prefix(A, B)}. + +nested_stacktrace(_Config) -> +    V = [{make_ref()}|[self()]], +    value1 = nested_stacktrace_1({{value,{V,x1}},void,{V,x1}}, +                                 {void,void,void}), +    case ?MODULE:module_info(native) of +        false -> +            {caught1, +             [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_], +             value2} = +                nested_stacktrace_1({{'add',{V,x1}},error,badarith}, +                                    {{value,{V,x2}},void,{V,x2}}), +            {caught1, +             [{erlang,'+',[V,x1],_},{?MODULE,my_add,2,_}|_], +             {caught2,[{erlang,abs,[V],_}|_]}} = +                nested_stacktrace_1({{'add',{V,x1}},error,badarith}, +                                    {{'abs',V},error,badarg}); +        true -> +            {caught1, +             [{?MODULE,my_add,2,_}|_], +             value2} = +                nested_stacktrace_1({{'add',{V,x1}},error,badarith}, +                                    {{value,{V,x2}},void,{V,x2}}), +            {caught1, +             [{?MODULE,my_add,2,_}|_], +             {caught2,[{?MODULE,my_abs,1,_}|_]}} = +                nested_stacktrace_1({{'add',{V,x1}},error,badarith}, +                                    {{'abs',V},error,badarg}) +    end, +    ok. + +nested_stacktrace_1({X1,C1,V1}, {X2,C2,V2}) -> +    try foo(X1) of +        V1 -> value1 +    catch +        C1:V1:S1 -> +            S1 = erlang:get_stacktrace(), +            T2 = try foo(X2) of +                     V2 -> value2 +                 catch +                     C2:V2:S2 -> +                         S2 = erlang:get_stacktrace(), +                         {caught2,S2} +                 end, +            {caught1,S1,T2} +    end. + +raise(_Config) -> +    test_raise(fun() -> exit({exit,tuple}) end), +    test_raise(fun() -> abs(id(x)) end), +    test_raise(fun() -> throw({was,thrown}) end), + +    badarg = bad_raise(fun() -> abs(id(x)) end), + +    ok. + +bad_raise(Expr) -> +    try +        Expr() +    catch +        _:E:Stk -> +            erlang:raise(bad_class, E, Stk) +    end. + +test_raise(Expr) -> +    test_raise_1(Expr), +    test_raise_2(Expr), +    test_raise_3(Expr). + +test_raise_1(Expr) -> +    erase(exception), +    try +        do_test_raise_1(Expr) +    catch +        C:E:Stk -> +            {C,E,Stk} = erase(exception) +    end. + +do_test_raise_1(Expr) -> +    try +        Expr() +    catch +        C:E:Stk -> +            %% Here the stacktrace must be built. +            put(exception, {C,E,Stk}), +            erlang:raise(C, E, Stk) +    end. + +test_raise_2(Expr) -> +    erase(exception), +    try +        do_test_raise_2(Expr) +    catch +        C:E:Stk -> +            {C,E} = erase(exception), +            try +                Expr() +            catch +                _:_:S -> +                    [StkTop|_] = S, +                    [StkTop|_] = Stk +            end +    end. + +do_test_raise_2(Expr) -> +    try +        Expr() +    catch +        C:E:Stk -> +            %% Here it is possible to replace erlang:raise/3 with +            %% the raw_raise/3 instruction since the stacktrace is +            %% not actually used. +            put(exception, {C,E}), +            erlang:raise(C, E, Stk) +    end. + +test_raise_3(Expr) -> +    try +        do_test_raise_3(Expr) +    catch +        exit:{exception,C,E}:Stk -> +            try +                Expr() +            catch +                C:E:S -> +                    [StkTop|_] = S, +                    [StkTop|_] = Stk +            end +    end. + +do_test_raise_3(Expr) -> +    try +        Expr() +    catch +        C:E:Stk -> +            %% Here it is possible to replace erlang:raise/3 with +            %% the raw_raise/3 instruction since the stacktrace is +            %% not actually used. +            erlang:raise(exit, {exception,C,E}, Stk) +    end. +  id(I) -> I. diff --git a/lib/compiler/test/z_SUITE.erl b/lib/compiler/test/z_SUITE.erl index d864184f4c..cd95d0e733 100644 --- a/lib/compiler/test/z_SUITE.erl +++ b/lib/compiler/test/z_SUITE.erl @@ -54,8 +54,7 @@ do_loaded([{M,_}|Ms], E0) ->  	    _ = M:module_info(functions),  	    E0  	catch -	    C:Error -> -		Stk = erlang:get_stacktrace(), +	    C:Error:Stk ->  		io:format("~p:~p\n~p\n", [C,Error,Stk]),  		E0 + 1  	end, | 
