diff options
Diffstat (limited to 'lib/compiler')
45 files changed, 1155 insertions, 744 deletions
diff --git a/lib/compiler/doc/src/Makefile b/lib/compiler/doc/src/Makefile index ee41a7074f..308e9c4d02 100644 --- a/lib/compiler/doc/src/Makefile +++ b/lib/compiler/doc/src/Makefile @@ -99,14 +99,14 @@ clean clean_docs: include $(ERL_TOP)/make/otp_release_targets.mk release_docs_spec: docs - $(INSTALL_DIR) $(RELSYSDIR)/doc/pdf - $(INSTALL_DATA) $(TOP_PDF_FILE) $(RELSYSDIR)/doc/pdf - $(INSTALL_DIR) $(RELSYSDIR)/doc/html + $(INSTALL_DIR) "$(RELSYSDIR)/doc/pdf" + $(INSTALL_DATA) $(TOP_PDF_FILE) "$(RELSYSDIR)/doc/pdf" + $(INSTALL_DIR) "$(RELSYSDIR)/doc/html" $(INSTALL_DATA) $(HTMLDIR)/* \ - $(RELSYSDIR)/doc/html - $(INSTALL_DATA) $(INFO_FILE) $(RELSYSDIR) - $(INSTALL_DIR) $(RELEASE_PATH)/man/man3 - $(INSTALL_DATA) $(MAN3DIR)/* $(RELEASE_PATH)/man/man3 + "$(RELSYSDIR)/doc/html" + $(INSTALL_DATA) $(INFO_FILE) "$(RELSYSDIR)" + $(INSTALL_DIR) "$(RELEASE_PATH)/man/man3" + $(INSTALL_DATA) $(MAN3DIR)/* "$(RELEASE_PATH)/man/man3" release_spec: diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml index 522c1dc411..be9eb1cd75 100644 --- a/lib/compiler/doc/src/compile.xml +++ b/lib/compiler/doc/src/compile.xml @@ -4,7 +4,7 @@ <erlref> <header> <copyright> - <year>1996</year><year>2011</year> + <year>1996</year><year>2012</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> @@ -294,6 +294,12 @@ module.beam: module.erl \ describing what it is doing.</p> </item> + <tag><c>{source,FileName}</c></tag> + <item> + <p>Sets the value of the source, as returned by + <c>module_info(compile)</c>.</p> + </item> + <tag><c>{outdir,Dir}</c></tag> <item> <p>Sets a new directory for the object code. The current @@ -333,7 +339,8 @@ module.beam: module.erl \ <tag><c>{d,Macro,Value}</c></tag> <item> <p>Defines a macro <c>Macro</c> to have the value - <c>Value</c>. The default is <c>true</c>).</p> + <c>Value</c>. <c>Macro</c> is of type atom, and <c>Value</c> can be any term. + The default <c>Value</c> is <c>true</c>.</p> </item> <tag><c>{parse_transform,Module}</c></tag> diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml index 3f53a71764..e2a921a6f2 100644 --- a/lib/compiler/doc/src/notes.xml +++ b/lib/compiler/doc/src/notes.xml @@ -31,6 +31,75 @@ <p>This document describes the changes made to the Compiler application.</p> +<section><title>Compiler 4.8.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + In rare circumstance, the compiler could crash when + compiling a case statement. (Thanks to Hakan Mattsson.)</p> + <p> + Own Id: OTP-9842</p> + </item> + <item> + <p>Calling a guard test (such as is_list/1) from the + top-level in a guard, would cause a compiler crash if + there was a local definition with the same name. + Corrected to reject the program with an error + message.</p> + <p> + Own Id: OTP-9866</p> + </item> + <item> + <p>Using <c>get/1</c> in a <c>try</c> block could in some + cases cause an internal compiler error. (Thanks to Eric + Merritt.)</p> + <p> + Own Id: OTP-9867</p> + </item> + <item> + <p> + An unexported on_load function would not get run if the + module was compiled with the <c>inline</c> option. + (Thanks to Yiannis Tsiouris.)</p> + <p> + Own Id: OTP-9910</p> + </item> + <item> + <p> + Fixed a discrepancy in compile_info</p> + <p> + The BEAM disassembler used the atom 'none' to signify the + absence of a compile_info chunk in a .beam file. This + clashed with the type declaration of the compile_info + field of a #beam_file{} record as containing a list. Now + [] signifies the absence of this chunk. This simplifies + the code and avoids a dialyzer warning.</p> + <p> + Own Id: OTP-9917</p> + </item> + <item> + <p> + Fix typo in `compile' doc: unmatched parenthesis (Thanks + to Ricardo Catalinas Jim�nez)</p> + <p> + Own Id: OTP-9919</p> + </item> + <item> + <p>In a <c>try</c>...<c>catch</c> statement that always + returned <c>false</c>, the compiler would remove calls to + BIFs that could not cause an exception (such as + <c>put/2</c>). Example of such code: <c>try put(K, V), + false catch _:_ -> false end.</c></p> + <p> + Own Id: OTP-9982</p> + </item> + </list> + </section> + +</section> + <section><title>Compiler 4.8</title> <section><title>Fixed Bugs and Malfunctions</title> diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile index 7a237608ad..56c45d369c 100644 --- a/lib/compiler/src/Makefile +++ b/lib/compiler/src/Makefile @@ -53,6 +53,7 @@ MODULES = \ beam_dead \ beam_dict \ beam_disasm \ + beam_except \ beam_flatten \ beam_jump \ beam_listing \ @@ -162,11 +163,11 @@ $(EBIN)/cerl_inline.beam: $(ESRC)/cerl_inline.erl include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt - $(INSTALL_DIR) $(RELSYSDIR)/src + $(INSTALL_DIR) "$(RELSYSDIR)/src" $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(EXTRA_FILES) \ - $(YRL_FILE) $(RELSYSDIR)/src - $(INSTALL_DIR) $(RELSYSDIR)/ebin - $(INSTALL_DATA) $(INSTALL_FILES) $(RELSYSDIR)/ebin + $(YRL_FILE) "$(RELSYSDIR)/src" + $(INSTALL_DIR) "$(RELSYSDIR)/ebin" + $(INSTALL_DATA) $(INSTALL_FILES) "$(RELSYSDIR)/ebin" release_docs_spec: diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 7103d2390f..62bdc74cc8 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2000-2011. All Rights Reserved. +%% Copyright Ericsson AB 2000-2012. 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 @@ -182,10 +182,14 @@ process_chunks(F) -> Literals = beam_disasm_literals(LiteralBin), Code = beam_disasm_code(CodeBin, Atoms, mk_imports(ImportsList), StrBin, Lambdas, Literals, Module), - Attributes = optional_chunk(F, attributes), + Attributes = + case optional_chunk(F, attributes) of + none -> []; + Atts when is_list(Atts) -> Atts + end, CompInfo = case optional_chunk(F, "CInf") of - none -> none; + none -> []; CompInfoBin when is_binary(CompInfoBin) -> binary_to_term(CompInfoBin) end, @@ -198,7 +202,7 @@ process_chunks(F) -> end. %%----------------------------------------------------------------------- -%% Retrieve an optional chunk or none if the chunk doesn't exist. +%% Retrieve an optional chunk or return 'none' if the chunk doesn't exist. %%----------------------------------------------------------------------- optional_chunk(F, ChunkTag) -> diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl new file mode 100644 index 0000000000..fb1a43cd9e --- /dev/null +++ b/lib/compiler/src/beam_except.erl @@ -0,0 +1,149 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. 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% +%% + +-module(beam_except). +-export([module/2]). + +%%% Rewrite certain calls to erlang:error/{1,2} to specialized +%%% instructions: +%%% +%%% erlang:error({badmatch,Value}) => badmatch Value +%%% erlang:error({case_clause,Value}) => case_end Value +%%% erlang:error({try_clause,Value}) => try_case_end Value +%%% erlang:error(if_clause) => if_end +%%% erlang:error(function_clause, Args) => jump FuncInfoLabel +%%% + +-import(lists, [reverse/1]). + +module({Mod,Exp,Attr,Fs0,Lc}, _Opt) -> + Fs = [function(F) || F <- Fs0], + {ok,{Mod,Exp,Attr,Fs,Lc}}. + +function({function,Name,Arity,CLabel,Is0}) -> + try + Is = function_1(Is0), + {function,Name,Arity,CLabel,Is} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. + +-record(st, + {lbl, %func_info label + loc %location for func_info + }). + +function_1(Is0) -> + case Is0 of + [{label,Lbl},{line,Loc}|_] -> + St = #st{lbl=Lbl,loc=Loc}, + translate(Is0, St, []); + [{label,_}|_] -> + %% No line numbers. The source must be a .S file. + %% There is no need to do anything. + Is0 + end. + +translate([{call_ext,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) -> + translate_1(Ar, I, Is, St, Acc); +translate([{call_ext_only,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) -> + translate_1(Ar, I, Is, St, Acc); +translate([{call_ext_last,Ar,{extfunc,erlang,error,Ar},_}=I|Is], St, Acc) -> + translate_1(Ar, I, Is, St, Acc); +translate([I|Is], St, Acc) -> + translate(Is, St, [I|Acc]); +translate([], _, Acc) -> + reverse(Acc). + +translate_1(Ar, I, Is, St, [{line,_}=Line|Acc1]=Acc0) -> + case dig_out(Ar, Acc1) of + no -> + translate(Is, St, [I|Acc0]); + {yes,function_clause,Acc2} -> + case {Line,St} of + {{line,Loc},#st{lbl=Fi,loc=Loc}} -> + Instr = {jump,{f,Fi}}, + translate(Is, St, [Instr|Acc2]); + {_,_} -> + %% This must be "error(function_clause, Args)" in + %% the Erlang source code. Don't translate. + translate(Is, St, [I|Acc0]) + end; + {yes,Instr,Acc2} -> + translate(Is, St, [Instr,Line|Acc2]) + end. + +dig_out(Ar, [{kill,_}|Is]) -> + dig_out(Ar, Is); +dig_out(1, [{block,Bl0}|Is]) -> + case dig_out_block(reverse(Bl0)) of + no -> no; + {yes,What,[]} -> + {yes,What,Is}; + {yes,What,Bl} -> + {yes,What,[{block,Bl}|Is]} + end; +dig_out(2, [{block,Bl}|Is]) -> + case dig_out_block_fc(Bl) of + no -> no; + {yes,What} -> {yes,What,Is} + end; +dig_out(_, _) -> no. + +dig_out_block([{set,[{x,0}],[{atom,if_clause}],move}]) -> + {yes,if_end,[]}; +dig_out_block([{set,[{x,0}],[{literal,{Exc,Value}}],move}|Is]) -> + translate_exception(Exc, {literal,Value}, Is, 0); +dig_out_block([{set,[{x,0}],[Tuple],move}, + {set,[],[Value],put}, + {set,[],[{atom,Exc}],put}, + {set,[Tuple],[],{put_tuple,2}}|Is]) -> + translate_exception(Exc, Value, Is, 3); +dig_out_block([{set,[],[Value],put}, + {set,[],[{atom,Exc}],put}, + {set,[{x,0}],[],{put_tuple,2}}|Is]) -> + translate_exception(Exc, Value, Is, 3); +dig_out_block(_) -> no. + +translate_exception(badmatch, Val, Is, Words) -> + {yes,{badmatch,Val},fix_block(Is, Words)}; +translate_exception(case_clause, Val, Is, Words) -> + {yes,{case_end,Val},fix_block(Is, Words)}; +translate_exception(try_clause, Val, Is, Words) -> + {yes,{try_case_end,Val},fix_block(Is, Words)}; +translate_exception(_, _, _, _) -> no. + +fix_block(Is, 0) -> + reverse(Is); +fix_block(Is0, Words) -> + [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] = reverse(Is0), + [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is]. + +dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) -> + dig_out_fc(Bl, Live-1, nil); +dig_out_block_fc(_) -> no. + +dig_out_fc([{set,[Dst],[{x,Reg},Dst0],put_list}|Is], Reg, Dst0) -> + dig_out_fc(Is, Reg-1, Dst); +dig_out_fc([{set,[{x,0}],[{atom,function_clause}],move}], -1, {x,1}) -> + {yes,function_clause}; +dig_out_fc(_, _, _) -> no. diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 6f0ffb5b25..d307d192b2 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -29,10 +29,17 @@ module({Mod,Exp,Attr,Fs0,Lc}, _Opts) -> {ok,{Mod,Exp,Attr,Fs,Lc}}. function({function,Name,Arity,CLabel,Asm0}) -> - Asm1 = beam_utils:live_opt(Asm0), - Asm2 = opt(Asm1, [], tdb_new()), - Asm = beam_utils:delete_live_annos(Asm2), - {function,Name,Arity,CLabel,Asm}. + try + Asm1 = beam_utils:live_opt(Asm0), + Asm2 = opt(Asm1, [], tdb_new()), + Asm = beam_utils:delete_live_annos(Asm2), + {function,Name,Arity,CLabel,Asm} + catch + Class:Error -> + Stack = erlang:get_stacktrace(), + io:fwrite("Function: ~w/~w\n", [Name,Arity]), + erlang:raise(Class, Error, Stack) + end. %% opt([Instruction], Accumulator, TypeDb) -> {[Instruction'],TypeDb'} %% Keep track of type information; try to simplify. diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index a631b8cd69..194f089ba1 100644 --- a/lib/compiler/src/beam_utils.erl +++ b/lib/compiler/src/beam_utils.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2011. All Rights Reserved. +%% Copyright Ericsson AB 2007-2012. 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 @@ -474,8 +474,15 @@ check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) -> end; check_liveness(R, [{try_end,Y}|Is], St) -> case R of - Y -> {killed,St}; - _ -> check_liveness(R, Is, St) + Y -> + {killed,St}; + {y,_} -> + %% y registers will be used if an exception occurs and + %% control transfers to the label given in the previous + %% try/2 instruction. + {used,St}; + _ -> + check_liveness(R, Is, St) end; check_liveness(R, [{catch_end,Y}|Is], St) -> case R of @@ -734,6 +741,9 @@ live_opt([{badmatch,Src}=I|Is], _, D, Acc) -> live_opt([{case_end,Src}=I|Is], _, D, Acc) -> Regs = x_live([Src], 0), live_opt(Is, Regs, D, [I|Acc]); +live_opt([{try_case_end,Src}=I|Is], _, D, Acc) -> + Regs = x_live([Src], 0), + live_opt(Is, Regs, D, [I|Acc]); live_opt([if_end=I|Is], _, D, Acc) -> Regs = 0, live_opt(Is, Regs, D, [I|Acc]); @@ -795,8 +805,6 @@ live_opt([{deallocate,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{kill,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); -live_opt([{try_case_end,_}=I|Is], Regs, D, Acc) -> - live_opt(Is, Regs, D, [I|Acc]); live_opt([{try_end,_}=I|Is], Regs, D, Acc) -> live_opt(Is, Regs, D, [I|Acc]); live_opt([{loop_rec_end,_}=I|Is], Regs, D, Acc) -> diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index a52e7bb761..9f0bca9dd5 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -783,15 +783,27 @@ valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) -> valfun_4({bs_bits_to_bytes,{f,Fail},Src,Dst}, Vst) -> assert_term(Src, Vst), set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst)); -valfun_4({bs_init2,{f,Fail},_,Heap,Live,_,Dst}, Vst0) -> +valfun_4({bs_init2,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), + if + is_integer(Sz) -> + ok; + true -> + assert_term(Sz, Vst0) + end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst3 = prune_x_regs(Live, Vst2), Vst = bs_zero_bits(Vst3), set_type_reg(binary, Dst, Vst); -valfun_4({bs_init_bits,{f,Fail},_,Heap,Live,_,Dst}, Vst0) -> +valfun_4({bs_init_bits,{f,Fail},Sz,Heap,Live,_,Dst}, Vst0) -> verify_live(Live, Vst0), + if + is_integer(Sz) -> + ok; + true -> + assert_term(Sz, Vst0) + end, Vst1 = heap_alloc(Heap, Vst0), Vst2 = branch_state(Fail, Vst1), Vst3 = prune_x_regs(Live, Vst2), diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl index c15103999f..2e7554c1ff 100644 --- a/lib/compiler/src/cerl_inline.erl +++ b/lib/compiler/src/cerl_inline.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2010. All Rights Reserved. +%% Copyright Ericsson AB 2001-2012. 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 @@ -1262,8 +1262,9 @@ i_receive_1(E, Cs, T, B, S) -> i_module(E, Ctxt, Ren, Env, S) -> %% Cf. `i_letrec'. Note that we pass a dummy constant value for the %% "body" parameter. + Exps = i_module_exports(E), {Es, _, Xs1, S1} = i_letrec(module_defs(E), void(), - module_exports(E), Ctxt, Ren, Env, S), + Exps, Ctxt, Ren, Env, S), %% Sanity check: case Es of [] -> @@ -1276,6 +1277,27 @@ i_module(E, Ctxt, Ren, Env, S) -> E1 = update_c_module(E, module_name(E), Xs1, module_attrs(E), Es), {E1, count_size(weight(module), S1)}. +i_module_exports(E) -> + %% If a function is named in an `on_load' attribute, we will + %% pretend that it is exported to ensure that it will not be removed. + Exps = module_exports(E), + Attrs = module_attrs(E), + case i_module_on_load(Attrs) of + none -> + Exps; + [{_,_}=FA] -> + ordsets:add_element(c_var(FA), Exps) + end. + +i_module_on_load([{Key,Val}|T]) -> + case concrete(Key) of + on_load -> + concrete(Val); + _ -> + i_module_on_load(T) + end; +i_module_on_load([]) -> none. + %% Binary-syntax expressions are too complicated to do anything %% interesting with here - that is beyond the scope of this program; %% also, their construction could have side effects, so even in effect diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index a17a10046e..7365706b94 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -146,10 +146,17 @@ env_default_opts() -> do_compile(Input, Opts0) -> Opts = expand_opts(Opts0), - Self = self(), - Serv = spawn_link(fun() -> internal(Self, Input, Opts) end), + {Pid,Ref} = + spawn_monitor(fun() -> + exit(try + internal(Input, Opts) + catch + error:Reason -> + {error,Reason} + end) + end), receive - {Serv,Rep} -> Rep + {'DOWN',Ref,process,Pid,Rep} -> Rep end. expand_opts(Opts0) -> @@ -242,15 +249,12 @@ format_error({module_name,Mod,Filename}) -> errors=[], warnings=[]}). -internal(Master, Input, Opts) -> - Master ! {self(), try internal(Input, Opts) - catch error:Reason -> {error, Reason} - end}. - -internal({forms,Forms}, Opts) -> - {_,Ps} = passes(forms, Opts), - internal_comp(Ps, "", "", #compile{code=Forms,options=Opts, - mod_options=Opts}); +internal({forms,Forms}, Opts0) -> + {_,Ps} = passes(forms, Opts0), + Source = proplists:get_value(source, Opts0, ""), + Opts1 = proplists:delete(source, Opts0), + Compile = #compile{code=Forms,options=Opts1,mod_options=Opts1}, + internal_comp(Ps, Source, "", Compile); internal({file,File}, Opts) -> {Ext,Ps} = passes(file, Opts), Compile = #compile{options=Opts,mod_options=Opts}, @@ -629,6 +633,8 @@ asm_passes() -> [{unless,no_postopt, [{pass,beam_block}, {iff,dblk,{listing,"block"}}, + {unless,no_except,{pass,beam_except}}, + {iff,dexcept,{listing,"except"}}, {unless,no_bopt,{pass,beam_bool}}, {iff,dbool,{listing,"bool"}}, {unless,no_topt,{pass,beam_type}}, diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src index fb06f2521c..1133882728 100644 --- a/lib/compiler/src/compiler.app.src +++ b/lib/compiler/src/compiler.app.src @@ -28,6 +28,7 @@ beam_dead, beam_dict, beam_disasm, + beam_except, beam_flatten, beam_jump, beam_listing, diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl index 6ea67741fa..18fba7962b 100644 --- a/lib/compiler/src/sys_core_fold.erl +++ b/lib/compiler/src/sys_core_fold.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2012. 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 @@ -150,14 +150,26 @@ guard(Expr, Sub) -> opt_guard_try(#c_seq{arg=Arg,body=Body0}=Seq) -> Body = opt_guard_try(Body0), case {Arg,Body} of - {#c_call{},#c_literal{val=false}} -> - %% We have sequence consisting of a call (evaluted - %% for a possible exception only), followed by 'false'. - %% Since the sequence is inside a try block that will + {#c_call{module=#c_literal{val=Mod}, + name=#c_literal{val=Name}, + args=Args},#c_literal{val=false}} -> + %% We have sequence consisting of a call (evaluated + %% for a possible exception and/or side effect only), + %% followed by 'false'. + %% Since the sequence is inside a try block that will %% default to 'false' if any exception occurs, not %% evalutating the call will not change the behaviour - %% of the guard. - Body; + %% provided that the call has no side effects. + case erl_bifs:is_pure(Mod, Name, length(Args)) of + false -> + %% Not a pure BIF (meaning that this is not + %% a guard and that we must keep the call). + Seq#c_seq{body=Body}; + true -> + %% The BIF has no side effects, so it can + %% be safely removed. + Body + end; {_,_} -> Seq#c_seq{body=Body} end; @@ -1747,36 +1759,26 @@ opt_bool_clauses([_|_], _, _) -> %% end. NewVar -> %% erlang:error(badarg) %% end. -%% -%% We add the extra match-all clause at the end only if Expr is -%% not guaranteed to evaluate to a boolean. opt_bool_not(#c_case{arg=Arg,clauses=Cs0}=Case0) -> case Arg of #c_call{anno=Anno,module=#c_literal{val=erlang}, name=#c_literal{val='not'}, args=[Expr]} -> - Cs = opt_bool_not(Anno, Expr, Cs0), + Cs = [opt_bool_not_invert(C) || C <- Cs0] ++ + [#c_clause{anno=[compiler_generated], + pats=[#c_var{name=cor_variable}], + guard=#c_literal{val=true}, + body=#c_call{anno=Anno, + module=#c_literal{val=erlang}, + name=#c_literal{val=error}, + args=[#c_literal{val=badarg}]}}], Case = Case0#c_case{arg=Expr,clauses=Cs}, opt_bool_not(Case); _ -> opt_bool_case_redundant(Case0) end. -opt_bool_not(Anno, Expr, Cs) -> - Tail = case is_bool_expr(Expr) of - false -> - [#c_clause{anno=[compiler_generated], - pats=[#c_var{name=cor_variable}], - guard=#c_literal{val=true}, - body=#c_call{anno=Anno, - module=#c_literal{val=erlang}, - name=#c_literal{val=error}, - args=[#c_literal{val=badarg}]}}]; - true -> [] - end, - [opt_bool_not_invert(C) || C <- Cs] ++ Tail. - opt_bool_not_invert(#c_clause{pats=[#c_literal{val=Bool}]}=C) -> C#c_clause{pats=[#c_literal{val=not Bool}]}. @@ -2065,32 +2067,7 @@ opt_case_in_let_2(V, Arg0, (_) -> false end, Es), %Only variables in tuple false = core_lib:is_var_used(V, B), %Built tuple must not be used. Arg1 = tuple_to_values(Arg0, length(Es)), %Might fail. - #c_let{vars=Es,arg=Arg1,body=B}; -opt_case_in_let_2(_, Arg, Cs) -> - %% simplify_bool_case(Case0) -> Case - %% Remove unecessary cases like - %% - %% case BoolExpr of - %% true -> true; - %% false -> false; - %% .... - %% end - %% - %% where BoolExpr is an expression that can only return true - %% or false (or throw an exception). - - true = is_bool_case(Cs) andalso is_bool_expr(Arg), - Arg. - -is_bool_case([A,B|_]) -> - (is_bool_clause(true, A) andalso is_bool_clause(false, B)) - orelse (is_bool_clause(false, A) andalso is_bool_clause(true, B)). - -is_bool_clause(Bool, #c_clause{pats=[#c_literal{val=Bool}], - guard=#c_literal{val=true}, - body=#c_literal{val=Bool}}) -> - true; -is_bool_clause(_, _) -> false. + #c_let{vars=Es,arg=Arg1,body=B}. %% is_simple_case_arg(Expr) -> true|false %% Determine whether the Expr is simple enough to be worth @@ -2612,14 +2589,14 @@ bsm_maybe_ctx_to_binary(V, B) -> body=B} end. -previous_ctx_to_binary(V, #c_seq{arg=#c_primop{name=Name,args=As}}) -> - case {Name,As} of - {#c_literal{val=bs_context_to_binary},[#c_var{name=V}]} -> +previous_ctx_to_binary(V, Core) -> + case Core of + #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary}, + args=[#c_var{name=V}]}} -> true; - {_,_} -> + _ -> false - end; -previous_ctx_to_binary(_, _) -> false. + end. %% bsm_leftmost(Cs) -> none | ArgumentNumber %% Find the leftmost argument that does binary matching. Return @@ -2641,9 +2618,9 @@ bsm_leftmost_2([_|Ps], Cs, N, Pos) -> bsm_leftmost_2([], Cs, _, Pos) -> bsm_leftmost_1(Cs, Pos). -%% bsm_notempty(Cs, Pos) -> true|false +%% bsm_nonempty(Cs, Pos) -> true|false %% Check if at least one of the clauses matches a non-empty -%% binary in the given argumet position. +%% binary in the given argument position. %% bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) -> case nth(Pos, Ps) of @@ -2704,7 +2681,7 @@ bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) -> %% %% But if the clauses can't be freely rearranged, as in %% - %% b(Var, <<>>) -> ... + %% b(Var, <<X>>) -> ... %% b(1, 2) -> ... %% %% we do have a problem. @@ -2764,22 +2741,20 @@ add_bin_opt_info(Core, Term) -> end. add_warning(Core, Term) -> - Anno = core_lib:get_anno(Core), - case lists:member(compiler_generated, Anno) of - true -> ok; + case is_compiler_generated(Core) of + true -> + ok; false -> - case get_line(Anno) of - Line when Line >= 0 -> %Must be positive. - File = get_file(Anno), - Key = {?MODULE,warnings}, - case get(Key) of - [{File,[{Line,?MODULE,Term}]}|_] -> - ok; %We already have + Anno = core_lib:get_anno(Core), + Line = get_line(Anno), + File = get_file(Anno), + Key = {?MODULE,warnings}, + case get(Key) of + [{File,[{Line,?MODULE,Term}]}|_] -> + ok; %We already have %an identical warning. - Ws -> - put(Key, [{File,[{Line,?MODULE,Term}]}|Ws]) - end; - _ -> ok %Compiler-generated code. + Ws -> + put(Key, [{File,[{Line,?MODULE,Term}]}|Ws]) end end. @@ -2793,14 +2768,7 @@ get_file([]) -> "no_file". % should not happen is_compiler_generated(Core) -> Anno = core_lib:get_anno(Core), - case lists:member(compiler_generated, Anno) of - true -> true; - false -> - case get_line(Anno) of - Line when Line >= 0 -> false; - _ -> true - end - end. + member(compiler_generated, Anno). get_warnings() -> ordsets:from_list((erase({?MODULE,warnings}))). diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl index ba9cde1de0..6cea783090 100644 --- a/lib/compiler/src/sys_pre_expand.erl +++ b/lib/compiler/src/sys_pre_expand.erl @@ -42,7 +42,7 @@ compile=[], %Compile flags attributes=[], %Attributes callbacks=[], %Callbacks - defined=[], %Defined functions + defined, %Defined functions (gb_set) vcount=0, %Variable counter func=[], %Current function arity=[], %Arity for current function @@ -83,7 +83,7 @@ module(Fs0, Opts0) -> {Efs,St2} = expand_pmod(Tfs, St1), %% Get the correct list of exported functions. Exports = case member(export_all, St2#expand.compile) of - true -> St2#expand.defined; + true -> gb_sets:to_list(St2#expand.defined); false -> St2#expand.exports end, %% Generate all functions from stored info. @@ -106,10 +106,11 @@ expand_pmod(Fs0, St0) -> true -> Ps0 end, + Def = gb_sets:to_list(St0#expand.defined), {Fs1,Xs,Ds} = sys_expand_pmod:forms(Fs0, Ps, St0#expand.exports, - St0#expand.defined), - St1 = St0#expand{exports=Xs, defined=Ds}, + Def), + St1 = St0#expand{exports=Xs,defined=gb_sets:from_list(Ds)}, {Fs2,St2} = add_instance(Ps, Fs1, St1), {Fs3,St3} = ensure_new(Base, Ps0, Fs2, St2), {Fs3,St3#expand{attributes = [{abstract, 0, [true]} @@ -118,7 +119,7 @@ expand_pmod(Fs0, St0) -> get_base(As) -> case lists:keyfind(extends, 1, As) of - {extends,[Base]} when is_atom(Base) -> + {extends,_,[Base]} when is_atom(Base) -> Base; _ -> [] @@ -159,7 +160,7 @@ add_func(Name, Args, Body, Fs, St) -> F = {function,0,Name,A,[{clause,0,Args,[],Body}]}, NA = {Name,A}, {[F|Fs],St#expand{exports=add_element(NA, St#expand.exports), - defined=add_element(NA, St#expand.defined)}}. + defined=gb_sets:add_element(NA, St#expand.defined)}}. %% define_function(Form, State) -> State. %% Add function to defined if form is a function. @@ -168,7 +169,7 @@ define_functions(Forms, #expand{defined=Predef}=St) -> Fs = foldl(fun({function,_,N,A,_Cs}, Acc) -> [{N,A}|Acc]; (_, Acc) -> Acc end, Predef, Forms), - St#expand{defined=ordsets:from_list(Fs)}. + St#expand{defined=gb_sets:from_list(Fs)}. module_attrs(#expand{attributes=Attributes}=St) -> Attrs = [{attribute,Line,Name,Val} || {Name,Line,Val} <- Attributes], @@ -187,7 +188,7 @@ module_predef_func_beh_info(#expand{callbacks=Callbacks,defined=Defined, PreDef=[{behaviour_info,1}], PreExp=PreDef, {[gen_beh_info(Callbacks)], - St#expand{defined=union(from_list(PreDef), Defined), + St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), Defined), exports=union(from_list(PreExp), Exports)}}. gen_beh_info(Callbacks) -> @@ -215,7 +216,8 @@ module_predef_funcs_mod_info(St) -> [{clause,0,[{var,0,'X'}],[], [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}}, [{atom,0,St#expand.module},{var,0,'X'}]}]}]}], - St#expand{defined=union(from_list(PreDef), St#expand.defined), + St#expand{defined=gb_sets:union(gb_sets:from_list(PreDef), + St#expand.defined), exports=union(from_list(PreExp), St#expand.exports)}}. %% forms(Forms, State) -> @@ -721,4 +723,4 @@ imported(F, A, St) -> end. defined(F, A, St) -> - ordsets:is_element({F,A}, St#expand.defined). + gb_sets:is_element({F,A}, St#expand.defined). diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl index e7dae67085..be15495672 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2012. 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 @@ -53,7 +53,6 @@ %% Main codegen structure. -record(cg, {lcount=1, %Label counter - finfo, %Function info label bfail, %Fail label for BIFs break, %Break label recv, %Receive label @@ -126,7 +125,6 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) -> stk=[]}, 0, Vdb), {B,_Aft,St} = cg_list(Les, 0, Vdb, Bef, St3#cg{bfail=0, - finfo=Fi, ultimate_failure=UltimateMatchFail, is_top_block=true}), {Name,Arity} = NameArity, @@ -147,8 +145,6 @@ cg({match,M,Rs}, Le, Vdb, Bef, St) -> match_cg(M, Rs, Le, Vdb, Bef, St); cg({guard_match,M,Rs}, Le, Vdb, Bef, St) -> guard_match_cg(M, Rs, Le, Vdb, Bef, St); -cg({match_fail,F}, Le, Vdb, Bef, St) -> - match_fail_cg(F, Le, Vdb, Bef, St); cg({call,Func,As,Rs}, Le, Vdb, Bef, St) -> call_cg(Func, As, Rs, Le, Vdb, Bef, St); cg({enter,Func,As}, Le, Vdb, Bef, St) -> @@ -294,39 +290,6 @@ match_cg({block,Es}, Le, _Fail, Bef, St) -> Int = clear_dead(Bef, Le#l.i, Le#l.vdb), block_cg(Es, Le, Int, St). -%% match_fail_cg(FailReason, Le, Vdb, StackReg, State) -> -%% {[Ainstr],StackReg,State}. -%% Generate code for the match_fail "call". N.B. there is no generic -%% case for when the fail value has been created elsewhere. - -match_fail_cg({function_clause,As}, Le, Vdb, Bef, St) -> - %% Must have the args in {x,0}, {x,1},... - {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb), - {Sis ++ [{jump,{f,St#cg.finfo}}], - Int#sr{reg=clear_regs(Int#sr.reg)},St}; -match_fail_cg({badmatch,Term}, Le, Vdb, Bef, St) -> - R = cg_reg_arg(Term, Bef), - Int0 = clear_dead(Bef, Le#l.i, Vdb), - {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis ++ [line(Le),{badmatch,R}], - Int#sr{reg=clear_regs(Int0#sr.reg)},St}; -match_fail_cg({case_clause,Reason}, Le, Vdb, Bef, St) -> - R = cg_reg_arg(Reason, Bef), - Int0 = clear_dead(Bef, Le#l.i, Vdb), - {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis++[line(Le),{case_end,R}], - Int#sr{reg=clear_regs(Bef#sr.reg)},St}; -match_fail_cg(if_clause, Le, Vdb, Bef, St) -> - Int0 = clear_dead(Bef, Le#l.i, Vdb), - {Sis,Int1} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis++[line(Le),if_end],Int1#sr{reg=clear_regs(Int1#sr.reg)},St}; -match_fail_cg({try_clause,Reason}, Le, Vdb, Bef, St) -> - R = cg_reg_arg(Reason, Bef), - Int0 = clear_dead(Bef, Le#l.i, Vdb), - {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb), - {Sis ++ [line(Le),{try_case_end,R}], - Int#sr{reg=clear_regs(Int0#sr.reg)},St}. - %% bsm_rename_ctx([Clause], Var) -> [Clause] %% We know from an annotation that the register for a binary can %% be reused for the match context because the two are not truly @@ -1460,20 +1423,7 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) -> Other -> [{move,Other,Ret}] end, - {Ais,clear_dead(Int, Le#l.i, Vdb),St}; -set_cg([], {binary,Segs}, Le, Vdb, Bef, St) -> - Fail = {f,St#cg.bfail}, - Target = find_scratch_reg(Bef#sr.reg), - Temp = find_scratch_reg(put_reg(Target, Bef#sr.reg)), - PutCode = cg_bin_put(Segs, Fail, Bef), - MaxRegs = max_reg(Bef#sr.reg), - Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a), - Aft = clear_dead(Bef, Le#l.i, Vdb), - {Code,Aft,St}; -set_cg([], _, Le, Vdb, Bef, St) -> - %% This should have been stripped by compiler, just cleanup. - {[],clear_dead(Bef, Le#l.i, Vdb), St}. - + {Ais,clear_dead(Int, Le#l.i, Vdb),St}. %%% %%% Code generation for constructing binaries. @@ -2104,7 +2054,7 @@ line_1(_, 0) -> %% Missing line number or line number 0. {line,[]}; line_1(Name, Line) -> - {line,[{location,Name,abs(Line)}]}. + {line,[{location,Name,Line}]}. find_loc([Line|T], File, _) when is_integer(Line) -> find_loc(T, File, Line); diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 6885405ae0..01042cc56f 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2012. 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 @@ -823,6 +823,13 @@ bitstr({bin_element,_,E0,Size0,[Type,{unit,Unit}|Flags]}, St0) -> {_,_} -> throw(bad_binary) end, + case Size1 of + #c_var{} -> ok; + #c_literal{val=Sz} when is_integer(Sz), Sz >= 0 -> ok; + #c_literal{val=undefined} -> ok; + #c_literal{val=all} -> ok; + _ -> throw(bad_binary) + end, {#c_bitstr{val=E1,size=Size1, unit=#c_literal{val=Unit}, type=#c_literal{val=Type}, @@ -2085,7 +2092,12 @@ bitstr_vars(Segs, Vs) -> lineno_anno(L, St) -> {line, Line} = erl_parse:get_attribute(L, line), - [Line] ++ St#core.file. + if + Line < 0 -> + [-Line] ++ St#core.file ++ [compiler_generated]; + true -> + [Line] ++ St#core.file + end. get_ianno(Ce) -> case get_anno(Ce) of diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index d76291f57f..b184987625 100644 --- a/lib/compiler/src/v3_kernel.erl +++ b/lib/compiler/src/v3_kernel.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2012. 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 @@ -83,12 +83,11 @@ -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2, keymember/3,keyfind/3]). -import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]). +-import(cerl, [c_tuple/1]). -include("core_parse.hrl"). -include("v3_kernel.hrl"). --define(EXPENSIVE_BINARY_LIMIT, 256). - %% These are not defined in v3_kernel.hrl. get_kanno(Kthing) -> element(2, Kthing). set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno). @@ -119,7 +118,6 @@ copy_anno(Kdst, Ksrc) -> funs=[], %Fun functions free=[], %Free variables ws=[] :: [warning()], %Warnings. - lit, %Constant pool for literals. guard_refc=0}). %> 0 means in guard -spec module(cerl:c_module(), [compile:option()]) -> @@ -128,7 +126,7 @@ copy_anno(Kdst, Ksrc) -> module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) -> Kas = attributes(As), Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es), - St0 = #kern{lit=dict:new()}, + St0 = #kern{}, {Kfs,St} = mapfoldl(fun function/2, St0, Fs), {ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas, body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}. @@ -249,26 +247,20 @@ expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) -> expr(Fun, Sub, St); expr(#c_var{anno=A,name=V}, Sub, St) -> {#k_var{anno=A,name=get_vsub(V, Sub)},[],St}; -expr(#c_literal{}=Lit, Sub, St) -> - Core = handle_literal(Lit), - expr(Core, Sub, St); -expr(#k_literal{val=Val0}=Klit, _Sub, #kern{lit=Literals0}=St) -> - %% Share identical literals to save some space and time during compilation. - case dict:find(Val0, Literals0) of - {ok,Val} -> - {Klit#k_literal{val=Val},[],St}; - error -> - Literals = dict:store(Val0, Val0, Literals0), - {Klit,[],St#kern{lit=Literals}} - end; -expr(#k_nil{}=V, _Sub, St) -> - {V,[],St}; -expr(#k_int{}=V, _Sub, St) -> - {V,[],St}; -expr(#k_float{}=V, _Sub, St) -> - {V,[],St}; -expr(#k_atom{}=V, _Sub, St) -> - {V,[],St}; +expr(#c_literal{anno=A,val=V}, _Sub, St) -> + Klit = case V of + [] -> + #k_nil{anno=A}; + V when is_integer(V) -> + #k_int{anno=A,val=V}; + V when is_float(V) -> + #k_float{anno=A,val=V}; + V when is_atom(V) -> + #k_atom{anno=A,val=V}; + _ -> + #k_literal{anno=A,val=V} + end, + {Klit,[],St}; expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) -> %% Do cons in two steps, first the expressions left to right, then %% any remaining literals right to left. @@ -286,11 +278,12 @@ expr(#c_binary{anno=A,segments=Cv}, Sub, St0) -> {#k_binary{anno=A,segs=Kv},Ep,St1} catch throw:bad_element_size -> + St1 = add_warning(get_line(A), bad_segment_size, A, St0), Erl = #c_literal{val=erlang}, Name = #c_literal{val=error}, Args = [#c_literal{val=badarg}], Error = #c_call{anno=A,module=Erl,name=Name,args=Args}, - expr(Error, Sub, St0) + expr(Error, Sub, St1) end; expr(#c_fun{anno=A,vars=Cvs,body=Cb}, Sub0, #kern{ff=OldFF,func=Func}=St0) -> FA = case OldFF of @@ -422,10 +415,11 @@ expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) -> end; expr(#c_primop{anno=A,name=#c_literal{val=match_fail},args=Cargs0}, Sub, St0) -> Cargs = translate_match_fail(Cargs0, Sub, A, St0), - %% This special case will disappear. {Kargs,Ap,St} = atomic_list(Cargs, Sub, St0), Ar = length(Cargs), - Call = #k_call{anno=A,op=#k_internal{name=match_fail,arity=Ar},args=Kargs}, + Call = #k_call{anno=A,op=#k_remote{mod=#k_atom{val=erlang}, + name=#k_atom{val=error}, + arity=Ar},args=Kargs}, {Call,Ap,St}; expr(#c_primop{anno=A,name=#c_literal{val=N},args=Cargs}, Sub, St0) -> {Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0), @@ -455,14 +449,14 @@ expr(#ireceive_accept{anno=A}, _Sub, St) -> {#k_receive_accept{anno=A},[],St}. translate_match_fail(Args, Sub, Anno, St) -> case Args of [#c_tuple{es=[#c_literal{val=function_clause}|As]}] -> - translate_match_fail_1(Anno, Args, As, Sub, St); + translate_match_fail_1(Anno, As, Sub, St); [#c_literal{val=Tuple}] when is_tuple(Tuple) -> %% The inliner may have created a literal out of %% the original #c_tuple{}. case tuple_to_list(Tuple) of [function_clause|As0] -> As = [#c_literal{val=E} || E <- As0], - translate_match_fail_1(Anno, Args, As, Sub, St); + translate_match_fail_1(Anno, As, Sub, St); _ -> Args end; @@ -471,7 +465,7 @@ translate_match_fail(Args, Sub, Anno, St) -> Args end. -translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) -> +translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) -> AnnoFunc = case keyfind(function_name, 1, Anno) of false -> none; %Force rewrite. @@ -481,10 +475,10 @@ translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) -> case {AnnoFunc,FF} of {Same,Same} -> %% Still in the correct function. - Args; + translate_fc(As); {{F,_},F} -> %% Still in the correct function. - Args; + translate_fc(As); _ -> %% Wrong function or no function_name annotation. %% @@ -493,9 +487,12 @@ translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) -> %% the current function). match_fail(function_clause) will %% only work at the top level of the function it was originally %% defined in, so we will need to rewrite it to a case_clause. - [#c_tuple{es=[#c_literal{val=case_clause},#c_tuple{es=As}]}] + [c_tuple([#c_literal{val=case_clause},c_tuple(As)])] end. +translate_fc(Args) -> + [#c_literal{val=function_clause},make_list(Args)]. + %% call_type(Module, Function, Arity) -> call | bif | apply | error. %% Classify the call. call_type(#c_literal{val=M}, #c_literal{val=F}, Ar) when is_atom(M), is_atom(F) -> @@ -605,7 +602,6 @@ is_atomic(#k_int{}) -> true; is_atomic(#k_float{}) -> true; is_atomic(#k_atom{}) -> true; %%is_atomic(#k_char{}) -> true; %No characters -%%is_atomic(#k_string{}) -> true; is_atomic(#k_nil{}) -> true; is_atomic(#k_var{}) -> true; is_atomic(_) -> false. @@ -914,9 +910,8 @@ match_guard_1([#iclause{anno=A,osub=Osub,guard=G,body=B}|Cs0], Def0, St0) -> true -> %% The true clause body becomes the default. {Kb,Pb,St1} = body(B, Osub, St0), - Line = get_line(A), - St2 = maybe_add_warning(Cs0, Line, St1), - St = maybe_add_warning(Def0, Line, St2), + St2 = maybe_add_warning(Cs0, A, St1), + St = maybe_add_warning(Def0, A, St2), {[],pre_seq(Pb, Kb),St}; false -> {Kg,St1} = guard(G, Osub, St0), @@ -927,15 +922,18 @@ match_guard_1([#iclause{anno=A,osub=Osub,guard=G,body=B}|Cs0], Def0, St0) -> end; match_guard_1([], Def, St) -> {[],Def,St}. -maybe_add_warning([C|_], Line, St) -> - maybe_add_warning(C, Line, St); -maybe_add_warning([], _Line, St) -> St; -maybe_add_warning(fail, _Line, St) -> St; -maybe_add_warning(Ke, MatchLine, St) -> - case get_kanno(Ke) of - [compiler_generated|_] -> St; - Anno -> +maybe_add_warning([C|_], MatchAnno, St) -> + maybe_add_warning(C, MatchAnno, St); +maybe_add_warning([], _MatchAnno, St) -> St; +maybe_add_warning(fail, _MatchAnno, St) -> St; +maybe_add_warning(Ke, MatchAnno, St) -> + case is_compiler_generated(Ke) of + true -> + St; + false -> + Anno = get_kanno(Ke), Line = get_line(Anno), + MatchLine = get_line(MatchAnno), Warn = case MatchLine of none -> nomatch_shadow; _ -> {nomatch_shadow,MatchLine} @@ -1117,7 +1115,6 @@ select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer, end, select_assert_match_possible(Bits, Val, Fl), P = #k_bin_int{anno=A,size=Sz,unit=U,flags=Fl,val=Val,next=N}, - select_assert_match_possible(Bits, Val, Fl), case member(native, Fl) of true -> throw(not_possible); false -> ok @@ -1259,8 +1256,6 @@ match_clause([U|Us], [C|_]=Cs0, Def, St0) -> sub_size_var(#k_bin_seg{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{isub=Sub}|_]) -> BinSeg#k_bin_seg{size=Kvar#k_var{name=get_vsub(Name, Sub)}}; -sub_size_var(#k_bin_int{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{isub=Sub}|_]) -> - BinSeg#k_bin_int{size=Kvar#k_var{name=get_vsub(Name, Sub)}}; sub_size_var(K, _) -> K. get_con([C|_]) -> arg_arg(clause_arg(C)). %Get the constructor @@ -1378,7 +1373,6 @@ arg_con(Arg) -> #k_tuple{} -> k_tuple; #k_binary{} -> k_binary; #k_bin_end{} -> k_bin_end; - #k_bin_int{} -> k_bin_int; #k_bin_seg{} -> k_bin_seg; #k_var{} -> k_var end. @@ -1389,15 +1383,9 @@ arg_val(Arg) -> #k_int{val=I} -> I; #k_float{val=F} -> F; #k_atom{val=A} -> A; - #k_nil{} -> 0; - #k_cons{} -> 2; #k_tuple{es=Es} -> length(Es); #k_bin_seg{size=S,unit=U,type=T,flags=Fs} -> - {set_kanno(S, []),U,T,Fs}; - #k_bin_int{} -> - 0; - #k_bin_end{} -> 0; - #k_binary{} -> 0 + {set_kanno(S, []),U,T,Fs} end. %% ubody_used_vars(Expr, State) -> [UsedVar] @@ -1427,14 +1415,12 @@ ubody(#ivalues{anno=A,args=As}, return, St) -> {#k_return{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; ubody(#ivalues{anno=A,args=As}, {break,_Vbs}, St) -> Au = lit_list_vars(As), - if St#kern.guard_refc > 0 -> + case is_in_guard(St) of + true -> {#k_guard_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; - true -> + false -> {#k_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St} end; -ubody(#ivalues{anno=A,args=As}, {guard_break,_Vbs}, St) -> - Au = lit_list_vars(As), - {#k_guard_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}; ubody(E, return, St0) -> %% Enterable expressions need no trailing return. case is_enter_expr(E) of @@ -1451,12 +1437,7 @@ ubody(E, {break,_Rs} = Break, St0) -> false -> {Ea,Pa,St1} = force_atomic(E, St0), ubody(pre_seq(Pa, #ivalues{args=[Ea]}), Break, St1) - end; -ubody(E, {guard_break,_Rs} = GuardBreak, St0) -> - %%ok = io:fwrite("ubody ~w:~p~n", [?LINE,{E,Br}]), - %% Exiting expressions need no trailing break. - {Ea,Pa,St1} = force_atomic(E, St0), - ubody(pre_seq(Pa, #ivalues{args=[Ea]}), GuardBreak, St1). + end. iletrec_funs(#iletrec{defs=Fs}, St0) -> %% Use union of all free variables. @@ -1494,7 +1475,6 @@ iletrec_funs_gen(Fs, FreeVs, St) -> %% is_exit_expr(Kexpr) -> boolean(). %% Test whether Kexpr always exits and never returns. -is_exit_expr(#k_call{op=#k_internal{name=match_fail,arity=1}}) -> true; is_exit_expr(#k_receive_next{}) -> true; is_exit_expr(_) -> false. @@ -1509,64 +1489,21 @@ is_enter_expr(#k_receive{}) -> true; is_enter_expr(#k_receive_next{}) -> true; is_enter_expr(_) -> false. -%% uguard(Expr, State) -> {Expr,[UsedVar],State}. -%% Tag the guard sequence with its used variables. - -uguard(#k_try{anno=A,arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false}}=Try, St0) -> - {B1,Bu,St1} = uguard(B0, St0), - {Try#k_try{anno=#k{us=Bu,ns=[],a=A},arg=B1},Bu,St1}; -uguard(T, St) -> - %%ok = io:fwrite("~w: ~p~n", [?LINE,T]), - uguard_test(T, St). - -%% uguard_test(Expr, State) -> {Test,[UsedVar],State}. -%% At this stage tests are just expressions which don't return any -%% values. - -uguard_test(T, St) -> uguard_expr(T, [], St). +%% uexpr(Expr, Break, State) -> {Expr,[UsedVar],State}. +%% Tag an expression with its used variables. +%% Break = return | {break,[RetVar]}. -uguard_expr(#iset{anno=A,vars=Vs,arg=E0,body=B0}, Rs, St0) -> - Ns = lit_list_vars(Vs), - {E1,Eu,St1} = uguard_expr(E0, Vs, St0), - {B1,Bu,St2} = uguard_expr(B0, Rs, St1), - Used = union(Eu, subtract(Bu, Ns)), - {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2}; -uguard_expr(#k_try{anno=A,arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X}, - handler=#k_atom{val=false}}=Try, Rs, St0) -> - {B1,Bu,St1} = uguard_expr(B0, Rs, St0), - {Try#k_try{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A},arg=B1,ret=Rs}, - Bu,St1}; -uguard_expr(#k_test{anno=A,op=Op,args=As}=Test, Rs, St) -> +uexpr(#k_test{anno=A,op=Op,args=As}=Test, {break,Rs}, St) -> [] = Rs, %Sanity check Used = union(op_vars(Op), lit_list_vars(As)), {Test#k_test{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}}, Used,St}; -uguard_expr(#k_bif{anno=A,op=Op,args=As}=Bif, Rs, St) -> - Used = union(op_vars(Op), lit_list_vars(As)), - {Bif#k_bif{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A},ret=Rs}, - Used,St}; -uguard_expr(#ivalues{anno=A,args=As}, Rs, St) -> - Sets = foldr2(fun (V, Arg, Rhs) -> - #iset{anno=A,vars=[V],arg=Arg,body=Rhs} - end, #k_atom{val=true}, Rs, As), - uguard_expr(Sets, [], St); -uguard_expr(#k_match{anno=A,vars=Vs,body=B0}, Rs, St0) -> - %% Experimental support for andalso/orelse in guards. - Br = {guard_break,Rs}, - {B1,Bu,St1} = umatch(B0, Br, St0), - {#k_guard_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, - vars=Vs,body=B1,ret=Rs},Bu,St1}; -uguard_expr(Lit, Rs, St) -> - %% Transform literals to puts here. - Used = lit_vars(Lit), - {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)}, - arg=Lit,ret=Rs},Used,St}. - -%% uexpr(Expr, Break, State) -> {Expr,[UsedVar],State}. -%% Tag an expression with its used variables. -%% Break = return | {break,[RetVar]}. - +uexpr(#iset{anno=A,vars=Vs,arg=E0,body=B0}, {break,_}=Br, St0) -> + Ns = lit_list_vars(Vs), + {E1,Eu,St1} = uexpr(E0, {break,Vs}, St0), + {B1,Bu,St2} = uexpr(B0, Br, St1), + Used = union(Eu, subtract(Bu, Ns)), + {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2}; uexpr(#k_call{anno=A,op=#k_local{name=F,arity=Ar}=Op,args=As0}=Call, Br, St) -> Free = get_free(F, Ar, St), As1 = As0 ++ Free, %Add free variables LAST! @@ -1598,10 +1535,11 @@ uexpr(#k_match{anno=A,vars=Vs0,body=B0}, Br, St0) -> Vs = handle_reuse_annos(Vs0, St0), Rs = break_rets(Br), {B1,Bu,St1} = umatch(B0, Br, St0), - if St0#kern.guard_refc > 0 -> + case is_in_guard(St1) of + true -> {#k_guard_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, vars=Vs,body=B1,ret=Rs},Bu,St1}; - true -> + false -> {#k_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A}, vars=Vs,body=B1,ret=Rs},Bu,St1} end; @@ -1618,24 +1556,27 @@ uexpr(#k_receive_accept{anno=A}, _, St) -> {#k_receive_accept{anno=#k{us=[],ns=[],a=A}},[],St}; uexpr(#k_receive_next{anno=A}, _, St) -> {#k_receive_next{anno=#k{us=[],ns=[],a=A}},[],St}; -uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, - {break,Rs0}, St0) -> - {Avs,St1} = new_vars(length(Vs), St0), %Need dummy names here - {A1,Au,St2} = ubody(A0, {break,Avs}, St1), %Must break to clean up here! - {B1,Bu,St3} = ubody(B0, {break,Rs0}, St2), - {H1,Hu,St4} = ubody(H0, {break,Rs0}, St3), - %% Guarantee ONE return variable. - NumNew = if - Rs0 =:= [] -> 1; - true -> 0 - end, - {Ns,St5} = new_vars(NumNew, St4), - Rs1 = Rs0 ++ Ns, - Used = union([Au,subtract(Bu, lit_list_vars(Vs)), - subtract(Hu, lit_list_vars(Evs))]), - {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs1),a=A}, - arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs1}, - Used,St5}; +uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}=Try, + {break,Rs0}=Br, St0) -> + case is_in_guard(St0) of + true -> + {[#k_var{name=X}],#k_var{name=X}} = {Vs,B0}, %Assertion. + #k_atom{val=false} = H0, %Assertion. + {A1,Bu,St1} = uexpr(A0, Br, St0), + {Try#k_try{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A}, + arg=A1,ret=Rs0},Bu,St1}; + false -> + {Avs,St1} = new_vars(length(Vs), St0), + {A1,Au,St2} = ubody(A0, {break,Avs}, St1), + {B1,Bu,St3} = ubody(B0, Br, St2), + {H1,Hu,St4} = ubody(H0, Br, St3), + {Rs1,St5} = ensure_return_vars(Rs0, St4), + Used = union([Au,subtract(Bu, lit_list_vars(Vs)), + subtract(Hu, lit_list_vars(Evs))]), + {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs1),a=A}, + arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs1}, + Used,St5} + end; uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}, return, St0) -> {Avs,St1} = new_vars(length(Vs), St0), %Need dummy names here @@ -1681,12 +1622,13 @@ uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) -> #k_int{val=Index},#k_int{val=Uniq}|Fvs], ret=Rs}, Free,add_local_function(Fun, St)}; -uexpr(Lit, {break,Rs}, St) -> +uexpr(Lit, {break,Rs0}, St0) -> %% Transform literals to puts here. %%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,Lit]), Used = lit_vars(Lit), + {Rs,St1} = ensure_return_vars(Rs0, St0), {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)}, - arg=Lit,ret=Rs},Used,St}. + arg=Lit,ret=Rs},Used,St1}. add_local_function(_, #kern{funs=ignore}=St) -> St; add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}. @@ -1743,6 +1685,11 @@ bif_returns(#k_internal{name=N,arity=Ar}, Rs, St0) -> {Ns,St1} = new_vars(bif_vals(N, Ar) - length(Rs), St0), {Rs ++ Ns,St1}. +%% ensure_return_vars([Ret], State) -> {[Ret],State}. + +ensure_return_vars([], St) -> new_vars(1, St); +ensure_return_vars([_]=Rs, St) -> {Rs,St}. + %% umatch(Match, Break, State) -> {Match,[UsedVar],State}. %% Tag a match expression with its used variables. @@ -1775,7 +1722,8 @@ umatch(#k_guard{anno=A,clauses=Gs0}, Br, St0) -> {#k_guard{anno=#k{us=Gus,ns=[],a=A},clauses=Gs1},Gus,St1}; umatch(#k_guard_clause{anno=A,guard=G0,body=B0}, Br, St0) -> %%ok = io:fwrite("~w: ~p~n", [?LINE,G0]), - {G1,Gu,St1} = uguard(G0, St0#kern{guard_refc=St0#kern.guard_refc+1}), + {G1,Gu,St1} = uexpr(G0, {break,[]}, + St0#kern{guard_refc=St0#kern.guard_refc+1}), %%ok = io:fwrite("~w: ~p~n", [?LINE,G1]), {B1,Bu,St2} = umatch(B0, Br, St1#kern{guard_refc=St1#kern.guard_refc-1}), Used = union(Gu, Bu), @@ -1823,7 +1771,6 @@ lit_list_vars(Ps) -> pat_vars(#k_var{name=N}) -> {[],[N]}; %%pat_vars(#k_char{}) -> {[],[]}; -%%pat_vars(#k_string{}) -> {[],[]}; pat_vars(#k_literal{}) -> {[],[]}; pat_vars(#k_int{}) -> {[],[]}; pat_vars(#k_float{}) -> {[],[]}; @@ -1850,34 +1797,6 @@ pat_list_vars(Ps) -> {union(Used0, Used),union(New0, New)} end, {[],[]}, Ps). -%% handle_literal(Literal, Anno) -> Kernel -%% Examine the literal. Complex (heap-based) literals such as lists, -%% tuples, and binaries should be kept as literals and put into the constant pool. -%% -%% (If necessary, this function could be extended to go through the literal -%% and convert huge binary literals to bit syntax expressions. We don't do that -%% because v3_core does not produce huge binary literals, and the optimizations in -%% sys_core_fold don't do much optimizations of binaries. IF THAT CHANGE IS MADE, -%% ALSO CHANGE sys_core_dsetel.) - -handle_literal(#c_literal{anno=A,val=V}) -> - case V of - [_|_] -> - #k_literal{anno=A,val=V}; - [] -> - #k_nil{anno=A}; - V when is_tuple(V) -> - #k_literal{anno=A,val=V}; - V when is_bitstring(V) -> - #k_literal{anno=A,val=V}; - V when is_integer(V) -> - #k_int{anno=A,val=V}; - V when is_float(V) -> - #k_float{anno=A,val=V}; - V when is_atom(V) -> - #k_atom{anno=A,val=V} - end. - make_list(Es) -> foldr(fun(E, Acc) -> #c_cons{hd=E,tl=Acc} @@ -1889,6 +1808,11 @@ integers(N, M) when N =< M -> [N|integers(N + 1, M)]; integers(_, _) -> []. +%% is_in_guard(State) -> true|false. + +is_in_guard(#kern{guard_refc=Refc}) -> + Refc > 0. + %%% %%% Handling of errors and warnings. %%% @@ -1904,12 +1828,17 @@ format_error({nomatch_shadow,Line}) -> format_error(nomatch_shadow) -> "this clause cannot match because a previous clause always matches"; format_error(bad_call) -> - "invalid module and/or function name; this call will always fail". + "invalid module and/or function name; this call will always fail"; +format_error(bad_segment_size) -> + "binary construction will fail because of a type mismatch". add_warning(none, Term, Anno, #kern{ws=Ws}=St) -> File = get_file(Anno), St#kern{ws=[{File,[{?MODULE,Term}]}|Ws]}; -add_warning(Line, Term, Anno, #kern{ws=Ws}=St) when Line >= 0 -> +add_warning(Line, Term, Anno, #kern{ws=Ws}=St) -> File = get_file(Anno), - St#kern{ws=[{File,[{Line,?MODULE,Term}]}|Ws]}; -add_warning(_, _, _, St) -> St. + St#kern{ws=[{File,[{Line,?MODULE,Term}]}|Ws]}. + +is_compiler_generated(Ke) -> + Anno = get_kanno(Ke), + member(compiler_generated, Anno). diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl index 37f2fdcf7e..fb8baf398b 100644 --- a/lib/compiler/src/v3_kernel.hrl +++ b/lib/compiler/src/v3_kernel.hrl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2009. All Rights Reserved. +%% Copyright Ericsson AB 1999-2012. 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 @@ -35,7 +35,6 @@ -record(k_int, {anno=[],val}). -record(k_float, {anno=[],val}). -record(k_atom, {anno=[],val}). --record(k_string, {anno=[],val}). -record(k_nil, {anno=[]}). -record(k_tuple, {anno=[],es}). diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl index fac9a9843d..2cc3493570 100644 --- a/lib/compiler/src/v3_life.erl +++ b/lib/compiler/src/v3_life.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1999-2011. All Rights Reserved. +%% Copyright Ericsson AB 1999-2012. 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 @@ -89,19 +89,8 @@ function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) -> end. %% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}. -%% Handle a body, need special cases for transforming match_fails. -%% We KNOW that they only occur last in a body. - -body(#k_seq{arg=#k_put{anno=Pa,arg=Arg,ret=[R]}, - body=#k_enter{anno=Ea,op=#k_internal{name=match_fail,arity=1}, - args=[R]}}, - I, Vdb0) -> - Vdb1 = use_vars(Pa#k.us, I, Vdb0), %All used here - {[match_fail(Arg, I, Pa#k.a ++ Ea#k.a)],I,Vdb1}; -body(#k_enter{anno=Ea,op=#k_internal{name=match_fail,arity=1},args=[Arg]}, - I, Vdb0) -> - Vdb1 = use_vars(Ea#k.us, I, Vdb0), - {[match_fail(Arg, I, Ea#k.a)],I,Vdb1}; +%% Handle a body. + body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) -> %%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]), A = get_kanno(Ke), @@ -123,53 +112,14 @@ guard(#k_try{anno=A,arg=Ts,vars=[#k_var{name=X}],body=#k_var{name=X}, %% Lock variables that are alive before try and used afterwards. %% Don't lock variables that are only used inside the try expression. Pdb0 = vdb_sub(I, I+1, Vdb), - {T,MaxI,Pdb1} = guard_body(Ts, I+1, Pdb0), + {T,MaxI,Pdb1} = body(Ts, I+1, Pdb0), Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values - #l{ke={protected,T,var_list(Rs)},i=I,a=A#k.a,vdb=Pdb2}; -guard(#k_seq{}=G, I, Vdb0) -> - {Es,_,Vdb1} = guard_body(G, I, Vdb0), - #l{ke={block,Es},i=I,vdb=Vdb1,a=[]}; -guard(G, I, Vdb) -> guard_expr(G, I, Vdb). - -%% guard_body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}. - -guard_body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) -> - A = get_kanno(Ke), - Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)), - {Es,MaxI,Vdb2} = guard_body(Kb, I+1, Vdb1), - E = guard_expr(Ke, I, Vdb2), - {[E|Es],MaxI,Vdb2}; -guard_body(Ke, I, Vdb0) -> - A = get_kanno(Ke), - Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)), - E = guard_expr(Ke, I, Vdb1), - {[E],I,Vdb1}. - -%% guard_expr(Call, I, Vdb) -> Expr - -guard_expr(#k_test{anno=A,op=Op,args=As}, I, _Vdb) -> - #l{ke={test,test_op(Op),atomic_list(As)},i=I,a=A#k.a}; -guard_expr(#k_bif{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) -> - Name = bif_op(Op), - Ar = length(As), - case is_gc_bif(Name, Ar) of - false -> - #l{ke={bif,Name,atomic_list(As),var_list(Rs)},i=I,a=A#k.a}; - true -> - #l{ke={gc_bif,Name,atomic_list(As),var_list(Rs)},i=I,a=A#k.a} - end; -guard_expr(#k_put{anno=A,arg=Arg,ret=Rs}, I, _Vdb) -> - #l{ke={set,var_list(Rs),literal(Arg, [])},i=I,a=A#k.a}; -guard_expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> - %% Support for andalso/orelse in guards. - %% Work out imported variables which need to be locked. - Mdb = vdb_sub(I, I+1, Vdb), - M = match(Kb, A#k.us, I+1, [], Mdb), - #l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}; -guard_expr(G, I, Vdb) -> guard(G, I, Vdb). + #l{ke={protected,T,var_list(Rs)},i=I,a=A#k.a,vdb=Pdb2}. %% expr(Kexpr, I, Vdb) -> Expr. +expr(#k_test{anno=A,op=Op,args=As}, I, _Vdb) -> + #l{ke={test,test_op(Op),atomic_list(As)},i=I,a=A#k.a}; expr(#k_call{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) -> #l{ke={call,call_op(Op),atomic_list(As),var_list(Rs)},i=I,a=A#k.a}; expr(#k_enter{anno=A,op=Op,args=As}, I, _Vdb) -> @@ -187,25 +137,11 @@ expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) -> Mdb = vdb_sub(I, I+1, Vdb), M = match(Kb, A#k.us, I+1, [], Mdb), #l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a}; -expr(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs}, I, Vdb) -> - %% Lock variables that are alive before the catch and used afterwards. - %% Don't lock variables that are only used inside the try. - Tdb0 = vdb_sub(I, I+1, Vdb), - %% This is the tricky bit. Lock variables in Arg that are used in - %% the body and handler. Add try tag 'variable'. - Ab = get_kanno(Kb), - Ah = get_kanno(Kh), - Tdb1 = use_vars(Ab#k.us, I+3, use_vars(Ah#k.us, I+3, Tdb0)), - Tdb2 = vdb_sub(I, I+2, Tdb1), - Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names - {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)), - {Bes,_,Bdb} = body(Kb, I+4, new_vars(map(Vnames, Vs), I+3, Tdb2)), - {Hes,_,Hdb} = body(Kh, I+4, new_vars(map(Vnames, Evs), I+3, Tdb2)), - #l{ke={'try',#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]}, - var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]}, - var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]}, - var_list(Rs)}, - i=I,vdb=Tdb1,a=A#k.a}; +expr(#k_try{}=Try, I, Vdb) -> + case is_in_guard() of + false -> body_try(Try, I, Vdb); + true -> guard(Try, I, Vdb) + end; expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) -> %% Lock variables that are alive before the catch and used afterwards. %% Don't lock variables that are only used inside the try. @@ -254,6 +190,27 @@ expr(#k_guard_break{anno=A,args=As}, I, Vdb) -> expr(#k_return{anno=A,args=As}, I, _Vdb) -> #l{ke={return,atomic_list(As)},i=I,a=A#k.a}. +body_try(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs}, + I, Vdb) -> + %% Lock variables that are alive before the catch and used afterwards. + %% Don't lock variables that are only used inside the try. + Tdb0 = vdb_sub(I, I+1, Vdb), + %% This is the tricky bit. Lock variables in Arg that are used in + %% the body and handler. Add try tag 'variable'. + Ab = get_kanno(Kb), + Ah = get_kanno(Kh), + Tdb1 = use_vars(Ab#k.us, I+3, use_vars(Ah#k.us, I+3, Tdb0)), + Tdb2 = vdb_sub(I, I+2, Tdb1), + Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names + {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)), + {Bes,_,Bdb} = body(Kb, I+4, new_vars(map(Vnames, Vs), I+3, Tdb2)), + {Hes,_,Hdb} = body(Kh, I+4, new_vars(map(Vnames, Evs), I+3, Tdb2)), + #l{ke={'try',#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]}, + var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]}, + var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]}, + var_list(Rs)}, + i=I,vdb=Tdb1,a=A#k.a}. + %% call_op(Op) -> Op. %% bif_op(Op) -> Op. %% test_op(Op) -> Op. @@ -353,25 +310,6 @@ guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) -> i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1), a=A#k.a}. -%% match_fail(FailValue, I, Anno) -> Expr. -%% Generate the correct match_fail instruction. N.B. there is no -%% generic case for when the fail value has been created elsewhere. - -match_fail(#k_literal{anno=Anno,val={Atom,Val}}, I, A) when is_atom(Atom) -> - match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom},#k_literal{val=Val}]}, I, A); -match_fail(#k_literal{anno=Anno,val={Atom}}, I, A) when is_atom(Atom) -> - match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom}]}, I, A); -match_fail(#k_tuple{es=[#k_atom{val=function_clause}|As]}, I, A) -> - #l{ke={match_fail,{function_clause,literal_list(As, [])}},i=I,a=A}; -match_fail(#k_tuple{es=[#k_atom{val=badmatch},Val]}, I, A) -> - #l{ke={match_fail,{badmatch,literal(Val, [])}},i=I,a=A}; -match_fail(#k_tuple{es=[#k_atom{val=case_clause},Val]}, I, A) -> - #l{ke={match_fail,{case_clause,literal(Val, [])}},i=I,a=A}; -match_fail(#k_atom{val=if_clause}, I, A) -> - #l{ke={match_fail,if_clause},i=I,a=A}; -match_fail(#k_tuple{es=[#k_atom{val=try_clause},Val]}, I, A) -> - #l{ke={match_fail,{try_clause,literal(Val, [])}},i=I,a=A}. - %% type(Ktype) -> Type. type(k_literal) -> literal; @@ -403,7 +341,6 @@ atomic(#k_int{val=I}) -> {integer,I}; atomic(#k_float{val=F}) -> {float,F}; atomic(#k_atom{val=N}) -> {atom,N}; %%atomic(#k_char{val=C}) -> {char,C}; -%%atomic(#k_string{val=S}) -> {string,S}; atomic(#k_nil{}) -> nil. atomic_list(Ks) -> [atomic(K) || K <- Ks]. @@ -565,3 +502,7 @@ vdb_sub(Min, Max, Vdb) -> true -> Vd end || {V,F,L}=Vd <- Vdb, F < Min, L >= Min ]. +%% is_in_guard() -> true|false. + +is_in_guard() -> + get(guard_refc) > 0. diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index b90adaf917..e047166ade 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -10,6 +10,7 @@ MODULES= \ apply_SUITE \ beam_validator_SUITE \ beam_disasm_SUITE \ + beam_expect_SUITE \ bs_bincomp_SUITE \ bs_bit_binaries_SUITE \ bs_construct_SUITE \ @@ -29,7 +30,6 @@ MODULES= \ misc_SUITE \ num_bif_SUITE \ pmod_SUITE \ - parteval_SUITE \ receive_SUITE \ record_SUITE \ trycatch_SUITE \ @@ -39,6 +39,7 @@ MODULES= \ NO_OPT= \ andor \ apply \ + beam_expect \ bs_construct \ bs_match \ bs_utf \ @@ -153,12 +154,12 @@ include $(ERL_TOP)/make/otp_release_targets.mk release_spec: opt release_tests_spec: make_emakefile - $(INSTALL_DIR) $(RELSYSDIR) + $(INSTALL_DIR) "$(RELSYSDIR)" $(INSTALL_DATA) compiler.spec compiler.cover \ - $(EMAKEFILE) $(ERL_FILES) $(CORE_FILES) $(RELSYSDIR) + $(EMAKEFILE) $(ERL_FILES) $(CORE_FILES) "$(RELSYSDIR)" $(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \ - $(INLINE_ERL_FILES) $(RELSYSDIR) - chmod -R u+w $(RELSYSDIR) - @tar cf - *_SUITE_data | (cd $(RELSYSDIR); tar xf -) + $(INLINE_ERL_FILES) "$(RELSYSDIR)" + chmod -R u+w "$(RELSYSDIR)" + @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) release_docs_spec: diff --git a/lib/compiler/test/beam_disasm_SUITE.erl b/lib/compiler/test/beam_disasm_SUITE.erl index 44574ae64a..62afc80ca6 100644 --- a/lib/compiler/test/beam_disasm_SUITE.erl +++ b/lib/compiler/test/beam_disasm_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2011. All Rights Reserved. +%% Copyright Ericsson AB 2011-2012. 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 @@ -60,6 +60,6 @@ stripped(Config) when is_list(Config) -> ?line true = is_list(Attr), ?line true = is_list(CompileInfo), ?line {ok, {tmp, _}} = beam_lib:strip(BeamName), - ?line {beam_file, tmp, _, none, none, [_|_]} = + ?line {beam_file, tmp, _, [], [], [_|_]} = beam_disasm:file(BeamName), ok. diff --git a/lib/compiler/test/beam_expect_SUITE.erl b/lib/compiler/test/beam_expect_SUITE.erl new file mode 100644 index 0000000000..6f216eac4f --- /dev/null +++ b/lib/compiler/test/beam_expect_SUITE.erl @@ -0,0 +1,67 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2011. 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% +%% +-module(beam_expect_SUITE). + +-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, + init_per_group/2,end_per_group/2, + coverage/1]). + +suite() -> [{ct_hooks,[ts_install_cth]}]. + +all() -> + [coverage]. + +groups() -> + []. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +coverage(_) -> + File = {file,"fake.erl"}, + ok = fc(a), + {'EXIT',{function_clause, + [{?MODULE,fc,[[x]],[File,{line,2}]}|_]}} = + (catch fc([x])), + {'EXIT',{function_clause, + [{?MODULE,fc,[y],[File,{line,2}]}|_]}} = + (catch fc(y)), + {'EXIT',{function_clause, + [{?MODULE,fc,[[a,b,c]],[File,{line,6}]}|_]}} = + (catch fc([a,b,c])), + + {'EXIT',{undef,[{erlang,error,[a,b,c],_}|_]}} = + (catch erlang:error(a, b, c)), + ok. + +-file("fake.erl", 1). +fc(a) -> %Line 2 + ok; %Line 3 +fc(L) when length(L) > 2 -> %Line 4 + %% Not the same as a "real" function_clause error. + error(function_clause, [L]). %Line 6 diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 556dc54a8f..902867bc19 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -79,21 +79,18 @@ beam_files(Config) when is_list(Config) -> %% a grammatical error in the output of the io:format/2 call below. ;-) ?line [_,_|_] = Fs = filelib:wildcard(Wc), ?line io:format("~p files\n", [length(Fs)]), - beam_files_1(Fs, 0). - -beam_files_1([F|Fs], Errors) -> - ?line case beam_validator:file(F) of - ok -> - beam_files_1(Fs, Errors); - {error,Es} -> - io:format("File: ~s", [F]), - io:format("Error: ~p\n", [Es]), - beam_files_1(Fs, Errors+1) - end; -beam_files_1([], 0) -> ok; -beam_files_1([], Errors) -> - ?line io:format("~p error(s)", [Errors]), - ?line ?t:fail(). + test_lib:p_run(fun do_beam_file/1, Fs). + + +do_beam_file(F) -> + case beam_validator:file(F) of + ok -> + ok; + {error,Es} -> + io:format("File: ~s", [F]), + io:format("Error: ~p\n", [Es]), + error + end. compiler_bug(Config) when is_list(Config) -> %% Check that the compiler returns an error if we try to diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl index 31c7890f26..e8b30f44ce 100644 --- a/lib/compiler/test/bs_construct_SUITE.erl +++ b/lib/compiler/test/bs_construct_SUITE.erl @@ -468,6 +468,10 @@ opt(Config) when is_list(Config) -> ?line {'EXIT',_} = (catch <<<<23,56,0,2>>:64/float>>), ?line {'EXIT',_} = (catch <<<<23,56,0,2:7>>/binary>>), + %% Test constant propagation - there should be a warning. + BadSz = 2.5, + {'EXIT',_} = (catch <<<<N,56,0,2>>:BadSz/binary>>), + case id(false) of true -> ?line opt_dont_call_me(); false -> ok diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl index f8c71a0257..01b7568122 100644 --- a/lib/compiler/test/bs_match_SUITE.erl +++ b/lib/compiler/test/bs_match_SUITE.erl @@ -342,6 +342,10 @@ partitioned_bs_match(Config) when is_list(Config) -> ?line fc(partitioned_bs_match_2, [4,<<0:17>>], catch partitioned_bs_match_2(4, <<0:17>>)), + + anything = partitioned_bs_match_3(anything, <<42>>), + ok = partitioned_bs_match_3(1, 2), + ok. partitioned_bs_match(_, <<42:8,T/binary>>) -> @@ -356,6 +360,9 @@ partitioned_bs_match_2(1, <<B:8,T/binary>>) -> partitioned_bs_match_2(Len, <<_:8,T/binary>>) -> {Len,T}. +partitioned_bs_match_3(Var, <<_>>) -> Var; +partitioned_bs_match_3(1, 2) -> ok. + function_clause(Config) when is_list(Config) -> ?line ok = function_clause_1(<<0,7,0,7,42>>), ?line fc(function_clause_1, [<<0,1,2,3>>], diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl index 1343fbd1c9..fed7bec7d4 100644 --- a/lib/compiler/test/compilation_SUITE.erl +++ b/lib/compiler/test/compilation_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2012. 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 @@ -44,7 +44,7 @@ all() -> trycatch_4, opt_crash, otp_5404, otp_5436, otp_5481, otp_5553, otp_5632, otp_5714, otp_5872, otp_6121, otp_6121a, otp_6121b, otp_7202, otp_7345, on_load, - string_table,otp_8949_a,otp_8949_a]. + string_table,otp_8949_a,otp_8949_a,split_cases]. groups() -> [{vsn, [], [vsn_1, vsn_2, vsn_3]}]. @@ -159,6 +159,7 @@ split({int, N}, <<N:16,B:N/binary,T/binary>>) -> ?comp(convopts). ?comp(otp_7202). ?comp(on_load). +?comp(on_load_inline). beam_compiler_7(doc) -> "Code snippet submitted from Ulf Wiger which fails in R3 Beam."; @@ -427,9 +428,9 @@ self_compile_1(Config, Prefix, Opts) -> %% Compile the compiler again using the newly compiled compiler. %% (In another node because reloading the compiler would disturb cover.) CompilerB = Prefix++"compiler_b", - ?line CompB = make_compiler_dir(Priv, Prefix++"compiler_b"), + CompB = make_compiler_dir(Priv, CompilerB), ?line VsnB = VsnA ++ ".0", - ?line self_compile_node(CompilerB, CompA, CompB, VsnB, Opts), + self_compile_node(CompA, CompB, VsnB, Opts), %% Compare compiler directories. ?line compare_compilers(CompA, CompB), @@ -438,21 +439,26 @@ self_compile_1(Config, Prefix, Opts) -> ?line CompilerC = Prefix++"compiler_c", ?line CompC = make_compiler_dir(Priv, CompilerC), ?line VsnC = VsnB ++ ".0", - ?line self_compile_node(CompilerC, CompB, CompC, VsnC, Opts), + self_compile_node(CompB, CompC, VsnC, Opts), ?line compare_compilers(CompB, CompC), ?line test_server:timetrap_cancel(Dog), ok. -self_compile_node(NodeName0, CompilerDir, OutDir, Version, Opts) -> - ?line NodeName = list_to_atom(NodeName0), - ?line Dog = test_server:timetrap(test_server:minutes(10)), +self_compile_node(CompilerDir, OutDir, Version, Opts) -> + ?line Dog = test_server:timetrap(test_server:minutes(15)), ?line Pa = "-pa " ++ filename:dirname(code:which(?MODULE)) ++ " -pa " ++ CompilerDir, - ?line {ok,Node} = start_node(NodeName, Pa), ?line Files = compiler_src(), - ?line ok = rpc:call(Node, ?MODULE, compile_compiler, [Files,OutDir,Version,Opts]), - ?line test_server:stop_node(Node), + + %% We don't want the cover server started on the other node, + %% because it will load the same cover-compiled code as on this + %% node. Use a shielded node to prevent the cover server from + %% being started. + ?t:run_on_shielded_node( + fun() -> + compile_compiler(Files, OutDir, Version, Opts) + end, Pa), ?line test_server:timetrap_cancel(Dog), ok. @@ -465,9 +471,12 @@ compile_compiler(Files, OutDir, Version, InlineOpts) -> {d,'COMPILER_VSN',"\""++Version++"\""}, nowarn_shadow_vars, {i,filename:join(code:lib_dir(stdlib), "include")}|InlineOpts], - lists:foreach(fun(File) -> - {ok,_} = compile:file(File, Opts) - end, Files). + test_lib:p_run(fun(File) -> + case compile:file(File, Opts) of + {ok,_} -> ok; + _ -> error + end + end, Files). compiler_src() -> filelib:wildcard(filename:join([code:lib_dir(compiler), "src", "*.erl"])). @@ -657,5 +666,19 @@ otp_8949_b(A, B) -> id(Var) end. +split_cases(_) -> + dummy1 = do_split_cases(x), + {'EXIT',{{badmatch,b},_}} = (catch do_split_cases(y)), + ok. + +do_split_cases(A) -> + case A of + x -> + Z = dummy1; + _ -> + Z = dummy2, + a=b + end, + Z. id(I) -> I. diff --git a/lib/compiler/test/compilation_SUITE_data/on_load_inline.erl b/lib/compiler/test/compilation_SUITE_data/on_load_inline.erl new file mode 100644 index 0000000000..322843b61e --- /dev/null +++ b/lib/compiler/test/compilation_SUITE_data/on_load_inline.erl @@ -0,0 +1,23 @@ +-module(on_load_inline). +-export([?MODULE/0]). +-on_load(on_load/0). +-compile(inline). + +?MODULE() -> + [{pid,Pid}] = ets:lookup(on_load_executed, pid), + exit(Pid, kill), + ok. + +on_load() -> + Parent = self(), + spawn(fun() -> + T = ets:new(on_load_executed, [named_table]), + ets:insert(T, {pid,self()}), + Parent ! done, + receive + wait_forever -> ok + end + end), + receive + done -> ok + end. diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl index fedbd98f71..da53a6ba9c 100644 --- a/lib/compiler/test/compile_SUITE.erl +++ b/lib/compiler/test/compile_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 1997-2011. All Rights Reserved. +%% Copyright Ericsson AB 1997-2012. 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 @@ -25,11 +25,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, - file_1/1, module_mismatch/1, big_file/1, outdir/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, package_forms/1, encrypted_abstr/1, bad_record_use1/1, bad_record_use2/1, strict_record/1, - missing_testheap/1, cover/1, env/1, core/1, asm/1]). + missing_testheap/1, cover/1, env/1, core/1, asm/1, + sys_pre_attributes/1]). -export([init/3]). @@ -41,11 +42,12 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [app_test, file_1, module_mismatch, big_file, outdir, + [app_test, file_1, forms_2, module_mismatch, big_file, outdir, binary, makedep, cond_and_ifdef, listings, listings_big, other_output, package_forms, encrypted_abstr, {group, bad_record_use}, strict_record, - missing_testheap, cover, env, core, asm]. + missing_testheap, cover, env, core, asm, + sys_pre_attributes]. groups() -> [{bad_record_use, [], @@ -74,6 +76,9 @@ app_test(Config) when is_list(Config) -> file_1(Config) when is_list(Config) -> ?line Dog = test_server:timetrap(test_server:minutes(5)), + + process_flag(trap_exit, true), + ?line {Simple, Target} = files(Config, "file_1"), ?line {ok, Cwd} = file:get_cwd(), ?line ok = file:set_cwd(filename:dirname(Target)), @@ -100,9 +105,37 @@ file_1(Config) when is_list(Config) -> %% Cleanup. ?line ok = file:delete(Target), ?line ok = file:del_dir(filename:dirname(Target)), + + %% There should not be any messages in the messages. + receive + Any -> + ?t:fail({unexpected,Any}) + after 10 -> + ok + end, + ?line test_server:timetrap_cancel(Dog), ok. +forms_2(Config) when is_list(Config) -> + Src = "/foo/bar", + AbsSrc = filename:absname(Src), + {ok,simple,Binary} = compile:forms([{attribute,1,module,simple}], + [binary,{source,Src}]), + code:load_binary(simple, Src, Binary), + Info = simple:module_info(compile), + + %% Test that the proper source is returned. + AbsSrc = proplists:get_value(source, Info), + + %% Ensure that the options are not polluted with 'source'. + [] = proplists:get_value(options, Info), + + %% Cleanup. + true = code:delete(simple), + false = code:purge(simple), + ok. + module_mismatch(Config) when is_list(Config) -> ?line DataDir = ?config(data_dir, Config), ?line File = filename:join(DataDir, "wrong_module_name.erl"), @@ -785,6 +818,37 @@ do_asm(Beam, Outdir) -> error end. +sys_pre_attributes(Config) -> + DataDir = ?config(data_dir, Config), + File = filename:join(DataDir, "attributes.erl"), + Mod = attributes, + CommonOpts = [binary,report,verbose, + {parse_transform,sys_pre_attributes}], + PreOpts = [{attribute,delete,deleted}], + PostOpts = [{attribute,insert,inserted,"value"}], + PrePostOpts = [{attribute,replace,replaced,42}, + {attribute,replace,replace_nonexisting,new}], + {ok,Mod,Code} = compile:file(File, PrePostOpts ++ PreOpts ++ + PostOpts ++ CommonOpts), + code:load_binary(Mod, File, Code), + Attr = Mod:module_info(attributes), + io:format("~p", [Attr]), + {inserted,"value"} = lists:keyfind(inserted, 1, Attr), + {replaced,[42]} = lists:keyfind(replaced, 1, Attr), + {replace_nonexisting,[new]} = lists:keyfind(replace_nonexisting, 1, Attr), + false = lists:keymember(deleted, 1, Attr), + + %% Cover more code. + {ok,Mod,_} = compile:file(File, PostOpts ++ CommonOpts), + {ok,Mod,_} = compile:file(File, CommonOpts -- [verbose]), + {ok,Mod,_} = compile:file(File, PreOpts ++ CommonOpts), + {ok,Mod,_} = compile:file(File, + [{attribute,replace,replaced,42}|CommonOpts]), + {ok,Mod,_} = compile:file(File, PrePostOpts ++ PreOpts ++ + PostOpts ++ CommonOpts -- + [report,verbose]), + ok. + %%% %%% Utilities. %%% diff --git a/lib/compiler/test/compile_SUITE_data/attributes.erl b/lib/compiler/test/compile_SUITE_data/attributes.erl new file mode 100644 index 0000000000..9c3451d272 --- /dev/null +++ b/lib/compiler/test/compile_SUITE_data/attributes.erl @@ -0,0 +1,23 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2012. 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% +%% + +-module(attributes). +-deleted(dummy). +-replaced(dummy). + diff --git a/lib/compiler/test/compiler.cover b/lib/compiler/test/compiler.cover index 9fc4c7dd43..3fd7fc1937 100644 --- a/lib/compiler/test/compiler.cover +++ b/lib/compiler/test/compiler.cover @@ -1,5 +1,5 @@ {incl_app,compiler,details}. %% -*- erlang -*- -{excl_mods,[sys_pre_attributes,core_scan,core_parse]}. +{excl_mods,compiler,[core_scan,core_parse]}. diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl index 26173c62b8..06185bfc34 100644 --- a/lib/compiler/test/core_SUITE.erl +++ b/lib/compiler/test/core_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2011. All Rights Reserved. +%% Copyright Ericsson AB 2006-2012. 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 @@ -21,7 +21,9 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, init_per_testcase/2,end_per_testcase/2, - dehydrated_itracer/1,nested_tries/1]). + dehydrated_itracer/1,nested_tries/1, + seq_in_guard/1,make_effect_seq/1,eval_is_boolean/1, + unsafe_case/1,nomatch_shadow/1,reversed_annos/1]). -include_lib("test_server/include/test_server.hrl"). @@ -41,7 +43,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), - [dehydrated_itracer, nested_tries]. + [dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq, + eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos]. groups() -> []. @@ -61,19 +64,19 @@ end_per_group(_GroupName, Config) -> ?comp(dehydrated_itracer). ?comp(nested_tries). +?comp(seq_in_guard). +?comp(make_effect_seq). +?comp(eval_is_boolean). +?comp(unsafe_case). +?comp(nomatch_shadow). +?comp(reversed_annos). try_it(Mod, Conf) -> - ?line Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)), - ?line Out = ?config(priv_dir,Conf), - ?line io:format("Compiling: ~s\n", [Src]), - ?line CompRc0 = compile:file(Src, [from_core,{outdir,Out},report,time]), - ?line io:format("Result: ~p\n",[CompRc0]), - ?line {ok,Mod} = CompRc0, - - ?line {module,Mod} = code:load_abs(filename:join(Out, Mod)), - ?line ok = Mod:Mod(), - ok. - - - - + Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)), + compile_and_load(Src, []), + compile_and_load(Src, [no_copt]). + +compile_and_load(Src, Opts) -> + {ok,Mod,Bin} = compile:file(Src, [from_core,report,time,binary|Opts]), + {module,Mod} = code:load_binary(Mod, Mod, Bin), + ok = Mod:Mod(). diff --git a/lib/compiler/test/core_SUITE_data/eval_is_boolean.core b/lib/compiler/test/core_SUITE_data/eval_is_boolean.core new file mode 100644 index 0000000000..6a68b1414d --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/eval_is_boolean.core @@ -0,0 +1,22 @@ +module 'eval_is_boolean' ['eval_is_boolean'/0] + attributes [] +'eval_is_boolean'/0 = + %% Line 4 + fun () -> + case <> of + <> when 'true' -> + case call 'erlang':'is_boolean'(call 'erlang':'make_ref'()) of + <'false'> when 'true' -> + 'ok' + ( <_cor1> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor1}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'eval_is_boolean',0}}] ) + -| ['compiler_generated'] ) + end +end diff --git a/lib/compiler/test/core_SUITE_data/make_effect_seq.core b/lib/compiler/test/core_SUITE_data/make_effect_seq.core new file mode 100644 index 0000000000..9941e63b76 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/make_effect_seq.core @@ -0,0 +1,51 @@ +module 'make_effect_seq' ['make_effect_seq'/0] + attributes [] +'make_effect_seq'/0 = + fun () -> + case <> of + <> when 'true' -> + let <_cor0> = + catch + apply 't'/1 + ('a') + in + case _cor0 of + <{'EXIT',{'badarg',_cor3}}> when 'true' -> + let <_cor4> = + apply 't'/1 + ({'a','b','c'}) + in + case _cor4 of + <'ok'> when 'true' -> + ( _cor4 + -| ['compiler_generated'] ) + ( <_cor2> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor2}) + -| ['compiler_generated'] ) + end + ( <_cor1> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor1}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'make_effect_seq',0}}] ) + -| ['compiler_generated'] ) + end +'t'/1 = + fun (_cor0) -> + case _cor0 of + <T> when 'true' -> + do + {'ok',call 'erlang':'element'(2, T)} + 'ok' + ( <_cor2> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_cor2}) + -| [{'function_name',{'t',1}}] ) + -| ['compiler_generated'] ) + end +end diff --git a/lib/compiler/test/core_SUITE_data/nomatch_shadow.core b/lib/compiler/test/core_SUITE_data/nomatch_shadow.core new file mode 100644 index 0000000000..565d9dc0f3 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/nomatch_shadow.core @@ -0,0 +1,28 @@ +module 'nomatch_shadow' ['nomatch_shadow'/0] + attributes [] +'nomatch_shadow'/0 = + fun () -> + case <> of + <> when 'true' -> + apply 't'/1 + (42) + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'nomatch_shadow',0}}] ) + -| ['compiler_generated'] ) + end +'t'/1 = + fun (_cor0) -> + case _cor0 of + <42> when 'true' -> + 'ok' + <42> when 'true' -> + 'ok' + ( <_cor1> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_cor1}) + -| [{'function_name',{'t',1}}] ) + -| ['compiler_generated'] ) + end +end diff --git a/lib/compiler/test/core_SUITE_data/reversed_annos.core b/lib/compiler/test/core_SUITE_data/reversed_annos.core new file mode 100644 index 0000000000..95b3cd52d6 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/reversed_annos.core @@ -0,0 +1,49 @@ +module 'reversed_annos' ['reversed_annos'/0] + attributes [] +'reversed_annos'/0 = + fun () -> + case <> of + <> when 'true' -> + case apply 't'/1 + (['a']) of + <'ok'> when 'true' -> + let <_cor2> = + apply 't'/1 + (['a'|['b']]) + in + case _cor2 of + <'ok'> when 'true' -> + ( _cor2 + -| ['compiler_generated'] ) + ( <_cor1> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor1}) + -| ['compiler_generated'] ) + end + ( <_cor0> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor0}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'reversed_annos',0}}] ) + -| ['compiler_generated'] ) + end +'t'/1 = + fun (_cor0) -> + case _cor0 of + <[_cor2|_cor3]> when 'true' -> + 'ok' + %% Cover v3_kernel:get_line/1. + ( <['a']> when 'true' -> + 'error' + -| [{'file',"reversed_annos.erl"},11] ) + ( <_cor1> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_cor1}) + -| [{'function_name',{'t',1}}] ) + -| ['compiler_generated'] ) + end +end diff --git a/lib/compiler/test/core_SUITE_data/seq_in_guard.core b/lib/compiler/test/core_SUITE_data/seq_in_guard.core new file mode 100644 index 0000000000..44686a7187 --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/seq_in_guard.core @@ -0,0 +1,66 @@ +module 'seq_in_guard' ['seq_in_guard'/0, + 't'/1] + attributes [] +'seq_in_guard'/0 = + %% Line 4 + fun () -> + case <> of + <> when 'true' -> + let <_cor0> = + catch + %% Line 5 + apply 't'/1 + ({}) + in %% Line 5 + case _cor0 of + <{'EXIT',{'function_clause',_cor4}}> when 'true' -> + let <_cor2> = + catch + %% Line 6 + apply 't'/1 + ('atom') + in %% Line 6 + case _cor2 of + <{'EXIT',{'function_clause',_cor5}}> when 'true' -> + %% Line 7 + apply 't'/1 + ({'a','b'}) + ( <_cor3> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor3}) + -| ['compiler_generated'] ) + end + ( <_cor1> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor1}) + -| ['compiler_generated'] ) + end + ( <> when 'true' -> + ( primop 'match_fail' + ({'function_clause'}) + -| [{'function_name',{'seq_in_guard',0}}] ) + -| ['compiler_generated'] ) + end +'t'/1 = + %% Line 9 + fun (_cor0) -> + case _cor0 of + <X> + when try + do + call 'erlang':'element' + (2, X) + 'true' + of <Try> -> + Try + catch <T,R> -> + 'false' -> + %% Line 10 + 'ok' + ( <_cor3> when 'true' -> + ( primop 'match_fail' + ({'function_clause',_cor3}) + -| [{'function_name',{'t',1}}] ) + -| ['compiler_generated'] ) + end +end diff --git a/lib/compiler/test/core_SUITE_data/unsafe_case.core b/lib/compiler/test/core_SUITE_data/unsafe_case.core new file mode 100644 index 0000000000..84cb2c310a --- /dev/null +++ b/lib/compiler/test/core_SUITE_data/unsafe_case.core @@ -0,0 +1,25 @@ +module 'unsafe_case' ['unsafe_case'/0] + attributes [] +'unsafe_case'/0 = + fun () -> + case apply 't'/1 + (42) of + <{'ok',42}> when 'true' -> + 'ok' + ( <_cor0> when 'true' -> + primop 'match_fail' + ({'badmatch',_cor0}) + -| ['compiler_generated'] ) + end +'t'/1 = + fun (_cor0) -> + case _cor0 of + <X> + when call 'erlang':'>' + (_cor0, + 0) -> + {'ok',X} + %% The default case is intentionally missing + %% to cover v3_kernel:build_match/2. + end +end diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl index ac14d36e82..54bd52947e 100644 --- a/lib/compiler/test/core_fold_SUITE.erl +++ b/lib/compiler/test/core_fold_SUITE.erl @@ -21,7 +21,7 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, t_element/1,setelement/1,t_length/1,append/1,t_apply/1,bifs/1, - eq/1,nested_call_in_case/1,coverage/1]). + eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1]). -export([foo/0,foo/1,foo/2,foo/3]). @@ -32,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> test_lib:recompile(?MODULE), [t_element, setelement, t_length, append, t_apply, bifs, - eq, nested_call_in_case, coverage]. + eq, nested_call_in_case, guard_try_catch, coverage]. groups() -> []. @@ -207,6 +207,23 @@ nested_call_in_case(Config) when is_list(Config) -> ?line {'EXIT',_} = (catch Mod:a(not_a_list, 42)), ok. +guard_try_catch(_Config) -> + false = do_guard_try_catch(key, value), + value = get(key), + ok. + +do_guard_try_catch(K, V) -> + %% This try...catch block looks like a guard. + %% Make sure that it is not optimized like a guard + %% (the put/2 call must not be optimized away). + try + put(K, V), + false + catch + _:_ -> + false + end. + coverage(Config) when is_list(Config) -> ?line {'EXIT',{{case_clause,{a,b,c}},_}} = (catch cover_will_match_list_type({a,b,c})), @@ -214,6 +231,7 @@ coverage(Config) when is_list(Config) -> (catch cover_will_match_list_type({a,b,c,d})), ?line a = cover_remove_non_vars_alias({a,b,c}), ?line error = cover_will_match_lit_list(), + {ok,[a]} = cover_is_safe_bool_expr(a), %% Make sure that we don't attempt to make literals %% out of pids. (Putting a pid into a #c_literal{} @@ -249,4 +267,17 @@ cover_will_match_lit_list() -> error end. +cover_is_safe_bool_expr(X) -> + %% Use a try...catch that looks like a try...catch in a guard. + try + %% let V = [X] in {ok,V} + %% is_safe_simple([X]) ==> true + %% is_safe_bool_expr([X]) ==> false + V = [X], + {ok,V} + catch + _:_ -> + false + end. + id(I) -> I. diff --git a/lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S b/lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S index c0bf04ed8f..cffb792920 100644 --- a/lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S +++ b/lib/compiler/test/guard_SUITE_data/guard_SUITE_tuple_size.S @@ -19,10 +19,10 @@ {get_tuple_element,{x,0},1,{x,2}}. {get_tuple_element,{x,0},2,{x,3}}. {get_tuple_element,{x,0},3,{x,4}}. - {gc_bif,'+',{f,0},5,[{x,1},{x,2}],{x,0}}. - {gc_bif,'+',{f,0},5,[{x,0},{x,3}],{x,0}}. - {gc_bif,'+',{f,0},5,[{x,0},{x,4}],{x,0}}. - {gc_bif,'+',{f,0},5,[{x,0},{x,5}],{x,0}}. + {gc_bif,'+',{f,0},6,[{x,1},{x,2}],{x,0}}. + {gc_bif,'+',{f,0},6,[{x,0},{x,3}],{x,0}}. + {gc_bif,'+',{f,0},6,[{x,0},{x,4}],{x,0}}. + {gc_bif,'+',{f,0},6,[{x,0},{x,5}],{x,0}}. return. {label,3}. {badmatch,{x,0}}. diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl index 9b414cade6..b53d0dba1d 100644 --- a/lib/compiler/test/misc_SUITE.erl +++ b/lib/compiler/test/misc_SUITE.erl @@ -190,6 +190,24 @@ silly_coverage(Config) when is_list(Config) -> {label,2}|non_proper_list]}],99}, ?line expect_error(fun() -> beam_block:module(BlockInput, []) end), + %% beam_type + TypeInput = {?MODULE,[{foo,0}],[], + [{function,foo,0,2, + [{label,1}, + {line,loc}, + {func_info,{atom,?MODULE},{atom,foo},0}, + {label,2}|non_proper_list]}],99}, + expect_error(fun() -> beam_type:module(TypeInput, []) end), + + %% beam_except + ExceptInput = {?MODULE,[{foo,0}],[], + [{function,foo,0,2, + [{label,1}, + {line,loc}, + {func_info,{atom,?MODULE},{atom,foo},0}, + {label,2}|non_proper_list]}],99}, + expect_error(fun() -> beam_except:module(ExceptInput, []) end), + %% beam_bool BoolInput = {?MODULE,[{foo,0}],[], [{function,foo,0,2, @@ -253,8 +271,15 @@ expect_error(Fun) -> io:format("~p", [Any]), ?t:fail(call_was_supposed_to_fail) catch - _:_ -> - io:format("~p\n", [erlang:get_stacktrace()]) + Class:Reason -> + Stk = erlang:get_stacktrace(), + io:format("~p:~p\n~p\n", [Class,Reason,Stk]), + case {Class,Reason} of + {error,undef} -> + ?t:fail(not_supposed_to_fail_with_undef); + {_,_} -> + ok + end end. confused_literals(Config) when is_list(Config) -> diff --git a/lib/compiler/test/parteval_SUITE.erl b/lib/compiler/test/parteval_SUITE.erl deleted file mode 100644 index 6b1ae38c1b..0000000000 --- a/lib/compiler/test/parteval_SUITE.erl +++ /dev/null @@ -1,66 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-2011. 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% -%% --module(parteval_SUITE). - --include_lib("test_server/include/test_server.hrl"). - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, pe2/1]). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - [pe2]. - -groups() -> - []. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -%% (This is more general than needed, since we once compiled the same -%% source code with and without a certain option.) -compile_and_load(Srcname, Outdir, Module, Options) -> - ?line Objname = filename:join(Outdir, "t1") ++ code:objfile_extension(), - ?line {ok, Module} = - compile:file(Srcname, - [{d, 'M', Module}, {outdir, Outdir}] ++ Options), - ?line {ok, B} = file:read_file(Objname), - ?line {module, Module} = code:load_binary(Module, Objname, B), - B. - -pe2(Config) when is_list(Config) -> - ?line DataDir = ?config(data_dir, Config), - ?line PrivDir = ?config(priv_dir, Config), - ?line Srcname = filename:join(DataDir, "t1.erl"), - ?line compile_and_load(Srcname, PrivDir, t1, []), - - ?line {Correct, Actual} = t1:run(), - ?line Correct = Actual, - ok. diff --git a/lib/compiler/test/parteval_SUITE_data/t1.erl b/lib/compiler/test/parteval_SUITE_data/t1.erl deleted file mode 100644 index 5e4a40f103..0000000000 --- a/lib/compiler/test/parteval_SUITE_data/t1.erl +++ /dev/null @@ -1,140 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 1998-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% -%% --module(?M). - --compile(export_all). - -%%% The arity-0 functions are all called from the test suite. - -f2() -> - size({1,2}). - -i() -> - case [] of - [] -> - ok; - X -> - hopp - end. - -e() -> - case 4+5 of -% X when X>10 -> kvock; % not removed by BEAM opt. - {X,X} when list(X) -> - kvack; - 9 -> - ok; - _ -> - ko - end. - -f() -> - element(2,{a,b,c,d}), - erlang:element(2,{a,b,c,d}), - "hej" ++ "hopp". - -g(X) -> - if - float(3.4) -> - hej; - X == 5, 4==4 -> - japp; - 4 == 4, size({1,2}) == 1 -> - ok - end. - -g() -> - {g(3),g(5)}. - -bliff() -> - if - 3==4 -> - himm - end. - -fi() -> - case 4 of - X when 4==3 -> - {X}; - 4 -> - 4; - _ -> - ok - end. - -iff() when 3==2 -> - if - 3 == 4 -> - baff; - 3 == 3 -> - nipp - end. - -sleep(I) -> receive after I -> ok end. - -sleep() -> - sleep(45). - -s() -> - case 4 of - 3 -> - ok - end. - -error_reason(R) when atom(R) -> - R; -error_reason(R) when tuple(R) -> - error_reason(element(1, R)). - -plusplus() -> - ?MODULE ++ " -> mindre snygg felhantering". - -call_it(F) -> - case (catch apply(?MODULE, F, [])) of - {'EXIT', R0} -> - {'EXIT', error_reason(R0)}; - V -> - V - end. - -run() -> - L = [{f2, 2}, - {i, ok}, - {e, ok}, - {f, "hejhopp"}, - {g, {hej, hej}}, - {bliff, {'EXIT', if_clause}}, - {fi, 4}, - {iff, {'EXIT', function_clause}}, - {sleep, ok}, - {s, {'EXIT', case_clause}, - {plusplus, {'EXIT', badarg}}}], - Actual = [call_it(F) || {F, _} <- L], - Correct = [C || {_, C} <- L], - {Correct, Actual}. - - -%%% Don't call, only compile. -t(A) -> - receive - A when 1==2 -> - ok; - B -> - B - end. diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl index 53d8c04169..2295592a38 100644 --- a/lib/compiler/test/test_lib.erl +++ b/lib/compiler/test/test_lib.erl @@ -77,7 +77,14 @@ get_data_dir(Config) -> %% Will fail the test case if there were any errors. p_run(Test, List) -> - N = erlang:system_info(schedulers) + 1, + N = case ?t:is_cover() of + false -> + erlang:system_info(schedulers); + true -> + %% Cover is running. Using more than one process + %% will probably only slow down compilation. + 1 + end, p_run_loop(Test, List, N, [], 0, 0). p_run_loop(_, [], _, [], Errors, Ws) -> diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl index 760cf17225..29119c0f5d 100644 --- a/lib/compiler/test/trycatch_SUITE.erl +++ b/lib/compiler/test/trycatch_SUITE.erl @@ -1,7 +1,7 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-2012. 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 @@ -24,7 +24,7 @@ catch_oops/1,after_oops/1,eclectic/1,rethrow/1, 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]). + plain_catch_coverage/1,andalso_orelse/1,get_in_try/1]). -include_lib("test_server/include/test_server.hrl"). @@ -35,7 +35,7 @@ all() -> [basic, lean_throw, try_of, try_after, catch_oops, after_oops, eclectic, rethrow, nested_of, nested_catch, nested_after, nested_horrid, last_call_optimization, - bool, plain_catch_coverage, andalso_orelse]. + bool, plain_catch_coverage, andalso_orelse, get_in_try]. groups() -> []. @@ -928,3 +928,17 @@ andalso_orelse_2({Type,Keyval}) -> zero() -> 0.0. + +get_in_try(_) -> + undefined = get_valid_line([a], []), + ok. + +get_valid_line([_|T]=Path, Annotations) -> + try + get(Path) + %% beam_dead used to optimize away an assignment to {y,1} + %% because it didn't appear to be used. + catch + _:not_found -> + get_valid_line(T, Annotations) + end. diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk index 416c2f08bb..c9c28cf9a2 100644 --- a/lib/compiler/vsn.mk +++ b/lib/compiler/vsn.mk @@ -1 +1 @@ -COMPILER_VSN = 4.8 +COMPILER_VSN = 4.8.1 |