aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/doc/src/compile.xml133
-rw-r--r--lib/compiler/doc/src/notes.xml258
-rw-r--r--lib/compiler/doc/src/part_notes_history.xml2
-rw-r--r--lib/compiler/src/Makefile7
-rw-r--r--lib/compiler/src/beam_asm.erl21
-rw-r--r--lib/compiler/src/beam_block.erl48
-rw-r--r--lib/compiler/src/beam_bool.erl21
-rw-r--r--lib/compiler/src/beam_bsm.erl8
-rw-r--r--lib/compiler/src/beam_dead.erl102
-rw-r--r--lib/compiler/src/beam_dict.erl45
-rw-r--r--lib/compiler/src/beam_disasm.erl35
-rw-r--r--lib/compiler/src/beam_flatten.erl11
-rw-r--r--lib/compiler/src/beam_jump.erl11
-rw-r--r--lib/compiler/src/beam_peep.erl58
-rw-r--r--lib/compiler/src/beam_receive.erl388
-rw-r--r--lib/compiler/src/beam_type.erl18
-rw-r--r--lib/compiler/src/beam_utils.erl52
-rw-r--r--lib/compiler/src/beam_validator.erl12
-rw-r--r--lib/compiler/src/cerl.erl19
-rw-r--r--lib/compiler/src/cerl_clauses.erl25
-rw-r--r--lib/compiler/src/cerl_inline.erl49
-rw-r--r--lib/compiler/src/cerl_trees.erl16
-rw-r--r--lib/compiler/src/compile.erl417
-rw-r--r--lib/compiler/src/compiler.app.src11
-rw-r--r--lib/compiler/src/core_lint.erl25
-rw-r--r--lib/compiler/src/erl_bifs.erl12
-rw-r--r--lib/compiler/src/genop.tab20
-rw-r--r--lib/compiler/src/rec_env.erl14
-rw-r--r--lib/compiler/src/sys_core_dsetel.erl12
-rw-r--r--lib/compiler/src/sys_core_fold.erl264
-rw-r--r--lib/compiler/src/sys_core_inline.erl29
-rw-r--r--lib/compiler/src/sys_pre_expand.erl36
-rw-r--r--lib/compiler/src/v3_codegen.erl30
-rw-r--r--lib/compiler/src/v3_core.erl290
-rw-r--r--lib/compiler/src/v3_kernel.erl162
-rw-r--r--lib/compiler/src/v3_kernel_pp.erl64
-rw-r--r--lib/compiler/src/v3_life.erl50
-rw-r--r--lib/compiler/test/Makefile33
-rw-r--r--lib/compiler/test/andor_SUITE.erl53
-rw-r--r--lib/compiler/test/apply_SUITE.erl29
-rw-r--r--lib/compiler/test/beam_disasm_SUITE.erl65
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl53
-rw-r--r--lib/compiler/test/bs_bincomp_SUITE.erl65
-rw-r--r--lib/compiler/test/bs_bit_binaries_SUITE.erl34
-rw-r--r--lib/compiler/test/bs_construct_SUITE.erl39
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl186
-rw-r--r--lib/compiler/test/bs_utf_SUITE.erl45
-rw-r--r--lib/compiler/test/compilation_SUITE.erl122
-rw-r--r--lib/compiler/test/compilation_SUITE_data/string_table.erl8
-rw-r--r--lib/compiler/test/compile_SUITE.erl158
-rw-r--r--lib/compiler/test/compile_SUITE_data/simple-basic1.mk1
-rw-r--r--lib/compiler/test/compile_SUITE_data/simple-basic2.mk1
-rw-r--r--lib/compiler/test/compile_SUITE_data/simple-missing.mk1
-rw-r--r--lib/compiler/test/compile_SUITE_data/simple-target1.mk1
-rw-r--r--lib/compiler/test/compile_SUITE_data/simple-target2.mk1
-rw-r--r--lib/compiler/test/compile_SUITE_data/simple.erl6
-rw-r--r--lib/compiler/test/compiler.cover4
-rw-r--r--lib/compiler/test/compiler.dynspec10
-rw-r--r--lib/compiler/test/compiler.spec2
-rw-r--r--lib/compiler/test/core_SUITE.erl32
-rw-r--r--lib/compiler/test/core_SUITE_data/.gitignore1
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl31
-rw-r--r--lib/compiler/test/error_SUITE.erl282
-rw-r--r--lib/compiler/test/float_SUITE.erl65
-rw-r--r--lib/compiler/test/fun_SUITE.erl29
-rw-r--r--lib/compiler/test/guard_SUITE.erl214
-rw-r--r--lib/compiler/test/inline_SUITE.erl31
-rw-r--r--lib/compiler/test/inline_SUITE_data/decode1.erl48
-rw-r--r--lib/compiler/test/lc_SUITE.erl50
-rw-r--r--lib/compiler/test/match_SUITE.erl82
-rw-r--r--lib/compiler/test/misc_SUITE.erl119
-rw-r--r--lib/compiler/test/num_bif_SUITE.erl47
-rw-r--r--lib/compiler/test/parteval_SUITE.erl28
-rw-r--r--lib/compiler/test/pmod_SUITE.erl34
-rw-r--r--lib/compiler/test/receive_SUITE.erl111
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/no_1.erl99
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/no_2.erl26
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/no_3.erl14
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/yes_1.erl12
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/yes_2.erl13
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/yes_3.erl16
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/yes_4.erl16
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl46
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/yes_6.erl15
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/yes_7.erl12
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/yes_8.erl15
-rw-r--r--lib/compiler/test/receive_SUITE_data/ref_opt/yes_9.erl13
-rw-r--r--lib/compiler/test/record_SUITE.erl85
-rw-r--r--lib/compiler/test/test_lib.erl69
-rw-r--r--lib/compiler/test/trycatch_SUITE.erl37
-rw-r--r--lib/compiler/test/warnings_SUITE.erl61
-rw-r--r--lib/compiler/vsn.mk2
92 files changed, 4090 insertions, 1357 deletions
diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml
index bbd3f1043d..830c89ae84 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>2010</year>
+ <year>1996</year><year>2011</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -68,7 +68,7 @@
to be an error if the module name in the source code is
not the same as the basename of the output file.</p>
- <p>Here follows first all elements of <c>Options</c> that in
+ <p><marker id="type-option"/>Here follows first all elements of <c>Options</c> that in
some way control the behavior of the compiler.</p>
<taglist>
<tag><c>basic_validation</c></tag>
@@ -164,6 +164,70 @@
for details.</p>
</item>
+ <tag><c>makedep</c></tag>
+ <item>
+ <p>Produce a Makefile rule to track headers dependencies.
+ No object file is produced.
+ </p>
+ <p>By default, this rule is written to
+ <c><![CDATA[<File>.Pbeam]]></c>. However, if the option
+ <c>binary</c> is set, nothing is written and the rule is
+ returned in <c>Binary</c>.
+ </p>
+ <p>For instance, if one has the following module:
+ </p>
+ <code>
+-module(module).
+
+-include_lib("eunit/include/eunit.hrl").
+-include("header.hrl").
+ </code>
+ <p>Here is the Makefile rule generated by this option:
+ </p>
+ <code>
+module.beam: module.erl \
+ /usr/local/lib/erlang/lib/eunit/include/eunit.hrl \
+ header.hrl
+ </code>
+ </item>
+
+ <tag><c>{makedep_output, Output}</c></tag>
+ <item>
+ <p>Write generated rule(s) to <c>Output</c> instead of the
+ default <c><![CDATA[<File>.Pbeam]]></c>. <c>Output</c>
+ can be a filename or an <c>io_device()</c>. To write to
+ stdout, use <c>standard_io</c>. However if <c>binary</c>
+ is set, nothing is written to <c>Output</c> and the
+ result is returned to the caller with
+ <c>{ok, ModuleName, Binary}</c>.
+ </p>
+ </item>
+
+ <tag><c>{makedep_target, Target}</c></tag>
+ <item>
+ <p>Change the name of the rule emitted to <c>Target</c>.
+ </p>
+ </item>
+
+ <tag><c>makedep_quote_target</c></tag>
+ <item>
+ <p>Characters in <c>Target</c> special to make(1) are quoted.
+ </p>
+ </item>
+
+ <tag><c>makedep_add_missing</c></tag>
+ <item>
+ <p>Consider missing headers as generated files and add them to the
+ dependencies.
+ </p>
+ </item>
+
+ <tag><c>makedep_phony</c></tag>
+ <item>
+ <p>Add a phony target for each dependency.
+ </p>
+ </item>
+
<tag><c>'P'</c></tag>
<item>
<p>Produces a listing of the parsed code after preprocessing
@@ -310,6 +374,27 @@
(there will not even be a warning if there is a mismatch).</p>
</item>
+ <tag><c>{no_auto_import,[{F,A}, ...]}</c></tag>
+ <item>
+ <p>Makes the function <c>F/A</c> no longer being
+ auto-imported from the module <c>erlang</c>, which resolves
+ BIF name clashes. This option has to be used to resolve name
+ clashes with BIFs auto-imported before R14A, if one wants to
+ call the local function with the same name as an
+ auto-imported BIF without module prefix.</p>
+ <note>
+ <p>From R14A and forward, the compiler resolves calls
+ without module prefix to local or imported functions before
+ trying auto-imported BIFs. If the BIF is to be
+ called, use the <c>erlang</c> module prefix in the call, not
+ <c>{ no_auto_import,[{F,A}, ...]}</c></p>
+ </note>
+ <p>If this option is written in the source code, as a
+ <c>-compile</c> directive, the syntax <c>F/A</c> can be used instead
+ of <c>{F,A}</c>. Example:</p>
+ <code>-compile({no_auto_import,[error/1]}).</code>
+ </item>
+
</taglist>
<p>If warnings are turned on (the <c>report_warnings</c> option
@@ -338,31 +423,35 @@
<tag><c>nowarn_bif_clash</c></tag>
<item>
- <p>By default, there will be a compilation error if a
- module contains an exported function with the same name
- as an auto-imported BIF (such as <c>size/1</c>) AND
- there is a call to it without a qualifying module name.
- The reason is that the BIF will be called, not
- the function in the same module. The recommended way to
- eliminate that warning is to use a call with a module
- name - either <c>erlang</c> to call the BIF or
- <c>?MODULE</c> to call the function in the same module.
- The warning can also be turned off using this option,
- but that is not recommended.</p>
+ <p>This option is removed, it will generate a fatal error if used.</p>
- <p><em>The use of this option is strongly discouraged,
- as code that uses it will probably break in a future
- major release (R14 or R15).</em></p>
+ <warning>
+ <p>Beginning with R14A, the compiler no longer calls the
+ auto-imported BIF if the name clashes with a local or
+ explicitly imported function and a call without explicit
+ module name is issued. Instead the local or imported
+ function is called. Still accepting <c>nowarn_bif_clash</c> would makes a
+ module calling functions clashing with autoimported BIFs
+ compile with both the old and new compilers, but with
+ completely different semantics, why the option was removed.</p>
+
+ <p>The use of this option has always been strongly discouraged.
+ From OTP R14A and forward it's an error to use it.</p>
+ <p>To resolve BIF clashes, use explicit module names or the
+ <c>{no_auto_import,[F/A]}</c> compiler directive.</p>
+ </warning>
</item>
<tag><c>{nowarn_bif_clash, FAs}</c></tag>
<item>
- <p>Turns off warnings as <c>nowarn_bif_clash</c> but only
- for the mentioned local functions. <c>FAs</c> is a tuple
- <c>{Name,Arity}</c> or a list of such tuples.</p>
- <p><em>The use of this option is strongly discouraged,
- as code that uses it will probably break in a future
- major release (R14 or R15).</em></p>
+ <p>This option is removed, it will generate a fatal error if used.</p>
+
+ <warning>
+ <p>The use of this option has always been strongly discouraged.
+ From OTP R14A and forward it's an error to use it.</p>
+ <p>To resolve BIF clashes, use explicit module names or the
+ <c>{no_auto_import,[F/A]}</c> compiler directive.</p>
+ </warning>
</item>
<tag><c>warn_export_all</c></tag>
diff --git a/lib/compiler/doc/src/notes.xml b/lib/compiler/doc/src/notes.xml
index 7ea000a895..740cbcf8eb 100644
--- a/lib/compiler/doc/src/notes.xml
+++ b/lib/compiler/doc/src/notes.xml
@@ -4,7 +4,7 @@
<chapter>
<header>
<copyright>
- <year>2004</year><year>2010</year>
+ <year>2004</year><year>2011</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -31,6 +31,262 @@
<p>This document describes the changes made to the Compiler
application.</p>
+<section><title>Compiler 4.7.5</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Compiler options given in the source code using a
+ <c>-compile()</c> attribute used to be included twice in
+ <c>Mod:module_info(compile)</c>. They are now only
+ included once at the beginning of the list of options.</p>
+ <p>
+ Own Id: OTP-9534</p>
+ </item>
+ <item>
+ <p>
+ beam_disasm: Handle stripped BEAM files</p>
+ <p>
+ beam_disasm:file/1 would crash if asked to disassemble a
+ stripped BEAM file without an "Attr" chunk. (Thanks to
+ Haitao Li)</p>
+ <p>
+ Own Id: OTP-9571</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 4.7.4</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ If a variable is matched out in binary matching and used
+ as the size for a binary element, it would seem to be
+ unbound if used in a subsequent match operation. (Thanks
+ to Bernard Duggan.)</p>
+ <p>
+ Own Id: OTP-9134</p>
+ </item>
+ <item>
+ <p>Eliminate incorrect warning in
+ <c>sys_core_fold</c></p>
+ <p>
+ Own Id: OTP-9152</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 4.7.3</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ The <c>-export_type()</c> directive is no longer included
+ among the attributes.</p>
+ <p>
+ Own Id: OTP-8998</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ The maximum number of allowed arguments for an Erlang
+ function has been lowered from 256 to 255, so that the
+ number of arguments can now fit in a byte.</p>
+ <p>
+ Own Id: OTP-9049</p>
+ </item>
+ <item>
+ <p>
+ Dependency generation for Makefiles has been added to the
+ compiler and erlc. See the manual pages for
+ <c>compile</c> and <c>erlc</c>. (Thanks to Jean-Sebastien
+ Pedron.)</p>
+ <p>
+ Own Id: OTP-9065</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 4.7.2</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Two compiler bugs (that would cause the compiler to
+ terminate) reported by Christopher Williams have been
+ fixed.</p>
+ <p>
+ Own Id: OTP-8949</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>The compiler would translate binary comprehensions
+ containing tail segments in a way that would would
+ confuse Dialyzer. For instance:</p>
+ <p><c>[42 || &lt;&lt;_:8/integer, _/bits&gt;&gt; &lt;=
+ Bits]</c></p>
+ <p>
+ would produce a Dialyzer warning.</p>
+ <p>
+ Own Id: OTP-8864</p>
+ </item>
+ <item>
+ <p>
+ Code such as <c>foo(A) -&gt; &lt;&lt;A:0&gt;&gt;</c>
+ would crash the compiler.</p>
+ <p>
+ Own Id: OTP-8865</p>
+ </item>
+ <item>
+ <p>
+ The compiler could fail with an internal error when
+ variables were exported from a receive block but the
+ return value of the receive block were not used. (Thanks
+ to Jim Engquist for reporting this error.)</p>
+ <p>
+ Own Id: OTP-8888</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 4.7.1</title>
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ Eliminated warnings for auto-imported BIF clashes.</p>
+ <p>
+ Own Id: OTP-8840</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
+<section><title>Compiler 4.7</title>
+
+ <section><title>Fixed Bugs and Malfunctions</title>
+ <list>
+ <item>
+ <p>
+ Several problems in the inliner have been fixed.</p>
+ <p>
+ Own Id: OTP-8552</p>
+ </item>
+ </list>
+ </section>
+
+
+ <section><title>Improvements and New Features</title>
+ <list>
+ <item>
+ <p>
+ The module binary from EEP31 (and EEP9) is implemented.</p>
+ <p>
+ Own Id: OTP-8217</p>
+ </item>
+ <item>
+ <p>Local and imported functions now override the
+ auto-imported BIFs when the names clash. The pre R14
+ behaviour was that auto-imported BIFs would override
+ local functions. To avoid that old programs change
+ behaviour, the following will generate an error:</p>
+ <list><item><p>Doing a call without explicit module name
+ to a local function having a name clashing with the name
+ of an auto-imported BIF that was present (and
+ auto-imported) before OTP R14A</p></item>
+ <item><p>Explicitly importing a function having a name
+ clashing with the name of an autoimported BIF that was
+ present (and autoimported) before OTP R14A</p></item>
+ <item><p>Using any form of the old compiler directive
+ <c>nowarn_bif_clash</c></p></item> </list> <p>If the BIF
+ was added or auto-imported in OTP R14A or later,
+ overriding it with an import or a local function will
+ only result in a warning,</p> <p>To resolve clashes, you
+ can either use the explicit module name <c>erlang</c> to
+ call the BIF, or you can remove the auto-import of that
+ specific BIF by using the new compiler directive
+ <c>-compile({no_auto_import,[F/A]}).</c>, which makes all
+ calls to the local or imported function without explicit
+ module name pass without warnings or errors.</p> <p>The
+ change makes it possible to add auto-imported BIFs
+ without breaking or silently changing old code in the
+ future. However some current code ingeniously utilizing
+ the old behaviour or the <c>nowarn_bif_clash</c> compiler
+ directive, might need changing to be accepted by the
+ compiler.</p>
+ <p>
+ *** POTENTIAL INCOMPATIBILITY ***</p>
+ <p>
+ Own Id: OTP-8579</p>
+ </item>
+ <item>
+ <p>The undocumented, unsupport, and deprecated function
+ <c>lists:flat_length/1</c> has been removed.</p>
+ <p>
+ Own Id: OTP-8584</p>
+ </item>
+ <item>
+ <p>Nested records can now be accessed without
+ parenthesis. See the Reference Manual for examples.
+ (Thanks to YAMASHINA Hio and Tuncer Ayaz.)</p>
+ <p>
+ Own Id: OTP-8597</p>
+ </item>
+ <item>
+ <p>It is now possible to suppress the warning in code
+ such as "<c>list_to_integer(S), ok</c>" by assigning the
+ ignored value "_" like this: "<c>_ = list_to_integer(S),
+ ok</c>".</p>
+ <p>
+ Own Id: OTP-8602</p>
+ </item>
+ <item>
+ <p><c>receive</c> statements that can only read out a
+ newly created reference are now specially optimized so
+ that it will execute in constant time regardless of the
+ number of messages in the receive queue for the process.
+ That optimization will benefit calls to
+ <c>gen_server:call()</c>. (See <c>gen:do_call/4</c> for
+ an example of a receive statement that will be
+ optimized.)</p>
+ <p>
+ Own Id: OTP-8623</p>
+ </item>
+ <item>
+ <p>The compiler optimizes record operations better.</p>
+ <p>
+ Own Id: OTP-8668</p>
+ </item>
+ </list>
+ </section>
+
+</section>
+
<section><title>Compiler 4.6.5</title>
<section><title>Fixed Bugs and Malfunctions</title>
diff --git a/lib/compiler/doc/src/part_notes_history.xml b/lib/compiler/doc/src/part_notes_history.xml
index cd17c4285e..12366f0006 100644
--- a/lib/compiler/doc/src/part_notes_history.xml
+++ b/lib/compiler/doc/src/part_notes_history.xml
@@ -5,7 +5,7 @@
<header>
<copyright>
<year>2006</year>
- <year>2007</year>
+ <year>2011</year>
<holder>Ericsson AB, All Rights Reserved</holder>
</copyright>
<legalnotice>
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 70ddd54145..1238d113e1 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -1,7 +1,7 @@
#
# %CopyrightBegin%
#
-# Copyright Ericsson AB 1996-2010. All Rights Reserved.
+# Copyright Ericsson AB 1996-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
@@ -58,6 +58,7 @@ MODULES = \
beam_listing \
beam_opcodes \
beam_peep \
+ beam_receive \
beam_trim \
beam_type \
beam_utils \
@@ -117,7 +118,9 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE)
ifeq ($(NATIVE_LIBS_ENABLED),yes)
ERL_COMPILE_FLAGS += +native
endif
-ERL_COMPILE_FLAGS += +inline +warn_unused_import -I../../stdlib/include -I$(EGEN) -W
+ERL_COMPILE_FLAGS += +inline +warn_unused_import \
+ +warnings_as_errors \
+ -I../../stdlib/include -I$(EGEN) -W
# ----------------------------------------------------
# Targets
diff --git a/lib/compiler/src/beam_asm.erl b/lib/compiler/src/beam_asm.erl
index 497c4fa07b..89d64834cf 100644
--- a/lib/compiler/src/beam_asm.erl
+++ b/lib/compiler/src/beam_asm.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose : Assembler for threaded Beam.
@@ -23,7 +23,7 @@
-export([module/4]).
-export([encode/2]).
--import(lists, [map/2,member/2,keymember/3,duplicate/2,filter/2]).
+-import(lists, [map/2,member/2,keymember/3,duplicate/2]).
-include("beam_opcodes.hrl").
module(Code, Abst, SourceFile, Opts) ->
@@ -191,11 +191,7 @@ flatten_exports(Exps) ->
flatten_imports(Imps) ->
list_to_binary(map(fun({M,F,A}) -> <<M:32,F:32,A:32>> end, Imps)).
-build_attributes(Opts, SourceFile, Attr0, Essentials) ->
- Attr = filter(fun({type,_}) -> false;
- ({spec,_}) -> false;
- (_) -> true
- end, Attr0),
+build_attributes(Opts, SourceFile, Attr, Essentials) ->
Misc = case member(slim, Opts) of
false ->
{{Y,Mo,D},{H,Mi,S}} = erlang:universaltime(),
@@ -265,7 +261,8 @@ make_op({gc_bif,Bif,Fail,Live,Args,Dest}, Dict) ->
Arity = length(Args),
BifOp = case Arity of
1 -> gc_bif1;
- 2 -> gc_bif2
+ 2 -> gc_bif2;
+ 3 -> gc_bif3
end,
encode_op(BifOp, [Fail,Live,{extfunc,erlang,Bif,Arity}|Args++[Dest]],Dict);
make_op({bs_add=Op,Fail,[Src1,Src2,Unit],Dest}, Dict) ->
diff --git a/lib/compiler/src/beam_block.erl b/lib/compiler/src/beam_block.erl
index d4a4ddca8a..c45874597a 100644
--- a/lib/compiler/src/beam_block.erl
+++ b/lib/compiler/src/beam_block.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose : Partitions assembly instructions into basic blocks and
@@ -36,12 +36,13 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
%% Collect basic blocks and optimize them.
Is2 = blockify(Is1),
- Is3 = beam_utils:live_opt(Is2),
- Is4 = opt_blocks(Is3),
- Is5 = beam_utils:delete_live_annos(Is4),
+ Is3 = move_allocates(Is2),
+ Is4 = beam_utils:live_opt(Is3),
+ Is5 = opt_blocks(Is4),
+ Is6 = beam_utils:delete_live_annos(Is5),
%% Optimize bit syntax.
- {Is,Lc} = bsm_opt(Is5, Lc0),
+ {Is,Lc} = bsm_opt(Is6, Lc0),
%% Done.
{{function,Name,Arity,CLabel,Is},Lc}
@@ -140,7 +141,6 @@ collect({move,S,D}) -> {set,[D],[S],move};
collect({put_list,S1,S2,D}) -> {set,[D],[S1,S2],put_list};
collect({put_tuple,A,D}) -> {set,[D],[],{put_tuple,A}};
collect({put,S}) -> {set,[],[S],put};
-collect({put_string,L,S,D}) -> {set,[D],[],{put_string,L,S}};
collect({get_tuple_element,S,I,D}) -> {set,[D],[S],{get_tuple_element,I}};
collect({set_tuple_element,S,D,I}) -> {set,[],[S,D],{set_tuple_element,I}};
collect({get_list,S,D1,D2}) -> {set,[D1,D2],[S],get_list};
@@ -157,11 +157,7 @@ opt_blocks([I|Is]) ->
opt_blocks([]) -> [].
opt_block(Is0) ->
- %% We explicitly move any allocate instruction upwards before optimising
- %% moves, to avoid any potential problems with the calculation of live
- %% registers.
- Is1 = move_allocates(Is0),
- Is = find_fixpoint(fun opt/1, Is1),
+ Is = find_fixpoint(fun opt/1, Is0),
opt_alloc(Is).
find_fixpoint(OptFun, Is0) ->
@@ -171,11 +167,21 @@ find_fixpoint(OptFun, Is0) ->
end.
%% move_allocates(Is0) -> Is
-%% Move allocates upwards in the instruction stream, in the hope of
-%% getting more possibilities for optimizing away moves later.
-
-move_allocates(Is) ->
- move_allocates_1(reverse(Is), []).
+%% Move allocate instructions upwards in the instruction stream, in the
+%% hope of getting more possibilities for optimizing away moves later.
+%%
+%% NOTE: Moving allocation instructions is only safe because it is done
+%% immediately after code generation so that we KNOW that if {x,X} is
+%% initialized, all x registers with lower numbers are also initialized.
+%% That assumption may not be true after other optimizations, such as
+%% the beam_utils:live_opt/1 optimization.
+
+move_allocates([{block,Bl0}|Is]) ->
+ Bl = move_allocates_1(reverse(Bl0), []),
+ [{block,Bl}|move_allocates(Is)];
+move_allocates([I|Is]) ->
+ [I|move_allocates(Is)];
+move_allocates([]) -> [].
move_allocates_1([{set,[],[],{alloc,_,_}=Alloc}|Is0], Acc0) ->
{Is,Acc} = move_allocates_2(Alloc, Is0, Acc0),
@@ -202,9 +208,7 @@ move_allocates_2(Alloc, [], Acc) ->
alloc_may_pass({set,_,_,{alloc,_,_}}) -> false;
alloc_may_pass({set,_,_,{set_tuple_element,_}}) -> false;
alloc_may_pass({set,_,_,put_list}) -> false;
-alloc_may_pass({set,_,_,{put_tuple,_}}) -> false;
alloc_may_pass({set,_,_,put}) -> false;
-alloc_may_pass({set,_,_,{put_string,_,_}}) -> false;
alloc_may_pass({set,_,_,_}) -> true.
combine_alloc({_,Ns,Nh1,Init}, {_,nostack,Nh2,[]}) ->
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl
index dcc6ad4c7c..d9ea6f5a70 100644
--- a/lib/compiler/src/beam_bool.erl
+++ b/lib/compiler/src/beam_bool.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose: Optimizes booleans in guards.
@@ -631,10 +631,10 @@ fetch_reg(V, [{I,V}|_]) -> {x,I};
fetch_reg(V, [_|SRs]) -> fetch_reg(V, SRs).
live_regs(Regs) ->
- foldl(fun ({I,_}, _) -> I;
- ([], Max) -> Max end,
- -1, Regs)+1.
-
+ foldl(fun ({I,_}, _) ->
+ I
+ end, -1, Regs)+1.
+
%%%
%%% Convert a block to Static Single Assignment (SSA) form.
@@ -748,8 +748,7 @@ initialized_regs([{bs_context_to_binary,Src}|Is], Regs) ->
initialized_regs([{label,_},{func_info,_,_,Arity}|_], Regs) ->
InitRegs = free_vars_regs(Arity),
add_init_regs(InitRegs, Regs);
-initialized_regs([_|_], Regs) -> Regs;
-initialized_regs([], Regs) -> Regs.
+initialized_regs([_|_], Regs) -> Regs.
add_init_regs([{x,_}=X|T], Regs) ->
add_init_regs(T, ordsets:add_element(X, Regs));
diff --git a/lib/compiler/src/beam_bsm.erl b/lib/compiler/src/beam_bsm.erl
index 2a36fda1ea..415864b8e9 100644
--- a/lib/compiler/src/beam_bsm.erl
+++ b/lib/compiler/src/beam_bsm.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2007-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
@@ -651,10 +651,8 @@ add_warning(Term, Anno, Ws) ->
warning_translate_label(Term, D) when is_tuple(Term) ->
case element(1, Term) of
{label,F} ->
- case gb_trees:lookup(F, D) of
- none -> Term;
- {value,FA} -> setelement(1, Term, FA)
- end;
+ FA = gb_trees:get(F, D),
+ setelement(1, Term, FA);
_ -> Term
end;
warning_translate_label(Term, _) -> Term.
diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl
index 7b4cd814a2..1365f3d20a 100644
--- a/lib/compiler/src/beam_dead.erl
+++ b/lib/compiler/src/beam_dead.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2002-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%
%%
@@ -162,14 +162,11 @@ function({function,Name,Arity,CLabel,Is0}, Lc0) ->
%% We must split the basic block when we encounter instructions with labels,
%% such as catches and BIFs. All labels must be visible outside the blocks.
-%% Also remove empty blocks.
split_blocks({function,Name,Arity,CLabel,Is0}) ->
Is = split_blocks(Is0, []),
{function,Name,Arity,CLabel,Is}.
-split_blocks([{block,[]}|Is], Acc) ->
- split_blocks(Is, Acc);
split_blocks([{block,Bl}|Is], Acc0) ->
Acc = split_block(Bl, [], Acc0),
split_blocks(Is, Acc);
@@ -246,30 +243,24 @@ forward([{select_val,Reg,_,{list,List}}=I|Is], D0, Lc, Acc) ->
D = update_value_dict(List, Reg, D0),
forward(Is, D, Lc, [I|Acc]);
forward([{label,Lbl}=LblI,{block,[{set,[Dst],[Lit],move}|BlkIs]}=Blk|Is], D, Lc, Acc) ->
+ %% Assumption: The target labels in a select_val/3 instruction
+ %% cannot be reached in any other way than through the select_val/3
+ %% instruction (i.e. there can be no fallthrough to such label and
+ %% it cannot be referenced by, for example, a jump/1 instruction).
Block = case gb_trees:lookup({Lbl,Dst}, D) of
- {value,Lit} ->
- %% The move instruction seems to be redundant, but also make
- %% sure that the instruction preceeding the label
- %% cannot fall through to the move instruction.
- case is_unreachable_after(Acc) of
- false -> Blk; %Must keep move instruction.
- true -> {block,BlkIs} %Safe to remove move instruction.
- end;
- _ -> Blk %Keep move instruction.
+ {value,Lit} -> {block,BlkIs}; %Safe to remove move instruction.
+ _ -> Blk %Must keep move instruction.
end,
forward([Block|Is], D, Lc, [LblI|Acc]);
forward([{label,Lbl}=LblI|[{move,Lit,Dst}|Is1]=Is0], D, Lc, Acc) ->
+ %% Assumption: The target labels in a select_val/3 instruction
+ %% cannot be reached in any other way than through the select_val/3
+ %% instruction (i.e. there can be no fallthrough to such label and
+ %% it cannot be referenced by, for example, a jump/1 instruction).
Is = case gb_trees:lookup({Lbl,Dst}, D) of
- {value,Lit} ->
- %% The move instruction seems to be redundant, but also make
- %% sure that the instruction preceeding the label
- %% cannot fall through to the move instruction.
- case is_unreachable_after(Acc) of
- false -> Is0; %Must keep move instruction.
- true -> Is1 %Safe to remove move instruction.
- end;
- _ -> Is0 %Keep move instruction.
- end,
+ {value,Lit} -> Is1; %Safe to remove move instruction.
+ _ -> Is0 %Keep move instruction.
+ end,
forward(Is, D, Lc, [LblI|Acc]);
forward([{test,is_eq_exact,_,[Dst,Src]}=I,
{block,[{set,[Dst],[Src],move}|Bl]}|Is], D, Lc, Acc) ->
@@ -281,12 +272,12 @@ forward([{test,is_eq_exact,_,[Dst,Src]}=I,{move,Src,Dst}|Is], D, Lc, Acc) ->
forward([I|Is], D, Lc, Acc);
forward([{test,is_nil,_,[Dst]}=I,{move,nil,Dst}|Is], D, Lc, Acc) ->
forward([I|Is], D, Lc, Acc);
-forward([{test,is_eq_exact,_,[_,{atom,_}]}=I|Is], D, Lc, [{label,_}|_]=Acc) ->
+forward([{test,is_eq_exact,_,_}=I|Is], D, Lc, Acc) ->
case Is of
[{label,_}|_] -> forward(Is, D, Lc, [I|Acc]);
_ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc])
end;
-forward([{test,is_ne_exact,_,[_,{atom,_}]}=I|Is], D, Lc, [{label,_}|_]=Acc) ->
+forward([{test,is_ne_exact,_,_}=I|Is], D, Lc, Acc) ->
case Is of
[{label,_}|_] -> forward(Is, D, Lc, [I|Acc]);
_ -> forward(Is, D, Lc+1, [{label,Lc},I|Acc])
@@ -299,16 +290,12 @@ update_value_dict([Lit,{f,Lbl}|T], Reg, D0) ->
Key = {Lbl,Reg},
D = case gb_trees:lookup(Key, D0) of
none -> gb_trees:insert(Key, Lit, D0); %New.
- {value,Lit} -> D0; %Already correct.
{value,inconsistent} -> D0; %Inconsistent.
{value,_} -> gb_trees:update(Key, inconsistent, D0)
end,
update_value_dict(T, Reg, D);
update_value_dict([], _, D) -> D.
-is_unreachable_after([I|_]) ->
- beam_jump:is_unreachable_after(I).
-
%%%
%%% Scan instructions in reverse execution order and remove dead code.
%%%
@@ -371,10 +358,10 @@ backward([{test,bs_start_match2,{f,To0},Live,[Src|_]=Info,Dst}|Is], D, Acc) ->
To = shortcut_bs_start_match(To0, Src, D),
I = {test,bs_start_match2,{f,To},Live,Info,Dst},
backward(Is, D, [I|Acc]);
-backward([{test,is_eq_exact=Op,{f,To0},[Reg,{atom,Val}]=Ops}|Is], D, Acc) ->
+backward([{test,is_eq_exact,{f,To0},[Reg,{atom,Val}]=Ops}|Is], D, Acc) ->
To1 = shortcut_bs_test(To0, Is, D),
To = shortcut_fail_label(To1, Reg, Val, D),
- I = {test,Op,{f,To},Ops},
+ I = combine_eqs(To, Ops, D, Acc),
backward(Is, D, [I|Acc]);
backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) ->
To1 = shortcut_bs_test(To0, Is, D),
@@ -394,7 +381,10 @@ backward([{test,Op,{f,To0},Ops0}|Is], D, Acc) ->
_Code ->
To2
end,
- I = {test,Op,{f,To},Ops0},
+ I = case Op of
+ is_eq_exact -> combine_eqs(To, Ops0, D, Acc);
+ _ -> {test,Op,{f,To},Ops0}
+ end,
backward(Is, D, [I|Acc]);
backward([{test,Op,{f,To0},Live,Ops0,Dst}|Is], D, Acc) ->
To1 = shortcut_bs_test(To0, Is, D),
@@ -519,6 +509,41 @@ bif_to_test(Name, Args, Fail) ->
not_possible() -> throw(not_possible).
+%% combine_eqs(To, Operands, Acc) -> Instruction.
+%% Combine two is_eq_exact instructions or (an is_eq_exact
+%% instruction and a select_val instruction) to a select_val
+%% instruction if possible.
+%%
+%% Example:
+%%
+%% is_eq_exact F1 Reg Lit1 select_val Reg F2 [ Lit1 L1
+%% L1: . Lit2 L2 ]
+%% .
+%% . ==>
+%% .
+%% F1: is_eq_exact F2 Reg Lit2 F1: is_eq_exact F2 Reg Lit2
+%% L2: .... L2:
+%%
+combine_eqs(To, [Reg,{Type,_}=Lit1]=Ops, D, [{label,L1}|_])
+ when Type =:= atom; Type =:= integer ->
+ case beam_utils:code_at(To, D) of
+ [{test,is_eq_exact,{f,F2},[Reg,{Type,_}=Lit2]},
+ {label,L2}|_] when Lit1 =/= Lit2 ->
+ {select_val,Reg,{f,F2},{list,[Lit1,{f,L1},Lit2,{f,L2}]}};
+ [{select_val,Reg,{f,F2},{list,[{Type,_}|_]=List0}}|_] ->
+ List = remove_from_list(Lit1, List0),
+ {select_val,Reg,{f,F2},{list,[Lit1,{f,L1}|List]}};
+ _Is ->
+ {test,is_eq_exact,{f,To},Ops}
+ end;
+combine_eqs(To, Ops, _D, _Acc) ->
+ {test,is_eq_exact,{f,To},Ops}.
+
+remove_from_list(Lit, [Lit,{f,_}|T]) ->
+ T;
+remove_from_list(Lit, [Val,{f,_}=Fail|T]) ->
+ [Val,Fail|remove_from_list(Lit, T)];
+remove_from_list(_, []) -> [].
%% shortcut_bs_test(TargetLabel, [Instruction], D) -> TargetLabel'
%% Try to shortcut the failure label for a bit syntax matching.
@@ -564,16 +589,11 @@ count_bits_matched([{test,_,_,_}|Is], SavePoint, Bits) ->
count_bits_matched([{bs_save2,Reg,SavePoint}|_], {Reg,SavePoint}, Bits) ->
%% The save point we are looking for - we are done.
Bits;
-count_bits_matched([{bs_save2,_,_}|Is], SavePoint, Bits) ->
- %% Another save point - keep counting.
- count_bits_matched(Is, SavePoint, Bits);
count_bits_matched([_|_], _, Bits) -> Bits.
shortcut_bs_pos_used(To, Reg, D) ->
shortcut_bs_pos_used_1(beam_utils:code_at(To, D), Reg, D).
-shortcut_bs_pos_used_1([{bs_restore2,Reg,_}|_], Reg, _) ->
- false;
shortcut_bs_pos_used_1([{bs_context_to_binary,Reg}|_], Reg, _) ->
false;
shortcut_bs_pos_used_1(Is, Reg, D) ->
diff --git a/lib/compiler/src/beam_dict.erl b/lib/compiler/src/beam_dict.erl
index 4ffe8bc606..c50ed28aa9 100644
--- a/lib/compiler/src/beam_dict.erl
+++ b/lib/compiler/src/beam_dict.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%% 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
@@ -33,10 +33,9 @@
exports = [] :: [{label(), arity(), label()}],
locals = [] :: [{label(), arity(), label()}],
imports = gb_trees:empty() :: gb_tree(), %{{M,F,A},Index}
- strings = [] :: [string()], %String pool
+ strings = <<>> :: binary(), %String pool
lambdas = [], %[{...}]
literals = dict:new() :: dict(), %Format: {Literal,Number}
- next_atom = 1 :: pos_integer(),
next_import = 0 :: non_neg_integer(),
string_offset = 0 :: non_neg_integer(),
next_literal = 0 :: non_neg_integer(),
@@ -66,13 +65,14 @@ highest_opcode(#asm{highest_opcode=Op}) -> Op.
%% atom(Atom, Dict) -> {Index,Dict'}
-spec atom(atom(), bdict()) -> {pos_integer(), bdict()}.
-atom(Atom, #asm{atoms=Atoms0,next_atom=NextIndex}=Dict) when is_atom(Atom) ->
+atom(Atom, #asm{atoms=Atoms0}=Dict) when is_atom(Atom) ->
case gb_trees:lookup(Atom, Atoms0) of
{value,Index} ->
{Index,Dict};
none ->
+ NextIndex = gb_trees:size(Atoms0) + 1,
Atoms = gb_trees:insert(Atom, NextIndex, Atoms0),
- {NextIndex,Dict#asm{atoms=Atoms,next_atom=NextIndex+1}}
+ {NextIndex,Dict#asm{atoms=Atoms}}
end.
%% Remembers an exported function.
@@ -119,10 +119,11 @@ import(Mod0, Name0, Arity, #asm{imports=Imp0,next_import=NextIndex}=D0)
string(Str, Dict) when is_list(Str) ->
#asm{strings=Strings,string_offset=NextOffset} = Dict,
- case old_string(Str, Strings) of
+ StrBin = list_to_binary(Str),
+ case old_string(StrBin, Strings) of
none ->
- NewDict = Dict#asm{strings=Strings++Str,
- string_offset=NextOffset+length(Str)},
+ NewDict = Dict#asm{strings = <<Strings/binary,StrBin/binary>>,
+ string_offset=NextOffset+byte_size(StrBin)},
{NextOffset,NewDict};
Offset when is_integer(Offset) ->
{NextOffset-Offset,Dict}
@@ -138,7 +139,7 @@ lambda(Lbl, Index, OldUniq, NumFree, #asm{lambdas=Lambdas0}=Dict) ->
Lambdas = [{Lbl,{OldIndex,Lbl,Index,NumFree,OldUniq}}|Lambdas0],
{OldIndex,Dict#asm{lambdas=Lambdas}}.
-%% Returns the index for a literal (adding it to the atom table if necessary).
+%% Returns the index for a literal (adding it to the literal table if necessary).
%% literal(Literal, Dict) -> {Index,Dict'}
-spec literal(term(), bdict()) -> {non_neg_integer(), bdict()}.
@@ -155,14 +156,15 @@ literal(Lit, #asm{literals=Tab0,next_literal=NextIndex}=Dict) ->
%% atom_table(Dict) -> {LastIndex,[Length,AtomString...]}
-spec atom_table(bdict()) -> {non_neg_integer(), [[non_neg_integer(),...]]}.
-atom_table(#asm{atoms=Atoms,next_atom=NumAtoms}) ->
+atom_table(#asm{atoms=Atoms}) ->
+ NumAtoms = gb_trees:size(Atoms),
Sorted = lists:keysort(2, gb_trees:to_list(Atoms)),
Fun = fun({A,_}) ->
L = atom_to_list(A),
[length(L)|L]
end,
AtomTab = lists:map(Fun, Sorted),
- {NumAtoms-1,AtomTab}.
+ {NumAtoms,AtomTab}.
%% Returns the table of local functions.
%% local_table(Dict) -> {NumLocals, [{Function, Arity, Label}...]}
@@ -187,7 +189,7 @@ import_table(#asm{imports=Imp,next_import=NumImports}) ->
ImpTab = [MFA || {MFA,_} <- Sorted],
{NumImports,ImpTab}.
--spec string_table(bdict()) -> {non_neg_integer(), [string()]}.
+-spec string_table(bdict()) -> {non_neg_integer(), binary()}.
string_table(#asm{strings=Strings,string_offset=Size}) ->
{Size,Strings}.
@@ -217,15 +219,12 @@ literal_table(#asm{literals=Tab,next_literal=NumLiterals}) ->
my_term_to_binary(Term) ->
term_to_binary(Term, [{minor_version,1}]).
-%% Search for string Str in the string pool Pool.
+%% Search for binary string Str in the binary string pool Pool.
%% old_string(Str, Pool) -> none | Index
--spec old_string(string(), [string()]) -> 'none' | pos_integer().
-
-old_string([C|Str]=Str0, [C|Pool]) ->
- case lists:prefix(Str, Pool) of
- true -> length(Pool)+1;
- false -> old_string(Str0, Pool)
- end;
-old_string([_|_]=Str, [_|Pool]) ->
- old_string(Str, Pool);
-old_string([_|_], []) -> none.
+-spec old_string(binary(), binary()) -> 'none' | pos_integer().
+
+old_string(Str, Pool) ->
+ case binary:match(Pool, Str) of
+ nomatch -> none;
+ {Start,_Length} -> byte_size(Pool) - Start
+ end.
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index c956f2f000..5c4d8e12b5 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2000-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%
%%=======================================================================
%% Notes:
@@ -204,7 +204,7 @@ process_chunks(F) ->
optional_chunk(F, ChunkTag) ->
case beam_lib:chunks(F, [ChunkTag]) of
{ok,{_Module,[{ChunkTag,Chunk}]}} -> Chunk;
- {error,beam_lib,{missing_chunk,_,ChunkTag}} -> none
+ {error,beam_lib,{missing_chunk,_,_}} -> none
end.
%%-----------------------------------------------------------------------
@@ -621,8 +621,7 @@ resolve_names(Fun, Imports, Str, Lbls, Lambdas, Literals, M) ->
%%
%% New make_fun2/4 instruction added in August 2001 (R8).
-%% New put_literal/2 instruction added in Feb 2006 R11B-4.
-%% We handle them specially here to avoid adding an argument to
+%% We handle it specially here to avoid adding an argument to
%% the clause for every instruction.
%%
@@ -631,8 +630,6 @@ resolve_inst({make_fun2,Args}, _, _, _, Lambdas, _, M) ->
{OldIndex,{F,A,_Lbl,_Index,NumFree,OldUniq}} =
lists:keyfind(OldIndex, 1, Lambdas),
{make_fun2,{M,F,A},OldIndex,OldUniq,NumFree};
-resolve_inst({put_literal,[{u,Index},Dst]},_,_,_,_,Literals,_) ->
- {put_literal,{literal,gb_trees:get(Index, Literals)},Dst};
resolve_inst(Instr, Imports, Str, Lbls, _Lambdas, _Literals, _M) ->
%% io:format(?MODULE_STRING":resolve_inst ~p.~n", [Instr]),
resolve_inst(Instr, Imports, Str, Lbls).
@@ -1004,13 +1001,17 @@ resolve_inst({gc_bif2,Args},Imports,_,_) ->
[F,Live,Bif,A1,A2,Reg] = resolve_args(Args),
{extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports),
{gc_bif,BifName,F,Live,[A1,A2],Reg};
+%%
+%% New instruction in R14, gc_bif with 3 arguments
+%%
+resolve_inst({gc_bif3,Args},Imports,_,_) ->
+ [F,Live,Bif,A1,A2,A3,Reg] = resolve_args(Args),
+ {extfunc,_Mod,BifName,_Arity} = lookup(Bif+1,Imports),
+ {gc_bif,BifName,F,Live,[A1,A2,A3],Reg};
%%
%% New instructions for creating non-byte aligned binaries.
%%
-resolve_inst({bs_bits_to_bytes2,[_Arg2,_Arg3]=Args},_,_,_) ->
- [A2,A3] = resolve_args(Args),
- {bs_bits_to_bytes2,A2,A3};
resolve_inst({bs_final2,[X,Y]},_,_,_) ->
{bs_final2,X,Y};
@@ -1096,6 +1097,14 @@ resolve_inst({on_load,[]},_,_,_) ->
on_load;
%%
+%% R14A.
+%%
+resolve_inst({recv_mark,[Lbl]},_,_,_) ->
+ {recv_mark,Lbl};
+resolve_inst({recv_set,[Lbl]},_,_,_) ->
+ {recv_set,Lbl};
+
+%%
%% Catches instructions that are not yet handled.
%%
resolve_inst(X,_,_,_) -> ?exit({resolve_inst,X}).
diff --git a/lib/compiler/src/beam_flatten.erl b/lib/compiler/src/beam_flatten.erl
index d9de7e2495..6c7cb849aa 100644
--- a/lib/compiler/src/beam_flatten.erl
+++ b/lib/compiler/src/beam_flatten.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose : Converts intermediate assembly code to final format.
@@ -57,7 +57,6 @@ norm({set,[D],[S],fconv}) -> {fconv,S,D};
norm({set,[D],[S1,S2],put_list}) -> {put_list,S1,S2,D};
norm({set,[D],[],{put_tuple,A}}) -> {put_tuple,A,D};
norm({set,[],[S],put}) -> {put,S};
-norm({set,[D],[],{put_string,L,S}}) -> {put_string,L,S,D};
norm({set,[D],[S],{get_tuple_element,I}}) -> {get_tuple_element,S,I,D};
norm({set,[],[S,D],{set_tuple_element,I}}) -> {set_tuple_element,S,D,I};
norm({set,[D1,D2],[S],get_list}) -> {get_list,S,D1,D2};
diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl
index 739928f411..3cab55c4cb 100644
--- a/lib/compiler/src/beam_jump.erl
+++ b/lib/compiler/src/beam_jump.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%%% Purpose : Optimise jumps and remove unreachable code.
@@ -452,7 +452,6 @@ is_label_used_in_2({set,_,_,Info}, Lbl) ->
{'catch',{f,F}} -> F =:= Lbl;
{alloc,_,_} -> false;
{put_tuple,_} -> false;
- {put_string,_,_} -> false;
{get_tuple_element,_} -> false;
{set_tuple_element,_} -> false;
_ when is_atom(Info) -> false
diff --git a/lib/compiler/src/beam_peep.erl b/lib/compiler/src/beam_peep.erl
index d03ac4b1f4..f39fc50b95 100644
--- a/lib/compiler/src/beam_peep.erl
+++ b/lib/compiler/src/beam_peep.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2008-2010. 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%
%%
@@ -64,22 +64,7 @@ function({function,Name,Arity,CLabel,Is0}) ->
%% InEncoding =:= latin1, OutEncoding =:= unicode;
%% InEncoding =:= latin1, OutEncoding =:= utf8 ->
%%
-%% (2) Code like
-%%
-%% is_ne_exact Fail Reg Literal1
-%% is_ne_exact Fail Reg Literal2
-%% is_ne_exact Fail Reg Literal3
-%% is_eq_exact UltimateFail Reg Literal4
-%% Fail: ....
-%%
-%% can be rewritten to
-%%
-%% select_val Reg UltimateFail [ Literal1 Fail
-%% Literal2 Fail
-%% Literal3 Fail
-%% Literal4 Fail ]
-%%
-%% (3) A select_val/4 instruction that only verifies that
+%% (2) A select_val/4 instruction that only verifies that
%% its argument is either 'true' or 'false' can be
%% be replaced with an is_boolean/2 instruction. That is:
%%
@@ -132,7 +117,7 @@ peep([{test,Op,_,Ops}=I|Is], SeenTests0, Acc) ->
false ->
%% Remember that we have seen this test.
SeenTests = gb_sets:insert(Test, SeenTests0),
- make_select_val(I, Is, SeenTests, Acc)
+ peep(Is, SeenTests, [I|Acc])
end
end;
peep([{select_val,Src,Fail,
@@ -151,33 +136,6 @@ peep([I|Is], _, Acc) ->
peep(Is, gb_sets:empty(), [I|Acc]);
peep([], _, Acc) -> reverse(Acc).
-make_select_val({test,is_ne_exact,{f,Fail},[Val,Lit]}=I0,
- Is0, SeenTests, Acc) ->
- try
- Type = case Lit of
- {atom,_} -> atom;
- {integer,_} -> integer;
- _ -> throw(impossible)
- end,
- {I,Is} = make_select_val_1(Is0, Fail, Val, Type, [Lit,{f,Fail}]),
- peep([I|Is], SeenTests, Acc)
- catch
- impossible ->
- peep(Is0, SeenTests, [I0|Acc])
- end;
-make_select_val(I, Is, SeenTests, Acc) ->
- peep(Is, SeenTests, [I|Acc]).
-
-make_select_val_1([{test,is_ne_exact,{f,Fail},[Val,{Type,_}=Lit]}|Is],
- Fail, Val, Type, Acc) ->
- make_select_val_1(Is, Fail, Val, Type, [Lit,{f,Fail}|Acc]);
-make_select_val_1([{test,is_eq_exact,{f,UltimateFail},[Val,{Type,_}=Lit]} |
- [{label,Fail}|_]=Is], Fail, Val, Type, Acc) ->
- Choices = [Lit,{f,Fail}|Acc],
- I = {select_val,Val,{f,UltimateFail},{list,Choices}},
- {I,Is};
-make_select_val_1(_Is, _Fail, _Val, _Type, _Acc) -> throw(impossible).
-
kill_seen(Dst, Seen0) ->
gb_sets:from_ordset(kill_seen_1(gb_sets:to_list(Seen0), Dst)).
@@ -187,5 +145,3 @@ kill_seen_1([{_,Ops}=Test|T], Dst) ->
false -> [Test|kill_seen_1(T, Dst)]
end;
kill_seen_1([], _) -> [].
-
-
diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl
new file mode 100644
index 0000000000..9ed44ad5d7
--- /dev/null
+++ b/lib/compiler/src/beam_receive.erl
@@ -0,0 +1,388 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2010. 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_receive).
+-export([module/2]).
+-import(lists, [foldl/3,reverse/1,reverse/2]).
+
+%%%
+%%% In code such as:
+%%%
+%%% Ref = make_ref(), %Or erlang:monitor(process, Pid)
+%%% .
+%%% .
+%%% .
+%%% receive
+%%% {Ref,Reply} -> Reply
+%%% end.
+%%%
+%%% we know that none of the messages that exist in the message queue
+%%% before the call to make_ref/0 can be matched out in the receive
+%%% statement. Therefore we can avoid going through the entire message
+%%% queue if we introduce two new instructions (here written as
+%%% BIFs in pseudo-Erlang):
+%%%
+%%% recv_mark(SomeUniqInteger),
+%%% Ref = make_ref(),
+%%% .
+%%% .
+%%% .
+%%% recv_set(SomeUniqInteger),
+%%% receive
+%%% {Ref,Reply} -> Reply
+%%% end.
+%%%
+%%% The recv_mark/1 instruction will save the current position and
+%%% SomeUniqInteger in the process context. The recv_set
+%%% instruction will verify that SomeUniqInteger is still stored
+%%% in the process context. If it is, it will set the current pointer
+%%% for the message queue (the next message to be read out) to the
+%%% position that was saved by recv_mark/1.
+%%%
+%%% The remove_message instruction must be modified to invalidate
+%%% the information stored by the previous recv_mark/1, in case there
+%%% is another receive executed between the calls to recv_mark/1 and
+%%% recv_set/1.
+%%%
+%%% We use a reference to a label (i.e. a position in the loaded code)
+%%% as the SomeUniqInteger.
+%%%
+
+module({Mod,Exp,Attr,Fs0,Lc}, _Opts) ->
+ Fs = [function(F) || F <- Fs0],
+ Code = {Mod,Exp,Attr,Fs,Lc},
+ {ok,Code}.
+
+%%%
+%%% Local functions.
+%%%
+
+function({function,Name,Arity,Entry,Is}) ->
+ try
+ D = beam_utils:index_labels(Is),
+ {function,Name,Arity,Entry,opt(Is, D, [])}
+ catch
+ Class:Error ->
+ Stack = erlang:get_stacktrace(),
+ io:fwrite("Function: ~w/~w\n", [Name,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+opt([{call_ext,Arity,{extfunc,erlang,Name,Arity}}=I|Is0], D, Acc) ->
+ case creates_new_ref(Name, Arity) of
+ true ->
+ %% The call creates a brand new reference. Now
+ %% search for a receive statement in the same
+ %% function that will match against the reference.
+ case opt_recv(Is0, D) of
+ no ->
+ opt(Is0, D, [I|Acc]);
+ {yes,Is,Lbl} ->
+ opt(Is, D, [I,{recv_mark,{f,Lbl}}|Acc])
+ end;
+ false ->
+ opt(Is0, D, [I|Acc])
+ end;
+opt([I|Is], D, Acc) ->
+ opt(Is, D, [I|Acc]);
+opt([], _, Acc) ->
+ reverse(Acc).
+
+%% creates_new_ref(Name, Arity) -> true|false.
+%% Return 'true' if the BIF Name/Arity will create a new reference.
+creates_new_ref(monitor, 2) -> true;
+creates_new_ref(make_ref, 0) -> true;
+creates_new_ref(_, _) -> false.
+
+%% opt_recv([Instruction], LabelIndex) -> no|{yes,[Instruction]}
+%% Search for a receive statement that will only retrieve messages
+%% that contain the newly created reference (which is currently in {x,0}).
+opt_recv(Is, D) ->
+ R = regs_init_x0(),
+ L = gb_sets:empty(),
+ opt_recv(Is, D, R, L, []).
+
+opt_recv([{label,L}=Lbl,{loop_rec,{f,Fail},_}=Loop|Is], D, R0, _, Acc) ->
+ R = regs_kill_not_live(0, R0),
+ case regs_to_list(R) of
+ [{y,_}=RefReg] ->
+ %% We now have the new reference in the Y register RefReg
+ %% and the current instruction is the beginning of a
+ %% receive statement. We must now verify that only messages
+ %% that contain the reference will be matched.
+ case opt_ref_used(Is, RefReg, Fail, D) of
+ false ->
+ no;
+ true ->
+ RecvSet = {recv_set,{f,L}},
+ {yes,reverse(Acc, [RecvSet,Lbl,Loop|Is]),L}
+ end;
+ [] ->
+ no
+ end;
+opt_recv([I|Is], D, R0, L0, Acc) ->
+ {R,L} = opt_update_regs(I, R0, L0),
+ case regs_empty(R) of
+ true ->
+ %% The reference is no longer alive. There is no
+ %% point in continuing the search.
+ no;
+ false ->
+ opt_recv(Is, D, R, L, [I|Acc])
+ end.
+
+opt_update_regs({block,Bl}, R, L) ->
+ {opt_update_regs_bl(Bl, R),L};
+opt_update_regs({call,_,_}, R, L) ->
+ {regs_kill_not_live(0, R),L};
+opt_update_regs({call_ext,_,_}, R, L) ->
+ {regs_kill_not_live(0, R),L};
+opt_update_regs({call_fun,_}, R, L) ->
+ {regs_kill_not_live(0, R),L};
+opt_update_regs({kill,Y}, R, L) ->
+ {regs_kill([Y], R),L};
+opt_update_regs(send, R, L) ->
+ {regs_kill_not_live(0, R),L};
+opt_update_regs({'catch',_,{f,Lbl}}, R, L) ->
+ {R,gb_sets:add(Lbl, L)};
+opt_update_regs({catch_end,_}, R, L) ->
+ {R,L};
+opt_update_regs({label,Lbl}, R, L) ->
+ case gb_sets:is_member(Lbl, L) of
+ false ->
+ %% We can't allow arbitrary labels (since the receive
+ %% could be entered without first creating the reference).
+ {regs_init(),L};
+ true ->
+ %% A catch label for a previously seen catch instruction is OK.
+ {R,L}
+ end;
+opt_update_regs({try_end,_}, R, L) ->
+ {R,L};
+opt_update_regs(_I, _R, L) ->
+ %% Unrecognized instruction. Abort the search.
+ {regs_init(),L}.
+
+opt_update_regs_bl([{set,Ds,_,{alloc,Live,_}}|Is], Regs0) ->
+ Regs1 = regs_kill_not_live(Live, Regs0),
+ Regs = regs_kill(Ds, Regs1),
+ opt_update_regs_bl(Is, Regs);
+opt_update_regs_bl([{set,[Dst]=Ds,[Src],move}|Is], Regs0) ->
+ Regs1 = regs_kill(Ds, Regs0),
+ Regs = case regs_is_member(Src, Regs1) of
+ false -> Regs1;
+ true -> regs_add(Dst, Regs1)
+ end,
+ opt_update_regs_bl(Is, Regs);
+opt_update_regs_bl([{set,Ds,_,_}|Is], Regs0) ->
+ Regs = regs_kill(Ds, Regs0),
+ opt_update_regs_bl(Is, Regs);
+opt_update_regs_bl([], Regs) -> Regs.
+
+%% opt_ref_used([Instruction], RefRegister, FailLabel, LabelIndex) -> true|false
+%% Return 'true' if it is certain that only messages that contain the same
+%% reference as in RefRegister can be matched out. Otherwise return 'false'.
+%%
+%% Basically, we follow all possible paths through the receive statement.
+%% If all paths are safe, we return 'true'.
+%%
+%% A branch to FailLabel is safe, because it exits the receive statement
+%% and no further message may be matched out.
+%%
+%% If a path hits an comparision between RefRegister and part of the message,
+%% that path is safe (any messages that may be matched further down the
+%% path is guaranteed to contain the reference).
+%%
+%% Otherwise, if we hit a 'remove_message' instruction, we give up
+%% and return 'false' (the optimization is definitely unsafe). If
+%% we hit an unrecognized instruction, we also give up and return
+%% 'false' (the optimization may be unsafe).
+
+opt_ref_used(Is, RefReg, Fail, D) ->
+ Done = gb_sets:singleton(Fail),
+ Regs = regs_init_x0(),
+ try
+ opt_ref_used_1(Is, RefReg, D, Done, Regs),
+ true
+ catch
+ throw:not_used ->
+ false
+ end.
+
+%% This functions only returns if all paths through the receive
+%% statement are safe, and throws an 'not_used' term otherwise.
+opt_ref_used_1([{block,Bl}|Is], RefReg, D, Done, Regs0) ->
+ Regs = opt_ref_used_bl(Bl, Regs0),
+ opt_ref_used_1(Is, RefReg, D, Done, Regs);
+opt_ref_used_1([{test,is_eq_exact,{f,Fail},Args}|Is], RefReg, D, Done0, Regs) ->
+ Done = opt_ref_used_at(Fail, RefReg, D, Done0, Regs),
+ case is_ref_msg_comparison(Args, RefReg, Regs) of
+ false ->
+ opt_ref_used_1(Is, RefReg, D, Done, Regs);
+ true ->
+ %% The instructions that follow (Is) can only be executed
+ %% if the message contains the same reference as in RefReg.
+ Done
+ end;
+opt_ref_used_1([{test,is_ne_exact,{f,Fail},Args}|Is], RefReg, D, Done0, Regs) ->
+ Done = opt_ref_used_1(Is, RefReg, D, Done0, Regs),
+ case is_ref_msg_comparison(Args, RefReg, Regs) of
+ false ->
+ opt_ref_used_at(Fail, RefReg, D, Done, Regs);
+ true ->
+ Done
+ end;
+opt_ref_used_1([{test,_,{f,Fail},_}|Is], RefReg, D, Done0, Regs) ->
+ Done = opt_ref_used_at(Fail, RefReg, D, Done0, Regs),
+ opt_ref_used_1(Is, RefReg, D, Done, Regs);
+opt_ref_used_1([{select_tuple_arity,_,{f,Fail},{list,List}}|_], RefReg, D, Done, Regs) ->
+ Lbls = [F || {f,F} <- List] ++ [Fail],
+ opt_ref_used_in_all(Lbls, RefReg, D, Done, Regs);
+opt_ref_used_1([{select_val,_,{f,Fail},{list,List}}|_], RefReg, D, Done, Regs) ->
+ Lbls = [F || {f,F} <- List] ++ [Fail],
+ opt_ref_used_in_all(Lbls, RefReg, D, Done, Regs);
+opt_ref_used_1([{label,Lbl}|Is], RefReg, D, Done, Regs) ->
+ case gb_sets:is_member(Lbl, Done) of
+ true -> Done;
+ false -> opt_ref_used_1(Is, RefReg, D, Done, Regs)
+ end;
+opt_ref_used_1([{loop_rec_end,_}|_], _, _, Done, _) ->
+ Done;
+opt_ref_used_1([_I|_], _RefReg, _D, _Done, _Regs) ->
+ %% The optimization may be unsafe.
+ throw(not_used).
+
+%% is_ref_msg_comparison(Args, RefReg, RegisterSet) -> true|false.
+%% Return 'true' if Args denotes a comparison between the
+%% reference and message or part of the message.
+is_ref_msg_comparison([R,RefReg], RefReg, Regs) ->
+ regs_is_member(R, Regs);
+is_ref_msg_comparison([RefReg,R], RefReg, Regs) ->
+ regs_is_member(R, Regs);
+is_ref_msg_comparison([_,_], _, _) -> false.
+
+opt_ref_used_in_all([L|Ls], RefReg, D, Done0, Regs) ->
+ Done = opt_ref_used_at(L, RefReg, D, Done0, Regs),
+ opt_ref_used_in_all(Ls, RefReg, D, Done, Regs);
+opt_ref_used_in_all([], _, _, Done, _) -> Done.
+
+opt_ref_used_at(Fail, RefReg, D, Done0, Regs) ->
+ case gb_sets:is_member(Fail, Done0) of
+ true ->
+ Done0;
+ false ->
+ Is = beam_utils:code_at(Fail, D),
+ Done = opt_ref_used_1(Is, RefReg, D, Done0, Regs),
+ gb_sets:add(Fail, Done)
+ end.
+
+opt_ref_used_bl([{set,[],[],remove_message}|_], _) ->
+ %% We have proved that a message that does not depend on the
+ %% reference can be matched out.
+ throw(not_used);
+opt_ref_used_bl([{set,Ds,Ss,_}|Is], Regs0) ->
+ case regs_all_members(Ss, Regs0) of
+ false ->
+ %% The destination registers may be assigned values that
+ %% are not dependent on the message being matched.
+ Regs = regs_kill(Ds, Regs0),
+ opt_ref_used_bl(Is, Regs);
+ true ->
+ %% All the sources depend on the message directly or
+ %% indirectly.
+ Regs = regs_add_list(Ds, Regs0),
+ opt_ref_used_bl(Is, Regs)
+ end;
+opt_ref_used_bl([], Regs) -> Regs.
+
+%%%
+%%% Functions for keeping track of a set of registers.
+%%%
+
+%% regs_init() -> RegisterSet
+%% Return an empty set of registers.
+
+regs_init() ->
+ {0,0}.
+
+%% regs_init_x0() -> RegisterSet
+%% Return a set that only contains the {x,0} register.
+
+regs_init_x0() ->
+ {1 bsl 0,0}.
+
+%% regs_empty(Register) -> true|false
+%% Test whether the register set is empty.
+
+regs_empty(R) ->
+ R =:= {0,0}.
+
+%% regs_kill_not_live(Live, RegisterSet) -> RegisterSet'
+%% Kill all registers indicated not live by Live.
+
+regs_kill_not_live(Live, {Xregs,Yregs}) ->
+ {Xregs band ((1 bsl Live)-1),Yregs}.
+
+%% regs_kill([Register], RegisterSet) -> RegisterSet'
+%% Kill all registers mentioned in the list of registers.
+
+regs_kill([{x,N}|Rs], {Xregs,Yregs}) ->
+ regs_kill(Rs, {Xregs band (bnot (1 bsl N)),Yregs});
+regs_kill([{y,N}|Rs], {Xregs,Yregs}) ->
+ regs_kill(Rs, {Xregs,Yregs band (bnot (1 bsl N))});
+regs_kill([{fr,_}|Rs], Regs) ->
+ regs_kill(Rs, Regs);
+regs_kill([], Regs) -> Regs.
+
+regs_add_list(List, Regs) ->
+ foldl(fun(R, A) -> regs_add(R, A) end, Regs, List).
+
+%% regs_add(Register, RegisterSet) -> RegisterSet'
+%% Add a new register to the set of registers.
+
+regs_add({x,N}, {Xregs,Yregs}) ->
+ {Xregs bor (1 bsl N),Yregs};
+regs_add({y,N}, {Xregs,Yregs}) ->
+ {Xregs,Yregs bor (1 bsl N)}.
+
+%% regs_all_members([Register], RegisterSet) -> true|false
+%% Test whether all of the registers are part of the register set.
+
+regs_all_members([R|Rs], Regs) ->
+ regs_is_member(R, Regs) andalso regs_all_members(Rs, Regs);
+regs_all_members([], _) -> true.
+
+%% regs_is_member(Register, RegisterSet) -> true|false
+%% Test whether Register is part of the register set.
+
+regs_is_member({x,N}, {Regs,_}) -> Regs band (1 bsl N) =/= 0;
+regs_is_member({y,N}, {_,Regs}) -> Regs band (1 bsl N) =/= 0;
+regs_is_member(_, _) -> false.
+
+%% regs_to_list(RegisterSet) -> [Register]
+%% Convert the register set to an explicit list of registers.
+regs_to_list({Xregs,Yregs}) ->
+ regs_to_list_1(Xregs, 0, x, regs_to_list_1(Yregs, 0, y, [])).
+
+regs_to_list_1(0, _, _, Acc) ->
+ Acc;
+regs_to_list_1(Regs, N, Tag, Acc) when (Regs band 1) =:= 1 ->
+ regs_to_list_1(Regs bsr 1, N+1, Tag, [{Tag,N}|Acc]);
+regs_to_list_1(Regs, N, Tag, Acc) ->
+ regs_to_list_1(Regs bsr 1, N+1, Tag, Acc).
diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl
index ba903a12b6..f83f73b224 100644
--- a/lib/compiler/src/beam_type.erl
+++ b/lib/compiler/src/beam_type.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose : Type-based optimisations.
@@ -76,9 +76,6 @@ simplify_basic_1([{set,[D],[{integer,Index},Reg],{bif,element,_}}=I0|Is], Ts0, A
end,
Ts = update(I, Ts0),
simplify_basic_1(Is, Ts, [I|Acc]);
-simplify_basic_1([{set,[_],[_],{bif,_,{f,0}}}=I|Is], Ts0, Acc) ->
- Ts = update(I, Ts0),
- simplify_basic_1(Is, Ts, [I|Acc]);
simplify_basic_1([{set,[D],[TupleReg],{get_tuple_element,0}}=I|Is0], Ts0, Acc) ->
case tdb_find(TupleReg, Ts0) of
{tuple,_,[Contents]} ->
@@ -118,7 +115,6 @@ simplify_basic_1([{test,is_record,_,[R,{atom,_}=Tag,{integer,Arity}]}=I|Is], Ts0
Ts = update(I, Ts0),
simplify_basic_1(Is, Ts, [I|Acc])
end;
-
simplify_basic_1([I|Is], Ts0, Acc) ->
Ts = update(I, Ts0),
simplify_basic_1(Is, Ts, [I|Acc]);
@@ -183,7 +179,7 @@ simplify_float_1([], Ts, Rs, Acc0) ->
{Is,Ts}.
opt_fmoves([{set,[{x,_}=R],[{fr,_}]=Src,fmove}=I1,
- {set,[{y,_}]=Dst,[{x,_}=R],move}=I2|Is], Acc) ->
+ {set,[_]=Dst,[{x,_}=R],move}=I2|Is], Acc) ->
case beam_utils:is_killed_block(R, Is) of
false -> opt_fmoves(Is, [I2,I1|Acc]);
true -> opt_fmoves(Is, [{set,Dst,Src,fmove}|Acc])
@@ -253,8 +249,6 @@ flt_need_heap_2({set,_,_,{put_tuple,_}}, H, Fl) ->
{[],H+1,Fl};
flt_need_heap_2({set,_,_,put}, H, Fl) ->
{[],H+1,Fl};
-flt_need_heap_2({set,_,_,{put_string,L,_Str}}, H, Fl) ->
- {[],H+2*L,Fl};
%% Then the "neutral" instructions. We just pass them.
flt_need_heap_2({set,[{fr,_}],_,_}, H, Fl) ->
{[],H,Fl};
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index ac249e6672..45cdf8a659 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2007-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose : Common utilities used by several optimization passes.
@@ -407,16 +407,23 @@ check_liveness(R, [{bif,Op,{f,Fail},Ss,D}|Is], St0) ->
Other ->
Other
end;
-check_liveness(R, [{gc_bif,Op,{f,Fail},_,Ss,D}|Is], St0) ->
- case check_liveness_fail(R, Op, Ss, Fail, St0) of
- {killed,St} = Killed ->
- case member(R, Ss) of
- true -> {used,St};
- false when R =:= D -> Killed;
- false -> check_liveness(R, Is, St)
- end;
- Other ->
- Other
+check_liveness(R, [{gc_bif,Op,{f,Fail},Live,Ss,D}|Is], St0) ->
+ case R of
+ {x,X} when X >= Live ->
+ {killed,St0};
+ {x,_} ->
+ {used,St0};
+ _ ->
+ case check_liveness_fail(R, Op, Ss, Fail, St0) of
+ {killed,St}=Killed ->
+ case member(R, Ss) of
+ true -> {used,St};
+ false when R =:= D -> Killed;
+ false -> check_liveness(R, Is, St)
+ end;
+ Other ->
+ Other
+ end
end;
check_liveness(R, [{bs_add,{f,0},Ss,D}|Is], St) ->
case member(R, Ss) of
@@ -424,12 +431,6 @@ check_liveness(R, [{bs_add,{f,0},Ss,D}|Is], St) ->
false when R =:= D -> {killed,St};
false -> check_liveness(R, Is, St)
end;
-check_liveness(R, [{bs_bits_to_bytes2,Src,Dst}|Is], St) ->
- case R of
- Src -> {used,St};
- Dst -> {killed,St};
- _ -> check_liveness(R, Is, St)
- end;
check_liveness(R, [{bs_put_binary,{f,0},Sz,_,_,Src}|Is], St) ->
case member(R, [Sz,Src]) of
true -> {used,St};
@@ -488,10 +489,13 @@ check_liveness(R, [{bs_context_to_binary,S}|Is], St) ->
S -> {used,St};
_ -> check_liveness(R, Is, St)
end;
-check_liveness(R, [{loop_rec,{f,_},{x,0}}|Is], St) ->
+check_liveness(R, [{loop_rec,{f,_},{x,0}}|_], St) ->
case R of
- {x,_} -> {killed,St};
- _ -> check_liveness(R, Is, St)
+ {x,_} ->
+ {killed,St};
+ _ ->
+ %% y register. Rarely happens. Be very conversative.
+ {unknown,St}
end;
check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) ->
check_liveness_at(R, Fail, St);
diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl
index 1fd61831e0..fb267b35b6 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -18,6 +18,10 @@
-module(beam_validator).
+-compile({no_auto_import,[min/2]}).
+
+%% Avoid warning for local function error/1 clashing with autoimported BIF.
+-compile({no_auto_import,[error/1]}).
-export([file/1, files/1]).
%% Interface for compiler.
@@ -416,6 +420,11 @@ valfun_1({put,Src}, Vst) ->
valfun_1({put_string,Sz,_,Dst}, Vst0) when is_integer(Sz) ->
Vst = eat_heap(2*Sz, Vst0),
set_type_reg(cons, Dst, Vst);
+%% Instructions for optimization of selective receives.
+valfun_1({recv_mark,{f,Fail}}, Vst) when is_integer(Fail) ->
+ Vst;
+valfun_1({recv_set,{f,Fail}}, Vst) when is_integer(Fail) ->
+ Vst;
%% Misc.
valfun_1({'%live',Live}, Vst) ->
verify_live(Live, Vst),
@@ -752,9 +761,6 @@ valfun_4({bs_utf8_size,{f,Fail},A,Dst}, Vst) ->
valfun_4({bs_utf16_size,{f,Fail},A,Dst}, Vst) ->
assert_term(A, Vst),
set_type_reg({integer,[]}, Dst, branch_state(Fail, Vst));
-valfun_4({bs_bits_to_bytes2,Src,Dst}, Vst) ->
- assert_term(Src, Vst),
- set_type_reg({integer,[]}, 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));
diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 74fc0878cf..4b74d60e9f 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-2010. 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%
%% =====================================================================
@@ -122,6 +122,9 @@
bitstr_bitsize/1, bitstr_unit/1, bitstr_type/1,
bitstr_flags/1]).
+-export_type([c_binary/0, c_call/0, c_clause/0, c_cons/0, c_fun/0, c_literal/0,
+ c_module/0, c_tuple/0, c_values/0, c_var/0, cerl/0, var_name/0]).
+
%%
%% needed by the include file below -- do not move
%%
@@ -970,7 +973,7 @@ atom_name(Node) ->
%% TODO: replace the use of the unofficial 'write_string/2'.
--spec atom_lit(cerl()) -> string().
+-spec atom_lit(cerl()) -> nonempty_string().
atom_lit(Node) ->
io_lib:write_string(atom_name(Node), $'). %' stupid Emacs.
@@ -1076,7 +1079,7 @@ char_val(Node) ->
%%
%% @see c_char/1
--spec char_lit(c_literal()) -> string().
+-spec char_lit(c_literal()) -> nonempty_string().
char_lit(Node) ->
io_lib:write_char(char_val(Node)).
@@ -1175,7 +1178,7 @@ string_val(Node) ->
%%
%% @see c_string/1
--spec string_lit(c_literal()) -> string().
+-spec string_lit(c_literal()) -> nonempty_string().
string_lit(Node) ->
io_lib:write_string(string_val(Node)).
diff --git a/lib/compiler/src/cerl_clauses.erl b/lib/compiler/src/cerl_clauses.erl
index 5f111a5e05..99fa8dd9d5 100644
--- a/lib/compiler/src/cerl_clauses.erl
+++ b/lib/compiler/src/cerl_clauses.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-2010. 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%
%% @doc Utility functions for Core Erlang case/receive clauses.
@@ -338,10 +338,19 @@ match(P, E, Bs) ->
if E =:= any ->
{false, Bs};
true ->
- case is_data(E) of
- true ->
+ case type(E) of
+ literal ->
+ case is_bitstring(concrete(E)) of
+ false ->
+ none;
+ true ->
+ {false, Bs}
+ end;
+ cons ->
+ none;
+ tuple ->
none;
- false ->
+ _ ->
{false, Bs}
end
end;
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index 191efa3032..c15103999f 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-2010. 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%
%%
%% Core Erlang inliner.
@@ -65,7 +65,6 @@
try_evars/1, try_handler/1, tuple_es/1, tuple_arity/1,
type/1, values_es/1, var_name/1]).
--import(erlang, [max/2]).
-import(lists, [foldl/3, foldr/3, mapfoldl/3, reverse/1]).
%%
@@ -201,9 +200,9 @@ start(Reply, Tree, Ctxt, Opts) ->
false ->
ok
end,
- Size = max(1, proplists:get_value(inline_size, Opts)),
- Effort = max(1, proplists:get_value(inline_effort, Opts)),
- Unroll = max(1, proplists:get_value(inline_unroll, Opts)),
+ Size = erlang:max(1, proplists:get_value(inline_size, Opts)),
+ Effort = erlang:max(1, proplists:get_value(inline_effort, Opts)),
+ Unroll = erlang:max(1, proplists:get_value(inline_unroll, Opts)),
case proplists:get_bool(verbose, Opts) of
true ->
io:fwrite("Inlining: inline_size=~w inline_effort=~w\n",
@@ -1429,17 +1428,26 @@ inline(E, #app{opnds = Opnds, ctxt = Ctxt, loc = L}, Ren, Env, S) ->
{E, S};
true ->
%% Create local bindings for the parameters to their
- %% respective operand structures from the app-structure, and
- %% visit the body in the context saved in the structure.
+ %% respective operand structures from the app-structure.
{Rs, Ren1, Env1, S1} = bind_locals(Vs, Opnds, Ren, Env, S),
- {E1, S2} = i(fun_body(E), Ctxt, Ren1, Env1, S1),
+
+ %% function_clause exceptions that have been inlined
+ %% into another function (or even into the same function)
+ %% will not work properly. The v3_kernel pass will
+ %% take care of it, but we will need to help it by
+ %% removing any function_name annotations on match_fail
+ %% primops that we inline.
+ E1 = kill_function_name_anns(fun_body(E)),
+
+ %% Visit the body in the context saved in the structure.
+ {E2, S2} = i(E1, Ctxt, Ren1, Env1, S1),
%% Create necessary bindings and/or set flags.
- {E2, S3} = make_let_bindings(Rs, E1, S2),
+ {E3, S3} = make_let_bindings(Rs, E2, S2),
%% Lastly, flag the application as inlined, since the inlining
%% attempt was not aborted before we reached this point.
- {E2, st__set_app_inlined(L, S3)}
+ {E3, st__set_app_inlined(L, S3)}
end.
%% For the (possibly renamed) argument variables to an inlined call,
@@ -2370,6 +2378,19 @@ kill_id_anns([A | As]) ->
kill_id_anns([]) ->
[].
+kill_function_name_anns(Body) ->
+ F = fun(P) ->
+ case type(P) of
+ primop ->
+ Ann = get_ann(P),
+ Ann1 = lists:keydelete(function_name, 1, Ann),
+ set_ann(P, Ann1);
+ _ ->
+ P
+ end
+ end,
+ cerl_trees:map(F, Body).
+
%% =====================================================================
%% General utilities
diff --git a/lib/compiler/src/cerl_trees.erl b/lib/compiler/src/cerl_trees.erl
index 7a2057713e..1e3755025f 100644
--- a/lib/compiler/src/cerl_trees.erl
+++ b/lib/compiler/src/cerl_trees.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-2010. 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%
%% @doc Basic functions on Core Erlang abstract syntax trees.
@@ -73,14 +73,12 @@ depth(T) ->
[] ->
0;
Gs ->
- 1 + lists:foldl(fun (G, A) -> max(depth_1(G), A) end, 0, Gs)
+ 1 + lists:foldl(fun (G, A) -> erlang:max(depth_1(G), A) end, 0, Gs)
end.
depth_1(Ts) ->
- lists:foldl(fun (T, A) -> max(depth(T), A) end, 0, Ts).
+ lists:foldl(fun (T, A) -> erlang:max(depth(T), A) end, 0, Ts).
-max(X, Y) when X > Y -> X;
-max(_, Y) -> Y.
%% @spec size(Tree::cerl()) -> integer()
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index b853800d73..e46c667e47 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1996-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
@@ -29,6 +29,8 @@
%% Erlc interface.
-export([compile/3,compile_beam/3,compile_asm/3,compile_core/3]).
+-export_type([option/0]).
+
-include("erl_compile.hrl").
-include("core_parse.hrl").
@@ -39,8 +41,7 @@
-type option() :: atom() | {atom(), term()} | {'d', atom(), term()}.
--type line() :: integer().
--type err_info() :: {line(), module(), term()}. %% ErrorDescriptor
+-type err_info() :: {erl_scan:line(), module(), term()}. %% ErrorDescriptor
-type errors() :: [{file:filename(), [err_info()]}].
-type warnings() :: [{file:filename(), [err_info()]}].
-type mod_ret() :: {'ok', module()}
@@ -68,7 +69,7 @@
file(File) -> file(File, ?DEFAULT_OPTIONS).
--spec file(module() | file:filename(), [option()]) -> comp_ret().
+-spec file(module() | file:filename(), [option()] | option()) -> comp_ret().
file(File, Opts) when is_list(Opts) ->
do_compile({file,File}, Opts++env_default_opts());
@@ -86,6 +87,8 @@ forms(Forms, Opt) when is_atom(Opt) ->
%% would have generated a Beam file, false otherwise (if only a binary or a
%% listing file would have been generated).
+-spec output_generated([option()]) -> boolean().
+
output_generated(Opts) ->
noenv_output_generated(Opts++env_default_opts()).
@@ -94,6 +97,8 @@ output_generated(Opts) ->
%% for default options.
%%
+-spec noenv_file(module() | file:filename(), [option()] | option()) -> comp_ret().
+
noenv_file(File, Opts) when is_list(Opts) ->
do_compile({file,File}, Opts);
noenv_file(File, Opt) ->
@@ -104,16 +109,20 @@ noenv_forms(Forms, Opts) when is_list(Opts) ->
noenv_forms(Forms, Opt) when is_atom(Opt) ->
noenv_forms(Forms, [Opt|?DEFAULT_OPTIONS]).
+-spec noenv_output_generated([option()]) -> boolean().
+
noenv_output_generated(Opts) ->
- any(fun ({save_binary,_F}) -> true;
+ {_,Passes} = passes(file, expand_opts(Opts)),
+ any(fun ({save_binary,_T,_F}) -> true;
(_Other) -> false
- end, passes(file, expand_opts(Opts))).
+ end, Passes).
%%
%% Local functions
%%
-define(pass(P), {P,fun P/1}).
+-define(pass(P,T), {P,fun T/1,fun P/1}).
env_default_opts() ->
Key = "ERL_COMPILER_OPTIONS",
@@ -162,13 +171,12 @@ expand_opt(report, Os) ->
[report_errors,report_warnings|Os];
expand_opt(return, Os) ->
[return_errors,return_warnings|Os];
-expand_opt(r11, Os) ->
- [no_stack_trimming,no_binaries,no_constant_pool|Os];
+expand_opt(r12, Os) ->
+ [no_recv_opt|Os];
+expand_opt(r13, Os) ->
+ [no_recv_opt|Os];
expand_opt({debug_info_key,_}=O, Os) ->
[encrypt_debug_info,O|Os];
-expand_opt(no_binaries=O, Os) ->
- %%Turn off the entire type optimization pass.
- [no_topt,O|Os];
expand_opt(no_float_opt, Os) ->
%%Turn off the entire type optimization pass.
[no_topt|Os];
@@ -199,6 +207,9 @@ format_error(write_error) ->
format_error({rename,From,To,Error}) ->
io_lib:format("failed to rename ~s to ~s: ~s",
[From,To,file:format_error(Error)]);
+format_error({delete,File,Error}) ->
+ io_lib:format("failed to delete file ~s: ~s",
+ [File,file:format_error(Error)]);
format_error({delete_temp,File,Error}) ->
io_lib:format("failed to delete temporary file ~s: ~s",
[File,file:format_error(Error)]);
@@ -215,16 +226,16 @@ format_error({module_name,Mod,Filename}) ->
[Mod,Filename]).
%% The compile state record.
--record(compile, {filename="",
- dir="",
- base="",
- ifile="",
- ofile="",
+-record(compile, {filename="" :: file:filename(),
+ dir="" :: file:filename(),
+ base="" :: file:filename(),
+ ifile="" :: file:filename(),
+ ofile="" :: file:filename(),
module=[],
code=[],
core_code=[],
abstract_code=[], %Abstract code for debugger.
- options=[],
+ options=[] :: [option()],
errors=[],
warnings=[]}).
@@ -234,26 +245,12 @@ internal(Master, Input, Opts) ->
end}.
internal({forms,Forms}, Opts) ->
- Ps = passes(forms, Opts),
+ {_,Ps} = passes(forms, Opts),
internal_comp(Ps, "", "", #compile{code=Forms,options=Opts});
internal({file,File}, Opts) ->
- Ps = passes(file, Opts),
+ {Ext,Ps} = passes(file, Opts),
Compile = #compile{options=Opts},
- case member(from_core, Opts) of
- true -> internal_comp(Ps, File, ".core", Compile);
- false ->
- case member(from_beam, Opts) of
- true ->
- internal_comp(Ps, File, ".beam", Compile);
- false ->
- case member(from_asm, Opts) orelse member(asm, Opts) of
- true ->
- internal_comp(Ps, File, ".S", Compile);
- false ->
- internal_comp(Ps, File, ".erl", Compile)
- end
- end
- end.
+ internal_comp(Ps, File, Ext, Compile).
internal_comp(Passes, File, Suffix, St0) ->
Dir = filename:dirname(File),
@@ -295,15 +292,6 @@ fold_comp([{Name,Pass}|Ps], Run, St0) ->
end;
fold_comp([], _Run, St) -> {ok,St}.
-os_process_size() ->
- case os:type() of
- {unix, sunos} ->
- Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"),
- list_to_integer(lib:nonl(Size));
- _ ->
- 0
- end.
-
run_tc({Name,Fun}, St) ->
Before0 = statistics(runtime),
Val = (catch Fun(St)),
@@ -312,13 +300,12 @@ run_tc({Name,Fun}, St) ->
{After_c, _} = After0,
Mem0 = erts_debug:flat_size(Val)*erlang:system_info(wordsize),
Mem = lists:flatten(io_lib:format("~.1f kB", [Mem0/1024])),
- Sz = lists:flatten(io_lib:format("~.1f MB", [os_process_size()/1024])),
- io:format(" ~-30s: ~10.2f s ~12s ~10s\n",
- [Name,(After_c-Before_c) / 1000,Mem,Sz]),
+ io:format(" ~-30s: ~10.2f s ~12s\n",
+ [Name,(After_c-Before_c) / 1000,Mem]),
Val.
comp_ret_ok(#compile{code=Code,warnings=Warn0,module=Mod,options=Opts}=St) ->
- case member(warnings_as_errors, Opts) andalso length(Warn0) > 0 of
+ case werror(St) of
true ->
case member(report_warnings, Opts) of
true ->
@@ -353,6 +340,11 @@ comp_ret_err(#compile{warnings=Warn0,errors=Err0,options=Opts}=St) ->
false -> error
end.
+not_werror(St) -> not werror(St).
+
+werror(#compile{options=Opts,warnings=Ws}) ->
+ Ws =/= [] andalso member(warnings_as_errors, Opts).
+
%% messages_per_file([{File,[Message]}]) -> [{File,[Message]}]
messages_per_file(Ms) ->
T = lists:sort([{File,M} || {File,Messages} <- Ms, M <- Messages]),
@@ -371,42 +363,52 @@ mpf(Ms) ->
[{File,[M || {F,M} <- Ms, F =:= File]} ||
File <- lists:usort([F || {F,_} <- Ms])].
-%% passes(form|file, [Option]) -> [{Name,PassFun}]
-%% Figure out which passes that need to be run.
-
-passes(forms, Opts) ->
- case member(from_core, Opts) of
- true ->
- select_passes(core_passes(), Opts);
- false ->
- select_passes(standard_passes(), Opts)
+%% passes(forms|file, [Option]) -> {Extension,[{Name,PassFun}]}
+%% Figure out the extension of the input file and which passes
+%% that need to be run.
+
+passes(Type, Opts) ->
+ {Ext,Passes0} = passes_1(Opts),
+ Passes1 = case Type of
+ file -> Passes0;
+ forms -> tl(Passes0)
+ end,
+ Passes = select_passes(Passes1, Opts),
+
+ %% If the last pass saves the resulting binary to a file,
+ %% insert a first pass to remove the file (unless the
+ %% source file is a BEAM file).
+ {Ext,case last(Passes) of
+ {save_binary,_TestFun,_Fun} ->
+ case Passes of
+ [{read_beam_file,_}|_] ->
+ %% The BEAM is both input and output.
+ %% Don't remove it.
+ Passes;
+ _ ->
+ [?pass(remove_file)|Passes]
+ end;
+ _ ->
+ Passes
+ end}.
+
+passes_1([Opt|Opts]) ->
+ case pass(Opt) of
+ {_,_}=Res -> Res;
+ none -> passes_1(Opts)
end;
-passes(file, Opts) ->
- case member(from_beam, Opts) of
- true ->
- Ps = [?pass(read_beam_file)|binary_passes()],
- select_passes(Ps, Opts);
- false ->
- Ps = case member(from_asm, Opts) orelse member(asm, Opts) of
- true ->
- [?pass(beam_consult_asm)|asm_passes()];
- false ->
- case member(from_core, Opts) of
- true ->
- [?pass(parse_core)|core_passes()];
- false ->
- [?pass(parse_module)|standard_passes()]
- end
- end,
- Fs = select_passes(Ps, Opts),
-
- %% If the last pass saves the resulting binary to a file,
- %% insert a first pass to remove the file.
- case last(Fs) of
- {save_binary,_Fun} -> [?pass(remove_file)|Fs];
- _Other -> Fs
- end
- end.
+passes_1([]) ->
+ {".erl",[?pass(parse_module)|standard_passes()]}.
+
+pass(from_core) ->
+ {".core",[?pass(parse_core)|core_passes()]};
+pass(from_asm) ->
+ {".S",[?pass(beam_consult_asm)|asm_passes()]};
+pass(asm) ->
+ pass(from_asm);
+pass(from_beam) ->
+ {".beam",[?pass(read_beam_file)|binary_passes()]};
+pass(_) -> none.
%% select_passes([Command], Opts) -> [{Name,Function}]
%% Interpret the lists of commands to return a pure list of passes.
@@ -439,6 +441,8 @@ passes(file, Opts) ->
%% file will be Ext. (Ext should not contain
%% a period.) No more passes will be run.
%%
+%% done End compilation at this point.
+%%
%% {done,Ext} End compilation at this point. Produce a listing
%% as with {listing,Ext}, unless 'binary' is
%% specified, in which case the current
@@ -472,6 +476,8 @@ select_passes([{src_listing,Ext}|_], _Opts) ->
[{listing,fun (St) -> src_listing(Ext, St) end}];
select_passes([{listing,Ext}|_], _Opts) ->
[{listing,fun (St) -> listing(Ext, St) end}];
+select_passes([done|_], _Opts) ->
+ [];
select_passes([{done,Ext}|_], Opts) ->
select_passes([{unless,binary,{listing,Ext}}], Opts);
select_passes([{iff,Flag,Pass}|Ps], Opts) ->
@@ -554,6 +560,13 @@ select_list_passes_1([], _, Acc) ->
standard_passes() ->
[?pass(transform_module),
+
+ {iff,makedep,[
+ ?pass(makedep),
+ {unless,binary,?pass(makedep_output)}
+ ]},
+ {iff,makedep,done},
+
{iff,'dpp',{listing,"pp"}},
?pass(lint_module),
{iff,'P',{src_listing,"P"}},
@@ -590,7 +603,7 @@ core_passes() ->
kernel_passes() ->
%% Destructive setelement/3 optimization and core lint.
- [{unless,no_constant_pool,?pass(core_dsetel_module)}, %Not safe without constant pool.
+ [?pass(core_dsetel_module),
{iff,dsetel,{listing,"dsetel"}},
{iff,clint,?pass(core_lint_module)},
@@ -626,6 +639,8 @@ asm_passes() ->
{iff,dclean,{listing,"clean"}},
{unless,no_bsm_opt,{pass,beam_bsm}},
{iff,dbsm,{listing,"bsm"}},
+ {unless,no_recv_opt,{pass,beam_receive}},
+ {iff,drecv,{listing,"recv"}},
{unless,no_stack_trimming,{pass,beam_trim}},
{iff,dtrim,{listing,"trim"}},
{pass,beam_flatten}]},
@@ -646,7 +661,7 @@ asm_passes() ->
binary_passes() ->
[{native_compile,fun test_native/1,fun native_compile/1},
- {unless,binary,?pass(save_binary)}].
+ {unless,binary,?pass(save_binary,not_werror)}].
%%%
%%% Compiler passes.
@@ -826,6 +841,10 @@ foldl_transform(St, [T|Ts]) ->
{'EXIT',R} ->
Es = [{St#compile.ifile,[{none,compile,{parse_transform,T,R}}]}],
{error,St#compile{errors=St#compile.errors ++ Es}};
+ {warning, Forms, Ws} ->
+ foldl_transform(
+ St#compile{code=Forms,
+ warnings=St#compile.warnings ++ Ws}, Ts);
Forms ->
foldl_transform(St#compile{code=Forms}, Ts)
end;
@@ -835,7 +854,6 @@ get_core_transforms(Opts) -> [M || {core_transform,M} <- Opts].
core_transforms(St) ->
%% The options field holds the complete list of options at this
-
Ts = get_core_transforms(St#compile.options),
foldl_core_transforms(St, Ts).
@@ -900,6 +918,184 @@ core_lint_module(St) ->
errors=St#compile.errors ++ Es}}
end.
+makedep(#compile{code=Code,options=Opts}=St) ->
+ Ifile = St#compile.ifile,
+ Ofile = St#compile.ofile,
+
+ %% Get the target of the Makefile rule.
+ Target0 =
+ case proplists:get_value(makedep_target, Opts) of
+ undefined ->
+ %% The target is derived from the output filename: possibly
+ %% remove the current working directory to obtain a relative
+ %% path.
+ shorten_filename(Ofile);
+ T ->
+ %% The caller specified one.
+ T
+ end,
+
+ %% Quote the target is the called asked for this.
+ Target1 = case proplists:get_value(makedep_quote_target, Opts) of
+ true ->
+ %% For now, only "$" is replaced by "$$".
+ Fun = fun
+ ($$) -> "$$";
+ (C) -> C
+ end,
+ map(Fun, Target0);
+ _ ->
+ Target0
+ end,
+ Target = Target1 ++ ":",
+
+ %% List the dependencies (includes) for this target.
+ {MainRule,PhonyRules} = makedep_add_headers(
+ Ifile, % The input file name.
+ Code, % The parsed source.
+ [], % The list of dependencies already added.
+ length(Target), % The current line length.
+ Target, % The target.
+ "", % Phony targets.
+ Opts),
+
+ %% Prepare the content of the Makefile. For instance:
+ %% hello.erl: hello.hrl common.hrl
+ %%
+ %% Or if phony targets are enabled:
+ %% hello.erl: hello.hrl common.hrl
+ %%
+ %% hello.hrl:
+ %%
+ %% common.hrl:
+ Makefile = case proplists:get_value(makedep_phony, Opts) of
+ true -> MainRule ++ PhonyRules;
+ _ -> MainRule
+ end,
+ {ok,St#compile{code=iolist_to_binary([Makefile,"\n"])}}.
+
+makedep_add_headers(Ifile, [{attribute,_,file,{File,_}}|Rest],
+ Included, LineLen, MainTarget, Phony, Opts) ->
+ %% The header "File" exists, add it to the dependencies.
+ {Included1,LineLen1,MainTarget1,Phony1} =
+ makedep_add_header(Ifile, Included, LineLen, MainTarget, Phony, File),
+ makedep_add_headers(Ifile, Rest, Included1, LineLen1,
+ MainTarget1, Phony1, Opts);
+makedep_add_headers(Ifile, [{error,{_,epp,{include,file,File}}}|Rest],
+ Included, LineLen, MainTarget, Phony, Opts) ->
+ %% The header "File" doesn't exist, do we add it to the dependencies?
+ case proplists:get_value(makedep_add_missing, Opts) of
+ true ->
+ {Included1,LineLen1,MainTarget1,Phony1} =
+ makedep_add_header(Ifile, Included, LineLen, MainTarget,
+ Phony, File),
+ makedep_add_headers(Ifile, Rest, Included1, LineLen1,
+ MainTarget1, Phony1, Opts);
+ _ ->
+ makedep_add_headers(Ifile, Rest, Included, LineLen,
+ MainTarget, Phony, Opts)
+ end;
+makedep_add_headers(Ifile, [_|Rest], Included, LineLen,
+ MainTarget, Phony, Opts) ->
+ makedep_add_headers(Ifile, Rest, Included,
+ LineLen, MainTarget, Phony, Opts);
+makedep_add_headers(_Ifile, [], _Included, _LineLen,
+ MainTarget, Phony, _Opts) ->
+ {MainTarget,Phony}.
+
+makedep_add_header(Ifile, Included, LineLen, MainTarget, Phony, File) ->
+ case member(File, Included) of
+ true ->
+ %% This file was already listed in the dependencies, skip it.
+ {Included,LineLen,MainTarget,Phony};
+ false ->
+ Included1 = [File|Included],
+
+ %% Remove "./" in front of the dependency filename.
+ File1 = case File of
+ "./" ++ File0 -> File0;
+ _ -> File
+ end,
+
+ %% Prepare the phony target name.
+ Phony1 = case File of
+ Ifile -> Phony;
+ _ -> Phony ++ "\n\n" ++ File1 ++ ":"
+ end,
+
+ %% Add the file to the dependencies. Lines longer than 76 columns
+ %% are splitted.
+ if
+ LineLen + 1 + length(File1) > 76 ->
+ LineLen1 = 2 + length(File1),
+ MainTarget1 = MainTarget ++ " \\\n " ++ File1,
+ {Included1,LineLen1,MainTarget1,Phony1};
+ true ->
+ LineLen1 = LineLen + 1 + length(File1),
+ MainTarget1 = MainTarget ++ " " ++ File1,
+ {Included1,LineLen1,MainTarget1,Phony1}
+ end
+ end.
+
+makedep_output(#compile{code=Code,options=Opts,ofile=Ofile}=St) ->
+ %% Write this Makefile (Code) to the selected output.
+ %% If no output is specified, the default is to write to a file named after
+ %% the output file.
+ Output0 = case proplists:get_value(makedep_output, Opts) of
+ undefined ->
+ %% Prepare the default filename.
+ outfile(filename:basename(Ofile, ".beam"), "Pbeam", Opts);
+ O ->
+ O
+ end,
+
+ %% If the caller specified an io_device(), there's nothing to do. If he
+ %% specified a filename, we must create it. Furthermore, this created file
+ %% must be closed before returning.
+ Ret = case Output0 of
+ _ when is_list(Output0) ->
+ case file:delete(Output0) of
+ Ret2 when Ret2 =:= ok; Ret2 =:= {error,enoent} ->
+ case file:open(Output0, [write]) of
+ {ok,IODev} ->
+ {ok,IODev,true};
+ {error,Reason2} ->
+ {error,open,Reason2}
+ end;
+ {error,Reason1} ->
+ {error,delete,Reason1}
+ end;
+ _ ->
+ {ok,Output0,false}
+ end,
+
+ case Ret of
+ {ok,Output1,CloseOutput} ->
+ try
+ %% Write the Makefile.
+ io:fwrite(Output1, "~s", [Code]),
+ %% Close the file if relevant.
+ if
+ CloseOutput -> file:close(Output1);
+ true -> ok
+ end,
+ {ok,St}
+ catch
+ exit:_ ->
+ %% Couldn't write to output Makefile.
+ Err = {St#compile.ifile,[{none,?MODULE,write_error}]},
+ {error,St#compile{errors=St#compile.errors++[Err]}}
+ end;
+ {error,open,Reason} ->
+ %% Couldn't open output Makefile.
+ Err = {St#compile.ifile,[{none,?MODULE,{open,Reason}}]},
+ {error,St#compile{errors=St#compile.errors++[Err]}};
+ {error,delete,Reason} ->
+ %% Couldn't open output Makefile.
+ Err = {St#compile.ifile,[{none,?MODULE,{delete,Output0,Reason}}]},
+ {error,St#compile{errors=St#compile.errors++[Err]}}
+ end.
+
%% expand_module(State) -> State'
%% Do the common preprocessing of the input forms.
@@ -909,13 +1105,8 @@ expand_module(#compile{code=Code,options=Opts0}=St0) ->
{ok,St0#compile{module=Mod,options=Opts,code={Mod,Exp,Forms}}}.
core_module(#compile{code=Code0,options=Opts}=St) ->
- case v3_core:module(Code0, Opts) of
- {ok,Code,Ws} ->
- {ok,St#compile{code=Code,warnings=St#compile.warnings ++ Ws}};
- {error,Es,Ws} ->
- {error,St#compile{warnings=St#compile.warnings ++ Ws,
- errors=St#compile.errors ++ Es}}
- end.
+ {ok,Code,Ws} = v3_core:module(Code0, Opts),
+ {ok,St#compile{code=Code,warnings=St#compile.warnings ++ Ws}}.
core_fold_module(#compile{code=Code0,options=Opts,warnings=Warns}=St) ->
{ok,Code,Ws} = sys_core_fold:module(Code0, Opts),
@@ -1184,38 +1375,44 @@ write_binary(Name, Bin, St) ->
%% report_errors(State) -> ok
%% report_warnings(State) -> ok
-report_errors(St) ->
- case member(report_errors, St#compile.options) of
+report_errors(#compile{options=Opts,errors=Errors}) ->
+ case member(report_errors, Opts) of
true ->
foreach(fun ({{F,_L},Eds}) -> list_errors(F, Eds);
({F,Eds}) -> list_errors(F, Eds) end,
- St#compile.errors);
+ Errors);
false -> ok
end.
report_warnings(#compile{options=Opts,warnings=Ws0}) ->
- case member(report_warnings, Opts) of
+ Werror = member(warnings_as_errors, Opts),
+ P = case Werror of
+ true -> "";
+ false -> "Warning: "
+ end,
+ ReportWerror = Werror andalso member(report_errors, Opts),
+ case member(report_warnings, Opts) orelse ReportWerror of
true ->
- Ws1 = flatmap(fun({{F,_L},Eds}) -> format_message(F, Eds);
- ({F,Eds}) -> format_message(F, Eds) end,
+ Ws1 = flatmap(fun({{F,_L},Eds}) -> format_message(F, P, Eds);
+ ({F,Eds}) -> format_message(F, P, Eds) end,
Ws0),
Ws = lists:sort(Ws1),
foreach(fun({_,Str}) -> io:put_chars(Str) end, Ws);
false -> ok
end.
-format_message(F, [{{Line,Column}=Loc,Mod,E}|Es]) ->
- M = {{F,Loc},io_lib:format("~s:~w:~w Warning: ~s\n",
- [F,Line,Column,Mod:format_error(E)])},
- [M|format_message(F, Es)];
-format_message(F, [{Line,Mod,E}|Es]) ->
- M = {{F,{Line,0}},io_lib:format("~s:~w: Warning: ~s\n",
- [F,Line,Mod:format_error(E)])},
- [M|format_message(F, Es)];
-format_message(F, [{Mod,E}|Es]) ->
- M = {none,io_lib:format("~s: Warning: ~s\n", [F,Mod:format_error(E)])},
- [M|format_message(F, Es)];
-format_message(_, []) -> [].
+format_message(F, P, [{{Line,Column}=Loc,Mod,E}|Es]) ->
+ M = {{F,Loc},io_lib:format("~s:~w:~w ~s~s\n",
+ [F,Line,Column,P,Mod:format_error(E)])},
+ [M|format_message(F, P, Es)];
+format_message(F, P, [{Line,Mod,E}|Es]) ->
+ M = {{F,{Line,0}},io_lib:format("~s:~w: ~s~s\n",
+ [F,Line,P,Mod:format_error(E)])},
+ [M|format_message(F, P, Es)];
+format_message(F, P, [{Mod,E}|Es]) ->
+ M = {none,io_lib:format("~s: ~s~s\n", [F,P,Mod:format_error(E)])},
+ [M|format_message(F, P, Es)];
+format_message(_, _, []) -> [].
%% list_errors(File, ErrorDescriptors) -> ok
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index b0311365c4..4ac879c9a4 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -1,19 +1,19 @@
% This is an -*- erlang -*- file.
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1997-2010. 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%
{application, compiler,
@@ -33,6 +33,7 @@
beam_listing,
beam_opcodes,
beam_peep,
+ beam_receive,
beam_trim,
beam_type,
beam_utils,
diff --git a/lib/compiler/src/core_lint.erl b/lib/compiler/src/core_lint.erl
index b633f568c9..b513a8965c 100644
--- a/lib/compiler/src/core_lint.erl
+++ b/lib/compiler/src/core_lint.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2010. 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
@@ -65,7 +65,8 @@
| {'return_mismatch', fa()} | {'undefined_function', fa()}
| {'duplicate_var', cerl:var_name(), fa()}
| {'unbound_var', cerl:var_name(), fa()}
- | {'undefined_function', fa(), fa()}.
+ | {'undefined_function', fa(), fa()}
+ | {'tail_segment_not_at_end', fa()}.
-type error() :: {module(), err_desc()}.
-type warning() :: {module(), term()}.
@@ -116,7 +117,9 @@ format_error({duplicate_var,N,{F,A}}) ->
format_error({unbound_var,N,{F,A}}) ->
io_lib:format("unbound variable ~s in ~w/~w", [N,F,A]);
format_error({undefined_function,{F1,A1},{F2,A2}}) ->
- io_lib:format("undefined function ~w/~w in ~w/~w", [F1,A1,F2,A2]).
+ io_lib:format("undefined function ~w/~w in ~w/~w", [F1,A1,F2,A2]);
+format_error({tail_segment_not_at_end,{F,A}}) ->
+ io_lib:format("binary tail segment not at end in ~w/~w", [F,A]).
-type ret() :: {'ok', [{module(), [warning(),...]}]}
| {'error', [{module(), [error(),...]}],
@@ -450,7 +453,8 @@ pattern(#c_cons{hd=H,tl=T}, Def, Ps, St) ->
pattern_list([H,T], Def, Ps, St);
pattern(#c_tuple{es=Es}, Def, Ps, St) ->
pattern_list(Es, Def, Ps, St);
-pattern(#c_binary{segments=Ss}, Def, Ps, St) ->
+pattern(#c_binary{segments=Ss}, Def, Ps, St0) ->
+ St = pat_bin_tail_check(Ss, St0),
pat_bin(Ss, Def, Ps, St);
pattern(#c_alias{var=V,pat=P}, Def, Ps, St0) ->
{Vvs,St1} = variable(V, Ps, St0),
@@ -482,6 +486,19 @@ pat_segment(#c_bitstr{val=V,size=S,type=T}, Def0, Ps0, St0) ->
pat_segment(_, Def, Ps, St) ->
{Ps,Def,add_error({not_bs_pattern,St#lint.func}, St)}.
+%% pat_bin_tail_check([Elem], State) -> State.
+%% There must be at most one tail segment (a size-less segment of
+%% type binary) and it must occur at the end.
+
+pat_bin_tail_check([#c_bitstr{size=#c_literal{val=all}}], St) ->
+ %% Size-less field is OK at the end of the list of segments.
+ St;
+pat_bin_tail_check([#c_bitstr{size=#c_literal{val=all}}|_], St) ->
+ add_error({tail_segment_not_at_end,St#lint.func}, St);
+pat_bin_tail_check([_|Ss], St) ->
+ pat_bin_tail_check(Ss, St);
+pat_bin_tail_check([], St) -> St.
+
%% pat_bit_expr(SizePat, Type, Defined, State) -> State.
%% Check the Size pattern, this is an input! Because of optimizations,
%% we must allow any kind of constant and literal here.
diff --git a/lib/compiler/src/erl_bifs.erl b/lib/compiler/src/erl_bifs.erl
index e87bb276de..f8128702dd 100644
--- a/lib/compiler/src/erl_bifs.erl
+++ b/lib/compiler/src/erl_bifs.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose: Information about the Erlang built-in functions.
@@ -65,6 +65,8 @@ is_pure(erlang, 'xor', 2) -> true;
is_pure(erlang, abs, 1) -> true;
is_pure(erlang, atom_to_binary, 2) -> true;
is_pure(erlang, atom_to_list, 1) -> true;
+is_pure(erlang, binary_part, 2) -> true;
+is_pure(erlang, binary_part, 3) -> true;
is_pure(erlang, binary_to_atom, 2) -> true;
is_pure(erlang, binary_to_list, 1) -> true;
is_pure(erlang, binary_to_list, 3) -> true;
diff --git a/lib/compiler/src/genop.tab b/lib/compiler/src/genop.tab
index 6874054495..63527bda8f 100644
--- a/lib/compiler/src/genop.tab
+++ b/lib/compiler/src/genop.tab
@@ -1,19 +1,19 @@
#
# %CopyrightBegin%
-#
-# Copyright Ericsson AB 1998-2009. All Rights Reserved.
-#
+#
+# Copyright Ericsson AB 1998-2010. 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%
#
BEAM_FORMAT_NUMBER=0
@@ -132,7 +132,7 @@ BEAM_FORMAT_NUMBER=0
#
# Building terms.
#
-68: put_string/3
+68: -put_string/3
69: put_list/3
70: put_tuple/2
71: put/1
@@ -208,7 +208,7 @@ BEAM_FORMAT_NUMBER=0
# New instructions in R10B.
109: bs_init2/6
-110: bs_bits_to_bytes/3
+110: -bs_bits_to_bytes/3
111: bs_add/5
112: apply/1
113: apply_last/2
@@ -274,3 +274,9 @@ BEAM_FORMAT_NUMBER=0
# R13B03
149: on_load/0
+
+# R14A
+
+150: recv_mark/1
+151: recv_set/1
+152: gc_bif3/7
diff --git a/lib/compiler/src/rec_env.erl b/lib/compiler/src/rec_env.erl
index 9b73e08ad8..31a1f8b0b7 100644
--- a/lib/compiler/src/rec_env.erl
+++ b/lib/compiler/src/rec_env.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-2010. 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%
%%
%% @author Richard Carlsson <[email protected]>
@@ -32,7 +32,7 @@
get/2, is_defined/2, is_empty/1, keys/1, lookup/2, new_key/1,
new_key/2, new_keys/2, new_keys/3, size/1, to_list/1]).
--import(erlang, [max/2]).
+-export_type([environment/0]).
-ifdef(DEBUG).
-export([test/1, test_custom/1, test_custom/2]).
@@ -586,7 +586,7 @@ new_key(N, R, _T, F, Env) ->
new_key(generate(N, R1), R1, 0, F, Env).
start_range(Env) ->
- max(env_size(Env) * ?START_RANGE_FACTOR, ?MINIMUM_RANGE).
+ erlang:max(env_size(Env) * ?START_RANGE_FACTOR, ?MINIMUM_RANGE).
%% The previous key might or might not be used to compute the next key
%% to be tried. It is currently not used.
diff --git a/lib/compiler/src/sys_core_dsetel.erl b/lib/compiler/src/sys_core_dsetel.erl
index c38eab7b42..f6696992b9 100644
--- a/lib/compiler/src/sys_core_dsetel.erl
+++ b/lib/compiler/src/sys_core_dsetel.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2002-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose : Using dsetelement to make multiple-field record updates
@@ -57,8 +57,6 @@
%% if X1 is used exactly once.
%% Thus, we need to track variable usage.
%%
-%% NOTE: This pass must NOT be used if the no_constant_pool option is used.
-%%
-module(sys_core_dsetel).
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 068478496b..6ea67741fa 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1999-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%
%%
%% Purpose : Constant folding optimisation for Core
@@ -460,7 +460,8 @@ eval_binary(#c_binary{anno=Anno,segments=Ss}=Bin) ->
Bin;
throw:{badarg,Warning} ->
add_warning(Bin, Warning),
- #c_call{module=#c_literal{val=erlang},
+ #c_call{anno=Anno,
+ module=#c_literal{val=erlang},
name=#c_literal{val=error},
args=[#c_literal{val=badarg}]}
end.
@@ -602,15 +603,23 @@ count_bits_1(Int, Bits) -> count_bits_1(Int bsr 64, Bits+64).
%% a rewritten expression consisting of a sequence of
%% the arguments only is returned.
-useless_call(effect, #c_call{module=#c_literal{val=Mod},
+useless_call(effect, #c_call{anno=Anno,
+ module=#c_literal{val=Mod},
name=#c_literal{val=Name},
args=Args}=Call) ->
A = length(Args),
case erl_bifs:is_safe(Mod, Name, A) of
false ->
case erl_bifs:is_pure(Mod, Name, A) of
- true -> add_warning(Call, result_ignored);
- false -> ok
+ true ->
+ case member(result_not_wanted, Anno) of
+ false ->
+ add_warning(Call, result_ignored);
+ true ->
+ ok
+ end;
+ false ->
+ ok
end,
no;
true ->
@@ -650,36 +659,34 @@ call_0(Call, M, N, As0, Sub) ->
%% We inline some very common higher order list operations.
%% We use the same evaluation order as the library function.
-call_1(_Call, lists, all, [Arg1,Arg2], Sub) ->
+call_1(#c_call{anno=Anno}, lists, all, [Arg1,Arg2], Sub) ->
Loop = #c_var{name={'lists^all',1}},
F = #c_var{name='F'},
Xs = #c_var{name='Xs'},
X = #c_var{name='X'},
Err1 = #c_tuple{es=[#c_literal{val='case_clause'}, X]},
CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
- body=#c_apply{op=Loop, args=[Xs]}},
+ body=#c_apply{anno=Anno, op=Loop, args=[Xs]}},
CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
body=#c_literal{val=false}},
CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err1]}},
+ body=match_fail(Anno, Err1)},
C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_case{arg=#c_apply{op=F, args=[X]},
+ body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]},
clauses = [CC1, CC2, CC3]}},
C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true},
body=#c_literal{val=true}},
Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]},
C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err2]}},
+ body=match_fail(Anno, Err2)},
Fun = #c_fun{vars=[Xs],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
L = #c_var{name='L'},
expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{op=Loop, args=[L]}}},
+ body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
Sub);
-call_1(_Call, lists, any, [Arg1,Arg2], Sub) ->
+call_1(#c_call{anno=Anno}, lists, any, [Arg1,Arg2], Sub) ->
Loop = #c_var{name={'lists^any',1}},
F = #c_var{name='F'},
Xs = #c_var{name='Xs'},
@@ -688,72 +695,71 @@ call_1(_Call, lists, any, [Arg1,Arg2], Sub) ->
CC1 = #c_clause{pats=[#c_literal{val=true}], guard=#c_literal{val=true},
body=#c_literal{val=true}},
CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
- body=#c_apply{op=Loop, args=[Xs]}},
+ body=#c_apply{anno=Anno, op=Loop, args=[Xs]}},
CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err1]}},
+ body=match_fail(Anno, Err1)},
C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_case{arg=#c_apply{op=F, args=[X]},
+ body=#c_case{arg=#c_apply{anno=Anno, op=F, args=[X]},
clauses = [CC1, CC2, CC3]}},
C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true},
body=#c_literal{val=false}},
Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]},
C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err2]}},
+ body=match_fail(Anno, Err2)},
Fun = #c_fun{vars=[Xs],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
L = #c_var{name='L'},
expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{op=Loop, args=[L]}}},
+ body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
Sub);
-call_1(_Call, lists, foreach, [Arg1,Arg2], Sub) ->
+call_1(#c_call{anno=Anno}, lists, foreach, [Arg1,Arg2], Sub) ->
Loop = #c_var{name={'lists^foreach',1}},
F = #c_var{name='F'},
Xs = #c_var{name='Xs'},
X = #c_var{name='X'},
C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_seq{arg=#c_apply{op=F, args=[X]},
- body=#c_apply{op=Loop, args=[Xs]}}},
+ body=#c_seq{arg=#c_apply{anno=Anno, op=F, args=[X]},
+ body=#c_apply{anno=Anno, op=Loop, args=[Xs]}}},
C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true},
body=#c_literal{val=ok}},
Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]},
C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err]}},
+ body=match_fail(Anno, Err)},
Fun = #c_fun{vars=[Xs],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
L = #c_var{name='L'},
expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{op=Loop, args=[L]}}},
+ body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
Sub);
-call_1(_Call, lists, map, [Arg1,Arg2], Sub) ->
+call_1(#c_call{anno=Anno}, lists, map, [Arg1,Arg2], Sub) ->
Loop = #c_var{name={'lists^map',1}},
F = #c_var{name='F'},
Xs = #c_var{name='Xs'},
X = #c_var{name='X'},
H = #c_var{name='H'},
C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_let{vars=[H], arg=#c_apply{op=F, args=[X]},
+ body=#c_let{vars=[H], arg=#c_apply{anno=Anno,
+ op=F,
+ args=[X]},
body=#c_cons{hd=H,
- tl=#c_apply{op=Loop,
+ tl=#c_apply{anno=Anno,
+ op=Loop,
args=[Xs]}}}},
C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true},
body=#c_literal{val=[]}},
Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]},
C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err]}},
+ body=match_fail(Anno, Err)},
Fun = #c_fun{vars=[Xs],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
L = #c_var{name='L'},
expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{op=Loop, args=[L]}}},
+ body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
Sub);
-call_1(_Call, lists, flatmap, [Arg1,Arg2], Sub) ->
+call_1(#c_call{anno=Anno}, lists, flatmap, [Arg1,Arg2], Sub) ->
Loop = #c_var{name={'lists^flatmap',1}},
F = #c_var{name='F'},
Xs = #c_var{name='Xs'},
@@ -761,26 +767,27 @@ call_1(_Call, lists, flatmap, [Arg1,Arg2], Sub) ->
H = #c_var{name='H'},
C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
body=#c_let{vars=[H],
- arg=#c_apply{op=F, args=[X]},
- body=#c_call{module=#c_literal{val=erlang},
+ arg=#c_apply{anno=Anno, op=F, args=[X]},
+ body=#c_call{anno=Anno,
+ module=#c_literal{val=erlang},
name=#c_literal{val='++'},
args=[H,
- #c_apply{op=Loop,
+ #c_apply{anno=Anno,
+ op=Loop,
args=[Xs]}]}}},
C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true},
body=#c_literal{val=[]}},
Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]},
C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err]}},
+ body=match_fail(Anno, Err)},
Fun = #c_fun{vars=[Xs],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
L = #c_var{name='L'},
expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{op=Loop, args=[L]}}},
+ body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
Sub);
-call_1(_Call, lists, filter, [Arg1,Arg2], Sub) ->
+call_1(#c_call{anno=Anno}, lists, filter, [Arg1,Arg2], Sub) ->
Loop = #c_var{name={'lists^filter',1}},
F = #c_var{name='F'},
Xs = #c_var{name='Xs'},
@@ -792,72 +799,75 @@ call_1(_Call, lists, filter, [Arg1,Arg2], Sub) ->
CC2 = #c_clause{pats=[#c_literal{val=false}], guard=#c_literal{val=true},
body=Xs},
CC3 = #c_clause{pats=[X], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err1]}},
+ body=match_fail(Anno, Err1)},
Case = #c_case{arg=B, clauses = [CC1, CC2, CC3]},
C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
body=#c_let{vars=[B],
- arg=#c_apply{op=F, args=[X]},
+ arg=#c_apply{anno=Anno, op=F, args=[X]},
body=#c_let{vars=[Xs],
- arg=#c_apply{op=Loop,
+ arg=#c_apply{anno=Anno,
+ op=Loop,
args=[Xs]},
body=Case}}},
C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true},
body=#c_literal{val=[]}},
Err2 = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]},
C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err2]}},
+ body=match_fail(Anno, Err2)},
Fun = #c_fun{vars=[Xs],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
L = #c_var{name='L'},
expr(#c_let{vars=[F, L], arg=#c_values{es=[Arg1, Arg2]},
body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{op=Loop, args=[L]}}},
+ body=#c_apply{anno=Anno, op=Loop, args=[L]}}},
Sub);
-call_1(_Call, lists, foldl, [Arg1,Arg2,Arg3], Sub) ->
+call_1(#c_call{anno=Anno}, lists, foldl, [Arg1,Arg2,Arg3], Sub) ->
Loop = #c_var{name={'lists^foldl',2}},
F = #c_var{name='F'},
Xs = #c_var{name='Xs'},
X = #c_var{name='X'},
A = #c_var{name='A'},
C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_apply{op=Loop,
- args=[Xs, #c_apply{op=F, args=[X, A]}]}},
+ body=#c_apply{anno=Anno,
+ op=Loop,
+ args=[Xs, #c_apply{anno=Anno,
+ op=F,
+ args=[X, A]}]}},
C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, body=A},
Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]},
C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err]}},
+ body=match_fail(Anno, Err)},
Fun = #c_fun{vars=[Xs, A],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
L = #c_var{name='L'},
expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{op=Loop, args=[L, A]}}},
+ body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}},
Sub);
-call_1(_Call, lists, foldr, [Arg1,Arg2,Arg3], Sub) ->
+call_1(#c_call{anno=Anno}, lists, foldr, [Arg1,Arg2,Arg3], Sub) ->
Loop = #c_var{name={'lists^foldr',2}},
F = #c_var{name='F'},
Xs = #c_var{name='Xs'},
X = #c_var{name='X'},
A = #c_var{name='A'},
C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=#c_apply{op=F, args=[X, #c_apply{op=Loop,
- args=[Xs, A]}]}},
+ body=#c_apply{anno=Anno,
+ op=F,
+ args=[X, #c_apply{anno=Anno,
+ op=Loop,
+ args=[Xs, A]}]}},
C2 = #c_clause{pats=[#c_literal{val=[]}], guard=#c_literal{val=true}, body=A},
Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]},
C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err]}},
+ body=match_fail(Anno, Err)},
Fun = #c_fun{vars=[Xs, A],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
L = #c_var{name='L'},
expr(#c_let{vars=[F, A, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
body=#c_letrec{defs=[{Loop,Fun}],
- body=#c_apply{op=Loop, args=[L, A]}}},
+ body=#c_apply{anno=Anno, op=Loop, args=[L, A]}}},
Sub);
-call_1(_Call, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) ->
+call_1(#c_call{anno=Anno}, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) ->
Loop = #c_var{name={'lists^mapfoldl',2}},
F = #c_var{name='F'},
Xs = #c_var{name='Xs'},
@@ -868,15 +878,16 @@ call_1(_Call, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) ->
C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E},
Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]},
C2 = #c_clause{pats=[X], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err]}},
+ body=match_fail(Anno, Err)},
#c_case{arg=A, clauses=[C1, C2]}
end,
C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
- body=Match(#c_apply{op=F, args=[X, Avar]},
+ body=Match(#c_apply{anno=Anno, op=F, args=[X, Avar]},
#c_tuple{es=[X, Avar]},
%%% Tuple passing version
- Match(#c_apply{op=Loop, args=[Xs, Avar]},
+ Match(#c_apply{anno=Anno,
+ op=Loop,
+ args=[Xs, Avar]},
#c_tuple{es=[Xs, Avar]},
#c_tuple{es=[#c_cons{hd=X, tl=Xs}, Avar]})
%%% Multiple-value version
@@ -894,22 +905,23 @@ call_1(_Call, lists, mapfoldl, [Arg1,Arg2,Arg3], Sub) ->
%%% body=#c_values{es=[#c_literal{val=[]}, A]}},
Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]},
C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err]}},
+ body=match_fail(Anno, Err)},
Fun = #c_fun{vars=[Xs, Avar],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
L = #c_var{name='L'},
expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
body=#c_letrec{defs=[{Loop,Fun}],
%%% Tuple passing version
- body=#c_apply{op=Loop, args=[L, Avar]}}},
+ body=#c_apply{anno=Anno,
+ op=Loop,
+ args=[L, Avar]}}},
%%% Multiple-value version
%%% body=#c_let{vars=[Xs, A],
%%% arg=#c_apply{op=Loop,
%%% args=[L, A]},
%%% body=#c_tuple{es=[Xs, A]}}}},
Sub);
-call_1(_Call, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) ->
+call_1(#c_call{anno=Anno}, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) ->
Loop = #c_var{name={'lists^mapfoldr',2}},
F = #c_var{name='F'},
Xs = #c_var{name='Xs'},
@@ -920,15 +932,16 @@ call_1(_Call, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) ->
C1 = #c_clause{pats=[P], guard=#c_literal{val=true}, body=E},
Err = #c_tuple{es=[#c_literal{val='badmatch'}, X]},
C2 = #c_clause{pats=[X], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err]}},
+ body=match_fail(Anno, Err)},
#c_case{arg=A, clauses=[C1, C2]}
end,
C1 = #c_clause{pats=[#c_cons{hd=X, tl=Xs}], guard=#c_literal{val=true},
%%% Tuple passing version
- body=Match(#c_apply{op=Loop, args=[Xs, Avar]},
+ body=Match(#c_apply{anno=Anno,
+ op=Loop,
+ args=[Xs, Avar]},
#c_tuple{es=[Xs, Avar]},
- Match(#c_apply{op=F, args=[X, Avar]},
+ Match(#c_apply{anno=Anno, op=F, args=[X, Avar]},
#c_tuple{es=[X, Avar]},
#c_tuple{es=[#c_cons{hd=X, tl=Xs}, Avar]}))
%%% Multiple-value version
@@ -947,15 +960,16 @@ call_1(_Call, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) ->
%%% body=#c_values{es=[#c_literal{val=[]}, A]}},
Err = #c_tuple{es=[#c_literal{val='function_clause'}, Xs]},
C3 = #c_clause{pats=[Xs], guard=#c_literal{val=true},
- body=#c_primop{name=#c_literal{val='match_fail'},
- args=[Err]}},
+ body=match_fail(Anno, Err)},
Fun = #c_fun{vars=[Xs, Avar],
body=#c_case{arg=Xs, clauses=[C1, C2, C3]}},
L = #c_var{name='L'},
expr(#c_let{vars=[F, Avar, L], arg=#c_values{es=[Arg1, Arg2, Arg3]},
body=#c_letrec{defs=[{Loop,Fun}],
%%% Tuple passing version
- body=#c_apply{op=Loop, args=[L, Avar]}}},
+ body=#c_apply{anno=Anno,
+ op=Loop,
+ args=[L, Avar]}}},
%%% Multiple-value version
%%% body=#c_let{vars=[Xs, A],
%%% arg=#c_apply{op=Loop,
@@ -965,6 +979,11 @@ call_1(_Call, lists, mapfoldr, [Arg1,Arg2,Arg3], Sub) ->
call_1(#c_call{module=M, name=N}=Call, _, _, As, Sub) ->
call_0(Call, M, N, As, Sub).
+match_fail(Anno, Arg) ->
+ #c_primop{anno=Anno,
+ name=#c_literal{val='match_fail'},
+ args=[Arg]}.
+
%% fold_call(Call, Mod, Name, Args, Sub) -> Expr.
%% Try to safely evaluate the call. Just try to evaluate arguments,
%% do the call and convert return values to literals. If this
@@ -1030,6 +1049,8 @@ fold_non_lit_args(Call, lists, append, [Arg1,Arg2], _) ->
eval_append(Call, Arg1, Arg2);
fold_non_lit_args(Call, erlang, setelement, [Arg1,Arg2,Arg3], _) ->
eval_setelement(Call, Arg1, Arg2, Arg3);
+fold_non_lit_args(Call, erlang, is_record, [Arg1,Arg2,Arg3], Sub) ->
+ eval_is_record(Call, Arg1, Arg2, Arg3, Sub);
fold_non_lit_args(Call, erlang, N, Args, Sub) ->
NumArgs = length(Args),
case erl_internal:comp_op(N, NumArgs) of
@@ -1186,19 +1207,22 @@ eval_element(Call, #c_literal{val=Pos}, #c_tuple{es=Es}, _Types) when is_integer
true ->
eval_failure(Call, badarg)
end;
-%% eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types)
-%% when is_integer(Pos) ->
-%% case orddict:find(V, Types#sub.t) of
-%% {ok,#c_tuple{es=Elements}} ->
-%% if
-%% 1 =< Pos, Pos =< length(Elements) ->
-%% lists:nth(Pos, Elements);
-%% true ->
-%% eval_failure(Call, badarg)
-%% end;
-%% error ->
-%% Call
-%% end;
+eval_element(Call, #c_literal{val=Pos}, #c_var{name=V}, Types)
+ when is_integer(Pos) ->
+ case orddict:find(V, Types#sub.t) of
+ {ok,#c_tuple{es=Elements}} ->
+ if
+ 1 =< Pos, Pos =< length(Elements) ->
+ case lists:nth(Pos, Elements) of
+ #c_alias{var=Alias} -> Alias;
+ Res -> Res
+ end;
+ true ->
+ eval_failure(Call, badarg)
+ end;
+ error ->
+ Call
+ end;
eval_element(Call, Pos, Tuple, _Types) ->
case is_not_integer(Pos) orelse is_not_tuple(Tuple) of
true ->
@@ -1207,6 +1231,20 @@ eval_element(Call, Pos, Tuple, _Types) ->
Call
end.
+%% eval_is_record(Call, Var, Tag, Size, Types) -> Val.
+%% Evaluates is_record/3 using type information.
+%%
+eval_is_record(Call, #c_var{name=V}, #c_literal{val=NeededTag}=Lit,
+ #c_literal{val=Size}, Types) ->
+ case orddict:find(V, Types#sub.t) of
+ {ok,#c_tuple{es=[#c_literal{val=Tag}|_]=Es}} ->
+ Lit#c_literal{val=Tag =:= NeededTag andalso
+ length(Es) =:= Size};
+ _ ->
+ Call
+ end;
+eval_is_record(Call, _, _, _, _) -> Call.
+
%% is_not_integer(Core) -> true | false.
%% Returns true if Core is definitely not an integer.
@@ -1253,9 +1291,9 @@ eval_setelement_2(Pos, [H|T], NewVal) when Pos > 1 ->
%%
eval_failure(Call, Reason) ->
add_warning(Call, {eval_failure,Reason}),
- #c_call{module=#c_literal{val=erlang},
- name=#c_literal{val=error},
- args=[#c_literal{val=Reason}]}.
+ Call#c_call{module=#c_literal{val=erlang},
+ name=#c_literal{val=error},
+ args=[#c_literal{val=Reason}]}.
%% simplify_apply(Call0, Mod, Func, Args) -> Call
%% Simplify an apply/3 to a call if the number of arguments
@@ -1715,23 +1753,24 @@ opt_bool_clauses([_|_], _, _) ->
opt_bool_not(#c_case{arg=Arg,clauses=Cs0}=Case0) ->
case Arg of
- #c_call{module=#c_literal{val=erlang},
+ #c_call{anno=Anno,module=#c_literal{val=erlang},
name=#c_literal{val='not'},
args=[Expr]} ->
- Cs = opt_bool_not(Expr, Cs0),
+ Cs = opt_bool_not(Anno, Expr, Cs0),
Case = Case0#c_case{arg=Expr,clauses=Cs},
opt_bool_not(Case);
_ ->
opt_bool_case_redundant(Case0)
end.
-opt_bool_not(Expr, Cs) ->
+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{module=#c_literal{val=erlang},
+ body=#c_call{anno=Anno,
+ module=#c_literal{val=erlang},
name=#c_literal{val=error},
args=[#c_literal{val=badarg}]}}];
true -> []
@@ -1930,13 +1969,25 @@ case_tuple_pat([#c_tuple{es=Ps}], Arity) when length(Ps) =:= Arity ->
case_tuple_pat([#c_literal{val=T}], Arity) when tuple_size(T) =:= Arity ->
Ps = [#c_literal{val=E} || E <- tuple_to_list(T)],
{ok,Ps,[]};
-case_tuple_pat([#c_var{anno=A}=V], Arity) ->
- Vars = make_vars(A, 1, Arity),
- {ok,Vars,[{V,#c_tuple{es=Vars}}]};
+case_tuple_pat([#c_var{anno=Anno0}=V], Arity) ->
+ Vars = make_vars(Anno0, 1, Arity),
+
+ %% If the entire case statement is evaluated in an effect
+ %% context (e.g. "case {A,B} of ... end, ok"), there will
+ %% be a warning that a term is constructed but never used.
+ %% To avoid that warning, we must annotate the tuple as
+ %% compiler generated.
+
+ Anno = [compiler_generated|Anno0],
+ {ok,Vars,[{V,#c_tuple{anno=Anno,es=Vars}}]};
case_tuple_pat([#c_alias{var=V,pat=P}], Arity) ->
case case_tuple_pat([P], Arity) of
- {ok,Ps,Avs} -> {ok,Ps,[{V,#c_tuple{es=unalias_pat_list(Ps)}}|Avs]};
- error -> error
+ {ok,Ps,Avs} ->
+ Anno0 = core_lib:get_anno(P),
+ Anno = [compiler_generated|Anno0],
+ {ok,Ps,[{V,#c_tuple{anno=Anno,es=unalias_pat_list(Ps)}}|Avs]};
+ error ->
+ error
end;
case_tuple_pat(_, _) -> error.
@@ -2806,7 +2857,8 @@ format_error({no_effect,{erlang,F,A}}) ->
end,
flatten(io_lib:format(Fmt, Args));
format_error(result_ignored) ->
- "the result of the expression is ignored";
+ "the result of the expression is ignored "
+ "(suppress the warning by assigning the expression to the _ variable)";
format_error(useless_building) ->
"a term is constructed, but never used";
format_error(bin_opt_alias) ->
diff --git a/lib/compiler/src/sys_core_inline.erl b/lib/compiler/src/sys_core_inline.erl
index c8d75b80c6..9f93acb666 100644
--- a/lib/compiler/src/sys_core_inline.erl
+++ b/lib/compiler/src/sys_core_inline.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2000-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose : Function inlining optimisation for Core.
@@ -41,11 +41,9 @@
-module(sys_core_inline).
-%%-compile({inline,{match_fail_fun,0}}).
-
-export([module/2]).
--import(lists, [member/2,map/2,foldl/3,mapfoldl/3]).
+-import(lists, [member/2,map/2,foldl/3,mapfoldl/3,keydelete/3]).
-include("core_parse.hrl").
@@ -178,11 +176,9 @@ weight_func(_Core, Acc) -> Acc + 1.
%% function_clause match_fail (if they have one).
match_fail_fun() ->
- fun (#c_primop{name=#c_literal{val=match_fail},
- args=[#c_tuple{es=[#c_literal{val=function_clause}|As]}]}=P) ->
- Fail = #c_tuple{es=[#c_literal{val=case_clause},
- #c_tuple{es=As}]},
- P#c_primop{args=[Fail]};
+ fun (#c_primop{anno=Anno0,name=#c_literal{val=match_fail}}=P) ->
+ Anno = keydelete(function_name, 1, Anno0),
+ P#c_primop{anno=Anno};
(Other) -> Other
end.
@@ -201,7 +197,7 @@ kill_id_anns(Body) ->
(Expr) ->
%% Mark everything as compiler generated to suppress
%% bogus warnings.
- A = [compiler_generated|core_lib:get_anno(Expr)],
+ A = compiler_generated(core_lib:get_anno(Expr)),
core_lib:set_anno(Expr, A)
end, Body).
@@ -210,3 +206,8 @@ kill_id_anns_1([{'id',_}|As]) ->
kill_id_anns_1([A|As]) ->
[A|kill_id_anns_1(As)];
kill_id_anns_1([]) -> [].
+
+compiler_generated([compiler_generated|_]=Anno) ->
+ Anno;
+compiler_generated(Anno) ->
+ [compiler_generated|Anno -- [compiler_generated]].
diff --git a/lib/compiler/src/sys_pre_expand.erl b/lib/compiler/src/sys_pre_expand.erl
index f80d03dfac..249bd7a8e7 100644
--- a/lib/compiler/src/sys_pre_expand.erl
+++ b/lib/compiler/src/sys_pre_expand.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1996-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
@@ -223,10 +223,8 @@ attribute(export, Es, _L, St) ->
St#expand{exports=union(from_list(Es), St#expand.exports)};
attribute(import, Is, _L, St) ->
import(Is, St);
-attribute(compile, C, _L, St) when is_list(C) ->
- St#expand{compile=St#expand.compile ++ C};
-attribute(compile, C, _L, St) ->
- St#expand{compile=St#expand.compile ++ [C]};
+attribute(compile, _C, _L, St) ->
+ St;
attribute(Name, Val, Line, St) when is_list(Val) ->
St#expand{attributes=St#expand.attributes ++ [{Name,Line,Val}]};
attribute(Name, Val, Line, St) ->
@@ -403,16 +401,21 @@ expr({'fun',Line,Body}, St) ->
expr({call,Line,{atom,La,N}=Atom,As0}, St0) ->
{As,St1} = expr_list(As0, St0),
Ar = length(As),
- case erl_internal:bif(N, Ar) of
- true ->
- {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1};
- false ->
- case imported(N, Ar, St1) of
- {yes,Mod} ->
- {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1};
- no ->
- {{call,Line,Atom,As},St1}
- end
+ case defined(N,Ar,St1) of
+ true ->
+ {{call,Line,Atom,As},St1};
+ _ ->
+ case imported(N, Ar, St1) of
+ {yes,Mod} ->
+ {{call,Line,{remote,La,{atom,La,Mod},Atom},As},St1};
+ no ->
+ case erl_internal:bif(N, Ar) of
+ true ->
+ {{call,Line,{remote,La,{atom,La,erlang},Atom},As},St1};
+ false -> %% This should have been handled by erl_lint
+ {{call,Line,Atom,As},St1}
+ end
+ end
end;
expr({call,Line,{record_field,_,_,_}=M,As0}, St0) ->
expr({call,Line,expand_package(M, St0),As0}, St0);
@@ -685,3 +688,6 @@ imported(F, A, St) ->
{ok,Mod} -> {yes,Mod};
error -> no
end.
+
+defined(F, A, St) ->
+ ordsets:is_element({F,A}, St#expand.defined).
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index 83113d1652..55e3c58d2a 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1999-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%
%%
%% Purpose : Code generator for Beam.
@@ -209,7 +209,6 @@ need_heap_1(#l{ke={set,_,Val}}, H) ->
{[],H + case Val of
{cons,_} -> 2;
{tuple,Es} -> 1 + length(Es);
- {string,S} -> 2 * length(S);
_Other -> 0
end};
need_heap_1(#l{ke={bif,dsetelement,_As,_Rs},i=I}, H) ->
@@ -236,7 +235,7 @@ match_cg(M, Rs, Le, Vdb, Bef, St0) ->
I = Le#l.i,
{Sis,Int0} = adjust_stack(Bef, I, I+1, Vdb),
{B,St1} = new_label(St0),
- {Mis,Int1,St2} = match_cg(M, St0#cg.ultimate_failure,
+ {Mis,Int1,St2} = match_cg(M, St1#cg.ultimate_failure,
Int0, St1#cg{break=B}),
%% Put return values in registers.
Reg = load_vars(Rs, Int1#sr.reg),
@@ -1191,7 +1190,12 @@ trap_bif(_, _, _) -> false.
bif_cg(bs_context_to_binary=Instr, [Src0], [], Le, Vdb, Bef, St0) ->
[Src] = cg_reg_args([Src0], Bef),
- {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0};
+ case is_register(Src) of
+ false ->
+ {[],clear_dead(Bef, Le#l.i, Vdb), St0};
+ true ->
+ {[{Instr,Src}],clear_dead(Bef, Le#l.i, Vdb), St0}
+ end;
bif_cg(dsetelement, [Index0,Tuple0,New0], _Rs, Le, Vdb, Bef, St0) ->
[New,Tuple,{integer,Index1}] = cg_reg_args([New0,Tuple0,Index0], Bef),
Index = Index1-1,
@@ -1424,8 +1428,6 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->
[{put_tuple,length(Es),Ret}] ++ cg_build_args(Es, Bef);
{var,V} -> % Normally removed by kernel optimizer.
[{move,fetch_var(V, Int),Ret}];
- {string,Str} = String ->
- [{put_string,length(Str),String,Ret}];
Other ->
[{move,Other,Ret}]
end,
@@ -1521,7 +1523,9 @@ cg_binary_size_1([], Bits, Acc) ->
[{1,_}|_] ->
{bs_init_bits,cg_binary_bytes_to_bits(Sizes, [])};
[{8,_}|_] ->
- {bs_init2,[E || {8,E} <- Sizes]}
+ {bs_init2,[E || {8,E} <- Sizes]};
+ [] ->
+ {bs_init_bits,[]}
end.
cg_binary_size_2({integer,N}, U, _, Next, Bits, Acc) ->
@@ -2022,6 +2026,10 @@ fetch_stack(V, [_|Stk], I) -> fetch_stack(V, Stk, I+1).
on_stack(V, Stk) -> keymember(V, 1, Stk).
+is_register({x,_}) -> true;
+is_register({yy,_}) -> true;
+is_register(_) -> false.
+
%% put_catch(CatchTag, Stack) -> Stack'
%% drop_catch(CatchTag, Stack) -> Stack'
%% Special interface for putting and removing catch tags, to ensure that
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index dfe15de4ff..87bb5bec25 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%% Copyright Ericsson AB 1999-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
@@ -122,14 +122,13 @@
| iclause() | ifun() | iletrec() | imatch() | iprimop()
| iprotect() | ireceive1() | ireceive2() | iset() | itry().
--type error() :: {file:filename(), [{integer(), module(), term()}]}.
-type warning() :: {file:filename(), [{integer(), module(), term()}]}.
-record(core, {vcount=0 :: non_neg_integer(), %Variable counter
fcount=0 :: non_neg_integer(), %Function counter
in_guard=false :: boolean(), %In guard or not.
+ wanted=true :: boolean(), %Result wanted or not.
opts :: [compile:option()], %Options.
- es=[] :: [error()], %Errors.
ws=[] :: [warning()], %Warnings.
file=[{file,""}]}). %File
@@ -140,46 +139,41 @@
| {attribute, integer(), attribute(), _}.
-spec module({module(), [fa()], [form()]}, [compile:option()]) ->
- {'ok',cerl:c_module(),[warning()]} | {'error',[error()],[warning()]}.
+ {'ok',cerl:c_module(),[warning()]}.
module({Mod,Exp,Forms}, Opts) ->
Cexp = map(fun ({_N,_A} = NA) -> #c_var{name=NA} end, Exp),
- {Kfs0,As0,Es,Ws,_File} = foldl(fun (F, Acc) ->
- form(F, Acc, Opts)
- end, {[],[],[],[],[]}, Forms),
+ {Kfs0,As0,Ws,_File} = foldl(fun (F, Acc) ->
+ form(F, Acc, Opts)
+ end, {[],[],[],[]}, Forms),
Kfs = reverse(Kfs0),
As = reverse(As0),
- case Es of
- [] ->
- {ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws};
- _ ->
- {error,Es,Ws}
- end.
+ {ok,#c_module{name=#c_literal{val=Mod},exports=Cexp,attrs=As,defs=Kfs},Ws}.
-form({function,_,_,_,_}=F0, {Fs,As,Es0,Ws0,File}, Opts) ->
- {F,Es,Ws} = function(F0, Es0, Ws0, File, Opts),
- {[F|Fs],As,Es,Ws,File};
-form({attribute,_,file,{File,_Line}}, {Fs,As,Es,Ws,_}, _Opts) ->
- {Fs,As,Es,Ws,File};
-form({attribute,_,_,_}=F, {Fs,As,Es,Ws,File}, _Opts) ->
- {Fs,[attribute(F)|As],Es,Ws,File}.
+form({function,_,_,_,_}=F0, {Fs,As,Ws0,File}, Opts) ->
+ {F,Ws} = function(F0, Ws0, File, Opts),
+ {[F|Fs],As,Ws,File};
+form({attribute,_,file,{File,_Line}}, {Fs,As,Ws,_}, _Opts) ->
+ {Fs,As,Ws,File};
+form({attribute,_,_,_}=F, {Fs,As,Ws,File}, _Opts) ->
+ {Fs,[attribute(F)|As],Ws,File}.
attribute({attribute,Line,Name,Val}) ->
{#c_literal{val=Name, anno=[Line]}, #c_literal{val=Val, anno=[Line]}}.
-function({function,_,Name,Arity,Cs0}, Es0, Ws0, File, Opts) ->
+function({function,_,Name,Arity,Cs0}, Ws0, File, Opts) ->
%%ok = io:fwrite("~p - ", [{Name,Arity}]),
- St0 = #core{vcount=0,opts=Opts,es=Es0,ws=Ws0,file=[{file,File}]},
+ St0 = #core{vcount=0,opts=Opts,ws=Ws0,file=[{file,File}]},
{B0,St1} = body(Cs0, Name, Arity, St0),
%%ok = io:fwrite("1", []),
%%ok = io:fwrite("~w:~p~n", [?LINE,B0]),
{B1,St2} = ubody(B0, St1),
%%ok = io:fwrite("2", []),
%%ok = io:fwrite("~w:~p~n", [?LINE,B1]),
- {B2,#core{es=Es,ws=Ws}} = cbody(B1, St2),
+ {B2,#core{ws=Ws}} = cbody(B1, St2),
%%ok = io:fwrite("3~n", []),
%%ok = io:fwrite("~w:~p~n", [?LINE,B2]),
- {{#c_var{name={Name,Arity}},B2},Es,Ws}.
+ {{#c_var{name={Name,Arity}},B2},Ws}.
body(Cs0, Name, Arity, St0) ->
Anno = lineno_anno(element(2, hd(Cs0)), St0),
@@ -213,10 +207,7 @@ clause({clause,Lc,H0,G0,B0}, St0) ->
catch
throw:nomatch ->
St = add_warning(Lc, nomatch, St0),
- {noclause,St}; %Bad pattern
- throw:no_binaries ->
- St = add_error(Lc, no_binaries, St0),
- {noclause,St}
+ {noclause,St} %Bad pattern
end.
clause_arity({clause,_,H0,_,_}) -> length(H0).
@@ -496,22 +487,18 @@ expr({tuple,L,Es0}, St0) ->
{Es1,Eps,St1} = safe_list(Es0, St0),
A = lineno_anno(L, St1),
{ann_c_tuple(A, Es1),Eps,St1};
-expr({bin,L,Es0}, #core{opts=Opts}=St0) ->
- St1 = case member(no_binaries, Opts) of
- false -> St0;
- true -> add_error(L, no_binaries, St0)
- end,
- try expr_bin(Es0, lineno_anno(L, St1), St1) of
+expr({bin,L,Es0}, St0) ->
+ try expr_bin(Es0, lineno_anno(L, St0), St0) of
{_,_,_}=Res -> Res
catch
throw:bad_binary ->
- St2 = add_warning(L, bad_binary, St1),
- LineAnno = lineno_anno(L, St2),
+ St = add_warning(L, bad_binary, St0),
+ LineAnno = lineno_anno(L, St),
As = [#c_literal{anno=LineAnno,val=badarg}],
{#icall{anno=#a{anno=LineAnno}, %Must have an #a{}
module=#c_literal{anno=LineAnno,val=erlang},
name=#c_literal{anno=LineAnno,val=error},
- args=As},[],St2}
+ args=As},[],St}
end;
expr({block,_,Es0}, St0) ->
%% Inline the block directly.
@@ -587,10 +574,14 @@ expr({'fun',L,{function,F,A},{_,_,_}=Id}, St) ->
{#c_var{anno=Lanno++[{id,Id}],name={F,A}},[],St};
expr({'fun',L,{clauses,Cs},Id}, St) ->
fun_tq(Id, Cs, L, St);
-expr({call,L,{remote,_,M,F},As0}, St0) ->
+expr({call,L,{remote,_,M,F},As0}, #core{wanted=Wanted}=St0) ->
{[M1,F1|As1],Aps,St1} = safe_list([M,F|As0], St0),
Lanno = lineno_anno(L, St1),
- {#icall{anno=#a{anno=Lanno},module=M1,name=F1,args=As1},Aps,St1};
+ Anno = case Wanted of
+ false -> [result_not_wanted|Lanno];
+ true -> Lanno
+ end,
+ {#icall{anno=#a{anno=Anno},module=M1,name=F1,args=As1},Aps,St1};
expr({call,Lc,{atom,Lf,F},As0}, St0) ->
{As1,Aps,St1} = safe_list(As0, St0),
Op = #c_var{anno=lineno_anno(Lf, St1),name={F,length(As1)}},
@@ -603,27 +594,28 @@ expr({call,L,FunExp,As0}, St0) ->
expr({match,L,P0,E0}, St0) ->
%% First fold matches together to create aliases.
{P1,E1} = fold_match(E0, P0),
- {E2,Eps,St1} = novars(E1, St0),
+ St1 = case P1 of
+ {var,_,'_'} -> St0#core{wanted=false};
+ _ -> St0
+ end,
+ {E2,Eps,St2} = novars(E1, St1),
+ St3 = St2#core{wanted=St0#core.wanted},
P2 = try
- pattern(P1, St1)
+ pattern(P1, St3)
catch
throw:Thrown ->
Thrown
end,
- {Fpat,St2} = new_var(St1),
+ {Fpat,St4} = new_var(St3),
Fc = fail_clause([Fpat], c_tuple([#c_literal{val=badmatch},Fpat])),
- Lanno = lineno_anno(L, St2),
+ Lanno = lineno_anno(L, St4),
case P2 of
nomatch ->
- St = add_warning(L, nomatch, St2),
- {#icase{anno=#a{anno=Lanno},
- args=[E2],clauses=[],fc=Fc},Eps,St};
- no_binaries ->
- St = add_error(L, no_binaries, St2),
+ St = add_warning(L, nomatch, St4),
{#icase{anno=#a{anno=Lanno},
args=[E2],clauses=[],fc=Fc},Eps,St};
Other when not is_atom(Other) ->
- {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St2}
+ {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps,St4}
end;
expr({op,_,'++',{lc,Llc,E,Qs},More}, St0) ->
%% Optimise '++' here because of the list comprehension algorithm.
@@ -900,25 +892,22 @@ lc_tq(Line, E, [{generate,Lg,P,G}|Qs0], Mc, St0) ->
lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) ->
{Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Name,St1} = new_fun_name("blc", St0),
- {Tname,St2} = new_var_name(St1),
- LA = lineno_anno(Line, St2),
+ LA = lineno_anno(Line, St1),
LAnno = #a{anno=LA},
- HeadBinPattern = pattern(P,St2),
- #c_binary{segments=Ps} = HeadBinPattern,
- {EPs,St3} = emasculate_segments(Ps,St2),
- Tail = #c_var{anno=LA,name=Tname},
- TailSegment = #c_bitstr{val=Tail,size=#c_literal{val=all},
- unit=#c_literal{val=1},
- type=#c_literal{val=binary},
- flags=#c_literal{val=[big,unsigned]}},
- Pattern = HeadBinPattern#c_binary{segments=Ps ++ [TailSegment]},
- EPattern = HeadBinPattern#c_binary{segments=EPs ++ [TailSegment]},
+ HeadBinPattern = pattern(P, St1),
+ #c_binary{segments=Ps0} = HeadBinPattern,
+ {Ps,Tail,St2} = append_tail_segment(Ps0, St1),
+ {EPs,St3} = emasculate_segments(Ps, St2),
+ Pattern = HeadBinPattern#c_binary{segments=Ps},
+ EPattern = HeadBinPattern#c_binary{segments=EPs},
{Arg,St4} = new_var(St3),
{Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat!
+ Tname = Tail#c_var.name,
{Nc,[],St6} = expr({call,Lg,{atom,Lg,Name},[{var,Lg,Tname}]}, St5),
{Bc,Bps,St7} = lc_tq(Line, E, Qs1, Nc, St6),
{Gc,Gps,St10} = safe(G, St7), %Will be a function argument!
Fc = function_clause([Arg], LA, {Name,1}),
+ {TailSegList,_,St} = append_tail_segment([], St10),
Cs = [#iclause{anno=#a{anno=[compiler_generated|LA]},
pats=[Pattern],
guard=Guardc,
@@ -930,14 +919,14 @@ lc_tq(Line, E, [{b_generate,Lg,P,G}|Qs0], Mc, St0) ->
op=#c_var{anno=LA,name={Name,1}},
args=[Tail]}]},
#iclause{anno=LAnno,
- pats=[#c_binary{anno=LA, segments=[TailSegment]}],guard=[],
+ pats=[#c_binary{anno=LA,segments=TailSegList}],guard=[],
body=[Mc]}],
Fun = #ifun{anno=LAnno,id=[],vars=[Arg],clauses=Cs,fc=Fc},
{#iletrec{anno=LAnno,defs=[{{Name,1},Fun}],
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,1}},
args=[Gc]}]},
- [],St10};
+ [],St};
lc_tq(Line, E, [Fil0|Qs0], Mc, St0) ->
%% Special case sequences guard tests.
LA = lineno_anno(Line, St0),
@@ -1045,26 +1034,24 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
{Gs,Qs1} = splitwith(fun is_guard_test/1, Qs0),
{Name,St1} = new_fun_name("lbc", St0),
LA = lineno_anno(Line, St1),
- {[Tail,AccVar],St2} = new_vars(LA, 2, St1),
+ {AccVar,St2} = new_var(LA, St1),
LAnno = #a{anno=LA},
HeadBinPattern = pattern(P, St2),
- #c_binary{segments=Ps} = HeadBinPattern,
- {EPs,St3} = emasculate_segments(Ps, St2),
- TailSegment = #c_bitstr{val=Tail,size=#c_literal{val=all},
- unit=#c_literal{val=1},
- type=#c_literal{val=binary},
- flags=#c_literal{val=[big,unsigned]}},
- Pattern = HeadBinPattern#c_binary{segments=Ps ++ [TailSegment]},
- EPattern = HeadBinPattern#c_binary{segments=EPs ++ [TailSegment]},
- {Arg,St4} = new_var(St3),
+ #c_binary{segments=Ps0} = HeadBinPattern,
+ {Ps,Tail,St3} = append_tail_segment(Ps0, St2),
+ {EPs,St4} = emasculate_segments(Ps, St3),
+ Pattern = HeadBinPattern#c_binary{segments=Ps},
+ EPattern = HeadBinPattern#c_binary{segments=EPs},
+ {Arg,St5} = new_var(St4),
NewMore = {call,Lg,{atom,Lg,Name},[{var,Lg,Tail#c_var.name},
{var,Lg,AccVar#c_var.name}]},
- {Guardc,St5} = lc_guard_tests(Gs, St4), %These are always flat!
- {Bc,Bps,St6} = bc_tq1(Line, E, Qs1, AccVar, St5),
- {Nc,Nps,St7} = expr(NewMore, St6),
- {Gc,Gps,St8} = safe(G, St7), %Will be a function argument!
+ {Guardc,St6} = lc_guard_tests(Gs, St5), %These are always flat!
+ {Bc,Bps,St7} = bc_tq1(Line, E, Qs1, AccVar, St6),
+ {Nc,Nps,St8} = expr(NewMore, St7),
+ {Gc,Gps,St9} = safe(G, St8), %Will be a function argument!
Fc = function_clause([Arg,AccVar], LA, {Name,2}),
Body = Bps ++ Nps ++ [#iset{var=AccVar,arg=Bc},Nc],
+ {TailSegList,_,St} = append_tail_segment([], St9),
Cs = [#iclause{anno=LAnno,
pats=[Pattern,AccVar],
guard=Guardc,
@@ -1074,7 +1061,7 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
guard=[],
body=Nps ++ [Nc]},
#iclause{anno=LAnno,
- pats=[#c_binary{anno=LA,segments=[TailSegment]},AccVar],
+ pats=[#c_binary{anno=LA,segments=TailSegList},AccVar],
guard=[],
body=[AccVar]}],
Fun = #ifun{anno=LAnno,id=[],vars=[Arg,AccVar],clauses=Cs,fc=Fc},
@@ -1082,7 +1069,7 @@ bc_tq1(Line, E, [{b_generate,Lg,P,G}|Qs0], AccExpr, St0) ->
body=Gps ++ [#iapply{anno=LAnno,
op=#c_var{anno=LA,name={Name,2}},
args=[Gc,AccExpr]}]},
- [],St8};
+ [],St};
bc_tq1(Line, E, [Fil0|Qs0], AccVar, St0) ->
%% Special case sequences guard tests.
LA = lineno_anno(Line, St0),
@@ -1128,6 +1115,29 @@ bc_tq1(_, {bin,Bl,Elements}, [], AccVar, St0) ->
%%Anno = Anno0#a{anno=[compiler_generated|A]},
{set_anno(E, Anno),Pre,St}.
+append_tail_segment(Segs, St) ->
+ app_tail_seg(Segs, St, []).
+
+app_tail_seg([#c_bitstr{val=Var0,size=#c_literal{val=all}}=Seg0]=L,
+ St0, Acc) ->
+ case Var0 of
+ #c_var{name='_'} ->
+ {Var,St} = new_var(St0),
+ Seg = Seg0#c_bitstr{val=Var},
+ {reverse(Acc, [Seg]),Var,St};
+ #c_var{} ->
+ {reverse(Acc, L),Var0,St0}
+ end;
+app_tail_seg([H|T], St, Acc) ->
+ app_tail_seg(T, St, [H|Acc]);
+app_tail_seg([], St0, Acc) ->
+ {Var,St} = new_var(St0),
+ Tail = #c_bitstr{val=Var,size=#c_literal{val=all},
+ unit=#c_literal{val=1},
+ type=#c_literal{val=binary},
+ flags=#c_literal{val=[unsigned,big]}},
+ {reverse(Acc, [Tail]),Var,St}.
+
emasculate_segments(Segs, St) ->
emasculate_segments(Segs, St, []).
@@ -1443,15 +1453,10 @@ pattern({cons,L,H,T}, St) ->
ann_c_cons(lineno_anno(L, St), pattern(H, St), pattern(T, St));
pattern({tuple,L,Ps}, St) ->
ann_c_tuple(lineno_anno(L, St), pattern_list(Ps, St));
-pattern({bin,L,Ps}, #core{opts=Opts}=St) ->
- case member(no_binaries, Opts) of
- false ->
- %% We don't create a #ibinary record here, since there is
- %% no need to hold any used/new annotations in a pattern.
- #c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)};
- true ->
- throw(no_binaries)
- end;
+pattern({bin,L,Ps}, St) ->
+ %% We don't create a #ibinary record here, since there is
+ %% no need to hold any used/new annotations in a pattern.
+ #c_binary{anno=lineno_anno(L, St),segments=pat_bin(Ps, St)};
pattern({match,_,P1,P2}, St) ->
pat_alias(pattern(P1, St), pattern(P2, St)).
@@ -1558,17 +1563,21 @@ new_vars_1(N, Anno, St0, Vs) when N > 0 ->
new_vars_1(0, _, St, Vs) -> {Vs,St}.
function_clause(Ps, Name) ->
- fail_clause(Ps, c_tuple([#c_literal{anno=[{name,Name}],
- val=function_clause}|Ps])).
-function_clause(Ps, Anno, Name) ->
- fail_clause(Ps, ann_c_tuple(Anno,
- [#c_literal{anno=[{name,Name}],
- val=function_clause}|Ps])).
-
-fail_clause(Pats, A) ->
+ function_clause(Ps, [], Name).
+
+function_clause(Ps, LineAnno, Name) ->
+ FcAnno = [{function_name,Name}],
+ fail_clause(Ps, FcAnno,
+ ann_c_tuple(LineAnno, [#c_literal{val=function_clause}|Ps])).
+
+fail_clause(Pats, Arg) ->
+ fail_clause(Pats, [], Arg).
+
+fail_clause(Pats, Anno, Arg) ->
#iclause{anno=#a{anno=[compiler_generated]},
pats=Pats,guard=[],
- body=[#iprimop{anno=#a{},name=#c_literal{val=match_fail},args=[A]}]}.
+ body=[#iprimop{anno=#a{anno=Anno},name=#c_literal{val=match_fail},
+ args=[Arg]}]}.
ubody(B, St) -> uexpr(B, [], St).
@@ -1811,7 +1820,21 @@ upattern_list([], _, St) -> {[],[],[],[],St}.
%% upat_bin([Pat], [KnownVar], State) ->
%% {[Pat],[GuardTest],[NewVar],[UsedVar],State}.
upat_bin(Es0, Ks, St0) ->
- upat_bin(Es0, Ks, [], St0).
+ {Es1,Pg,Pv,Pu0,St1} = upat_bin(Es0, Ks, [], St0),
+
+ %% In a clause such as <<Sz:8,V:Sz>> in a function head, Sz will both
+ %% be new and used; a situation that is not handled properly by
+ %% uclause/4. (Basically, since Sz occurs in two sets that are
+ %% subtracted from each other, Sz will not be added to the list of
+ %% known variables and will seem to be new the next time it is
+ %% used in a match.)
+ %% Since the variable Sz really is new (it does not use a
+ %% value bound prior to the binary matching), Sz should only be
+ %% included in the set of new variables. Thus we should take it
+ %% out of the set of used variables.
+
+ Pu1 = subtract(Pu0, intersection(Pv, Pu0)),
+ {Es1,Pg,Pv,Pu1,St1}.
%% upat_bin([Pat], [KnownVar], [LocalVar], State) ->
%% {[Pat],[GuardTest],[NewVar],[UsedVar],State}.
@@ -1823,35 +1846,36 @@ upat_bin([], _, _, St) -> {[],[],[],[],St}.
%% upat_element(Segment, [KnownVar], [LocalVar], State) ->
-%% {Segment,[GuardTest],[NewVar],[UsedVar],[LocalVar],State}
-upat_element(#c_bitstr{val=H0,size=Sz}=Seg, Ks, Bs, St0) ->
- {H1,Hg,Hv,[],St1} = upattern(H0, Ks, St0),
- Bs1 = case H0 of
- #c_var{name=Hname} ->
- case H1 of
+%% {Segment,[GuardTest],[NewVar],[UsedVar],[LocalVar],State}
+upat_element(#c_bitstr{val=H0,size=Sz0}=Seg, Ks, Bs0, St0) ->
+ {H1,Hg,Hv,[],St1} = upattern(H0, Ks, St0),
+ Bs1 = case H0 of
#c_var{name=Hname} ->
- Bs;
- #c_var{name=Other} ->
- [{Hname, Other}|Bs]
- end;
- _ ->
- Bs
- end,
- {Sz1, Us} = case Sz of
- #c_var{name=Vname} ->
- rename_bitstr_size(Vname, Bs);
- _Other -> {Sz, []}
- end,
- {Seg#c_bitstr{val=H1, size=Sz1},Hg,Hv,Us,Bs1,St1}.
-
-rename_bitstr_size(V, [{V, N}|_]) ->
- New = #c_var{name=N},
- {New, [N]};
+ case H1 of
+ #c_var{name=Hname} ->
+ Bs0;
+ #c_var{name=Other} ->
+ [{Hname,Other}|Bs0]
+ end;
+ _ ->
+ Bs0
+ end,
+ {Sz1,Us} = case Sz0 of
+ #c_var{name=Vname} ->
+ rename_bitstr_size(Vname, Bs0);
+ _Other ->
+ {Sz0,[]}
+ end,
+ {Seg#c_bitstr{val=H1,size=Sz1},Hg,Hv,Us,Bs1,St1}.
+
+rename_bitstr_size(V, [{V,N}|_]) ->
+ New = #c_var{name=N},
+ {New,[N]};
rename_bitstr_size(V, [_|Rest]) ->
- rename_bitstr_size(V, Rest);
+ rename_bitstr_size(V, Rest);
rename_bitstr_size(V, []) ->
- Old = #c_var{name=V},
- {Old, [V]}.
+ Old = #c_var{name=V},
+ {Old,[V]}.
used_in_any(Les) ->
foldl(fun (Le, Ns) -> union((get_anno(Le))#a.us, Ns) end,
@@ -2098,39 +2122,25 @@ is_simple(#c_literal{}) -> true;
is_simple(#c_cons{hd=H,tl=T}) ->
is_simple(H) andalso is_simple(T);
is_simple(#c_tuple{es=Es}) -> is_simple_list(Es);
-is_simple(#c_binary{segments=Es}) -> is_simp_bin(Es);
is_simple(_) -> false.
-spec is_simple_list([cerl:cerl()]) -> boolean().
is_simple_list(Es) -> lists:all(fun is_simple/1, Es).
--spec is_simp_bin([cerl:cerl()]) -> boolean().
-
-is_simp_bin(Es) ->
- lists:all(fun (#c_bitstr{val=E,size=S}) ->
- is_simple(E) andalso is_simple(S)
- end, Es).
-
%%%
%%% Handling of warnings.
%%%
--type err_desc() :: 'bad_binary' | 'no_binaries' | 'nomatch'.
+-type err_desc() :: 'bad_binary' | 'nomatch'.
-spec format_error(err_desc()) -> nonempty_string().
format_error(nomatch) ->
"pattern cannot possibly match";
format_error(bad_binary) ->
- "binary construction will fail because of a type mismatch";
-format_error(no_binaries) ->
- "bit syntax is not allowed to be used when compatibility with a previous "
- "version has been requested".
+ "binary construction will fail because of a type mismatch".
add_warning(Line, Term, #core{ws=Ws,file=[{file,File}]}=St) when Line >= 0 ->
St#core{ws=[{File,[{location(Line),?MODULE,Term}]}|Ws]};
add_warning(_, _, St) -> St.
-
-add_error(Line, Term, #core{es=Es,file=[{file,File}]}=St) ->
- St#core{es=[{File,[{location(abs_line(Line)),?MODULE,Term}]}|Es]}.
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 8568071e57..3b33a08cf7 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose : Transform Core Erlang to Kernel Erlang
@@ -80,7 +80,8 @@
-export([module/2,format_error/1]).
--import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,keymember/3]).
+-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]).
-compile({nowarn_deprecated_function, {erlang,hash,2}}).
@@ -126,19 +127,29 @@ copy_anno(Kdst, Ksrc) ->
-spec module(cerl:c_module(), [compile:option()]) ->
{'ok', #k_mdef{}, [warning()]}.
-module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, Options) ->
- Lit = case member(no_constant_pool, Options) of
- true -> no;
- false -> dict:new()
- end,
- St0 = #kern{lit=Lit},
- {Kfs,St} = mapfoldl(fun function/2, St0, Fs),
+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),
- Kas = map(fun ({#c_literal{val=N},V}) ->
- {N,core_lib:literal_value(V)} end, As),
+ St0 = #kern{lit=dict:new()},
+ {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)}.
+attributes([{#c_literal{val=Name},Val}|As]) ->
+ case include_attribute(Name) of
+ false ->
+ attributes(As);
+ true ->
+ [{Name,core_lib:literal_value(Val)}|attributes(As)]
+ end;
+attributes([]) -> [].
+
+include_attribute(type) -> false;
+include_attribute(spec) -> false;
+include_attribute(opaque) -> false;
+include_attribute(export_type) -> false;
+include_attribute(_) -> true.
+
function({#c_var{name={F,Arity}=FA},Body}, St0) ->
try
St1 = St0#kern{func=FA,ff=undefined,vcount=0,fcount=0,ds=sets:new()},
@@ -240,11 +251,6 @@ 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{anno=A,val=Lit}, Sub, #kern{lit=no}=St) ->
- %% No constant pools for compatibility with a previous version.
- %% Fully expand the literal.
- Core = expand_literal(Lit, A),
- expr(Core, Sub, St);
expr(#c_literal{}=Lit, Sub, St) ->
Core = handle_literal(Lit),
expr(Core, Sub, St);
@@ -265,9 +271,6 @@ expr(#k_float{}=V, _Sub, St) ->
{V,[],St};
expr(#k_atom{}=V, _Sub, St) ->
{V,[],St};
-expr(#k_string{}=V, _Sub, St) ->
- %% Only for compatibility with a previous version.
- {V,[],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.
@@ -420,7 +423,7 @@ expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) ->
{Call,Ap,St}
end;
expr(#c_primop{anno=A,name=#c_literal{val=match_fail},args=Cargs0}, Sub, St0) ->
- Cargs = translate_match_fail(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),
@@ -447,32 +450,53 @@ expr(#c_catch{anno=A,body=Cb}, Sub, St0) ->
%% Handle internal expressions.
expr(#ireceive_accept{anno=A}, _Sub, St) -> {#k_receive_accept{anno=A},[],St}.
-%% Translate a function_clause to case_clause if it has been moved into
-%% another function.
-translate_match_fail([#c_tuple{es=[#c_literal{anno=A0,
- val=function_clause}|As]}]=Args,
- Sub,
- #kern{ff=FF}) ->
- A = case A0 of
- [{name,{Func0,Arity0}}] ->
- [{name,{get_fsub(Func0, Arity0, Sub),Arity0}}];
- _ ->
- A0
- end,
- case {A,FF} of
- {[{name,Same}],Same} ->
+%% Translate a function_clause exception to a case_clause exception if
+%% it has been moved into another function. (A function_clause exception
+%% will not work correctly if it is moved into another function, or
+%% even if it is invoked not from the top level in the correct function.)
+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);
+ [#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);
+ _ ->
+ Args
+ end;
+ _ ->
+ %% Not a function_clause exception.
+ Args
+ end.
+
+translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) ->
+ AnnoFunc = case keyfind(function_name, 1, Anno) of
+ false ->
+ none; %Force rewrite.
+ {function_name,{Name,Arity}} ->
+ {get_fsub(Name, Arity, Sub),Arity}
+ end,
+ case {AnnoFunc,FF} of
+ {Same,Same} ->
%% Still in the correct function.
Args;
- {[{name,{F,_}}],F} ->
+ {{F,_},F} ->
%% Still in the correct function.
Args;
_ ->
- %% Inlining has probably moved the function_clause into another
- %% function (where it will not work correctly).
- %% Rewrite to a case_clause.
+ %% Wrong function or no function_name annotation.
+ %%
+ %% The inliner has copied the match_fail(function_clause)
+ %% primop from another function (or from another instance of
+ %% 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}]}]
- end;
-translate_match_fail(Args, _, _) -> Args.
+ end.
%% call_type(Module, Function, Arity) -> call | bif | apply | error.
%% Classify the call.
@@ -980,11 +1004,6 @@ match_var([U|Us], Cs0, Def, St) ->
%% according to type, the order is really irrelevant but tries to be
%% smart.
-match_con(Us, Cs0, Def, #kern{lit=no}=St) ->
- %% No constant pool (for compatibility with R11B).
- %% We must expand literals.
- Cs = [expand_pat_lit_clause(C, true) || C <- Cs0],
- match_con_1(Us, Cs, Def, St);
match_con(Us, [C], Def, St) ->
%% There is only one clause. We can keep literal tuples and
%% lists, but we must convert []/integer/float/atom literals
@@ -1783,7 +1802,6 @@ lit_vars(#k_int{}) -> [];
lit_vars(#k_float{}) -> [];
lit_vars(#k_atom{}) -> [];
%%lit_vars(#k_char{}) -> [];
-lit_vars(#k_string{}) -> [];
lit_vars(#k_nil{}) -> [];
lit_vars(#k_cons{hd=H,tl=T}) ->
union(lit_vars(H), lit_vars(T));
@@ -1845,48 +1863,20 @@ 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};
- _ ->
- expand_literal(V, 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}
end.
-%% expand_literal(Literal, Anno) -> CoreTerm | KernelTerm
-%% Fully expand the literal. Atomic terms such as integers are directly
-%% translated to the Kernel Erlang format, while complex terms are kept
-%% in the Core Erlang format (but the content is recursively processed).
-
-expand_literal([H|T]=V, A) when is_integer(H), 0 =< H, H =< 255 ->
- case is_print_char_list(T) of
- false ->
- #c_cons{anno=A,hd=#k_int{anno=A,val=H},tl=expand_literal(T, A)};
- true ->
- #k_string{anno=A,val=V}
- end;
-expand_literal([H|T], A) ->
- #c_cons{anno=A,hd=expand_literal(H, A),tl=expand_literal(T, A)};
-expand_literal([], A) ->
- #k_nil{anno=A};
-expand_literal(V, A) when is_tuple(V) ->
- #c_tuple{anno=A,es=expand_literal_list(tuple_to_list(V), A)};
-expand_literal(V, A) when is_integer(V) ->
- #k_int{anno=A,val=V};
-expand_literal(V, A) when is_float(V) ->
- #k_float{anno=A,val=V};
-expand_literal(V, A) when is_atom(V) ->
- #k_atom{anno=A,val=V}.
-
-expand_literal_list([H|T], A) ->
- [expand_literal(H, A)|expand_literal_list(T, A)];
-expand_literal_list([], _) -> [].
-
-is_print_char_list([H|T]) when is_integer(H), 0 =< H, H =< 255 ->
- is_print_char_list(T);
-is_print_char_list([]) -> true;
-is_print_char_list(_) -> false.
-
make_list(Es) ->
foldr(fun(E, Acc) ->
#c_cons{hd=E,tl=Acc}
diff --git a/lib/compiler/src/v3_kernel_pp.erl b/lib/compiler/src/v3_kernel_pp.erl
index b1ca907d11..e363a5387a 100644
--- a/lib/compiler/src/v3_kernel_pp.erl
+++ b/lib/compiler/src/v3_kernel_pp.erl
@@ -1,29 +1,31 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1999-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%
%%
%% Purpose : Kernel Erlang (naive) prettyprinter
-module(v3_kernel_pp).
--include("v3_kernel.hrl").
-
-export([format/1]).
+%%-define(INCLUDE_ANNOTATIONS, 1).
+
+-include("v3_kernel.hrl").
+
%% These are "internal" structures in sys_kernel which are here for
%% debugging purposes.
-record(iset, {anno=[],vars,arg,body}).
@@ -50,28 +52,33 @@ format(Node) -> format(Node, #ctxt{}).
format(Node, Ctxt) ->
case canno(Node) of
-%% [] ->
-%% format_1(Node, Ctxt);
-%% [L,{file,_}] when is_integer(L) ->
-%% format_1(Node, Ctxt);
-%% #k{a=Anno}=K when Anno =/= [] ->
-%% format(setelement(2, Node, K#k{a=[]}), Ctxt);
-%% List ->
-%% format_anno(List, Ctxt, fun (Ctxt1) ->
-%% format_1(Node, Ctxt1)
-%% end);
- _ ->
- format_1(Node, Ctxt)
+ [] ->
+ format_1(Node, Ctxt);
+ [L,{file,_}] when is_integer(L) ->
+ format_1(Node, Ctxt);
+ #k{a=Anno}=K when Anno =/= [] ->
+ format(setelement(2, Node, K#k{a=[]}), Ctxt);
+ List ->
+ format_anno(List, Ctxt, fun (Ctxt1) ->
+ format_1(Node, Ctxt1)
+ end)
end.
-%% format_anno(Anno, Ctxt0, ObjFun) ->
-%% Ctxt1 = ctxt_bump_indent(Ctxt0, 1),
-%% ["( ",
-%% ObjFun(Ctxt0),
-%% nl_indent(Ctxt1),
-%% "-| ",io_lib:write(Anno),
-%% " )"].
-
+
+-ifndef(INCLUDE_ANNOTATIONS).
+%% Don't include annotations (for readability).
+format_anno(_Anno, Ctxt, ObjFun) ->
+ ObjFun(Ctxt).
+-else.
+%% Include annotations (for debugging of annotations).
+format_anno(Anno, Ctxt0, ObjFun) ->
+ Ctxt1 = ctxt_bump_indent(Ctxt0, 1),
+ ["( ",
+ ObjFun(Ctxt0),
+ nl_indent(Ctxt1),
+ "-| ",io_lib:write(Anno),
+ " )"].
+-endif.
%% format_1(Kexpr, Context) -> string().
@@ -80,7 +87,6 @@ format_1(#k_atom{val=A}, _Ctxt) -> core_atom(A);
format_1(#k_float{val=F}, _Ctxt) -> float_to_list(F);
format_1(#k_int{val=I}, _Ctxt) -> integer_to_list(I);
format_1(#k_nil{}, _Ctxt) -> "[]";
-format_1(#k_string{val=S}, _Ctxt) -> io_lib:write_string(S);
format_1(#k_var{name=V}, _Ctxt) ->
if is_atom(V) ->
case atom_to_list(V) of
@@ -108,6 +114,8 @@ format_1(#k_bin_int{size=Sz,unit=U,flags=Fs,val=Val,next=Next}, Ctxt) ->
[format_bin_seg_1(S, Ctxt),
format_bin_seg(Next, ctxt_bump_indent(Ctxt, 2))];
format_1(#k_bin_end{}, _Ctxt) -> "#<>#";
+format_1(#k_literal{val=Term}, _Ctxt) ->
+ io_lib:format("~p", [Term]);
format_1(#k_local{name=N,arity=A}, Ctxt) ->
"local " ++ format_fa_pair({N,A}, Ctxt);
format_1(#k_remote{mod=M,name=N,arity=A}, _Ctxt) ->
diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl
index 0adeaca8fa..a7a4d4dc91 100644
--- a/lib/compiler/src/v3_life.erl
+++ b/lib/compiler/src/v3_life.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1999-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1999-2010. All Rights Reserved.
+%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
%% compliance with the License. You should have received a copy of the
%% Erlang Public License along with this software. If not, it can be
%% retrieved online at http://www.erlang.org/.
-%%
+%%
%% Software distributed under the License is distributed on an "AS IS"
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
%% the License for the specific language governing rights and limitations
%% under the License.
-%%
+%%
%% %CopyrightEnd%
%%
%% Purpose : Convert annotated kernel expressions to annotated beam format.
@@ -66,21 +66,27 @@ functions([], Acc) -> reverse(Acc).
%% function(Kfunc) -> Func.
function(#k_fdef{func=F,arity=Ar,vars=Vs,body=Kb}) ->
- %ok = io:fwrite("life ~w: ~p~n~p~n", [?LINE,{F,Ar},Kb]),
- As = var_list(Vs),
- Vdb0 = foldl(fun ({var,N}, Vdb) -> new_var(N, 0, Vdb) end, [], As),
- %% Force a top-level match!
- B0 = case Kb of
- #k_match{} -> Kb;
- _ ->
- Ka = get_kanno(Kb),
- #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a},
- vars=Vs,body=Kb,ret=[]}
- end,
- put(guard_refc, 0),
- {B1,_,Vdb1} = body(B0, 1, Vdb0),
- erase(guard_refc),
- {function,F,Ar,As,B1,Vdb1}.
+ try
+ As = var_list(Vs),
+ Vdb0 = foldl(fun ({var,N}, Vdb) -> new_var(N, 0, Vdb) end, [], As),
+ %% Force a top-level match!
+ B0 = case Kb of
+ #k_match{} -> Kb;
+ _ ->
+ Ka = get_kanno(Kb),
+ #k_match{anno=#k{us=Ka#k.us,ns=[],a=Ka#k.a},
+ vars=Vs,body=Kb,ret=[]}
+ end,
+ put(guard_refc, 0),
+ {B1,_,Vdb1} = body(B0, 1, Vdb0),
+ erase(guard_refc),
+ {function,F,Ar,As,B1,Vdb1}
+ catch
+ Class:Error ->
+ Stack = erlang:get_stacktrace(),
+ io:fwrite("Function: ~w/~w\n", [F,Ar]),
+ erlang:raise(Class, Error, Stack)
+ end.
%% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}.
%% Handle a body, need special cases for transforming match_fails.
@@ -355,8 +361,6 @@ 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_literal{anno=Anno,val=Atom}, I, A) when is_atom(Atom) ->
- match_fail(#k_atom{anno=Anno,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) ->
@@ -412,7 +416,6 @@ literal(#k_int{val=I}, _) -> {integer,I};
literal(#k_float{val=F}, _) -> {float,F};
literal(#k_atom{val=N}, _) -> {atom,N};
%%literal(#k_char{val=C}, _) -> {char,C};
-literal(#k_string{val=S}, _) -> {string,S};
literal(#k_nil{}, _) -> nil;
literal(#k_cons{hd=H,tl=T}, Ctxt) ->
{cons,[literal(H, Ctxt),literal(T, Ctxt)]};
@@ -437,7 +440,6 @@ literal2(#k_int{val=I}, _) -> {integer,I};
literal2(#k_float{val=F}, _) -> {float,F};
literal2(#k_atom{val=N}, _) -> {atom,N};
%%literal2(#k_char{val=C}, _) -> {char,C};
-literal2(#k_string{val=S}, _) -> {string,S};
literal2(#k_nil{}, _) -> nil;
literal2(#k_cons{hd=H,tl=T}, Ctxt) ->
{cons,[literal2(H, Ctxt),literal2(T, Ctxt)]};
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index ad2f63e9e5..b90adaf917 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -9,6 +9,7 @@ MODULES= \
andor_SUITE \
apply_SUITE \
beam_validator_SUITE \
+ beam_disasm_SUITE \
bs_bincomp_SUITE \
bs_bit_binaries_SUITE \
bs_construct_SUITE \
@@ -53,16 +54,24 @@ NO_OPT= \
record \
trycatch
-R11= \
+INLINE= \
andor \
apply \
+ bs_bincomp \
+ bs_bit_binaries \
+ bs_construct \
+ bs_match \
+ bs_utf \
+ core_fold \
float \
fun \
+ guard \
+ lc \
match \
+ misc \
num_bif \
receive \
- record \
- trycatch
+ record
CORE_MODULES = \
bs_shadowed_size_var \
@@ -73,8 +82,8 @@ NO_OPT_MODULES= $(NO_OPT:%=%_no_opt_SUITE)
NO_OPT_ERL_FILES= $(NO_OPT_MODULES:%=%.erl)
POST_OPT_MODULES= $(NO_OPT:%=%_post_opt_SUITE)
POST_OPT_ERL_FILES= $(POST_OPT_MODULES:%=%.erl)
-R11_MODULES= $(R11:%=%_r11_SUITE)
-R11_ERL_FILES= $(R11_MODULES:%=%.erl)
+INLINE_MODULES= $(INLINE:%=%_inline_SUITE)
+INLINE_ERL_FILES= $(INLINE_MODULES:%=%.erl)
ERL_FILES= $(MODULES:%=%.erl)
@@ -103,15 +112,15 @@ EBIN = .
# Targets
# ----------------------------------------------------
-make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) $(R11_ERL_FILES)
+make_emakefile: $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) $(INLINE_ERL_FILES)
$(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \
> $(EMAKEFILE)
$(ERL_TOP)/make/make_emakefile +no_copt +no_postopt $(ERL_COMPILE_FLAGS) \
-o$(EBIN) $(NO_OPT_MODULES) >> $(EMAKEFILE)
$(ERL_TOP)/make/make_emakefile +no_copt $(ERL_COMPILE_FLAGS) \
-o$(EBIN) $(POST_OPT_MODULES) >> $(EMAKEFILE)
- $(ERL_TOP)/make/make_emakefile +r11 $(ERL_COMPILE_FLAGS) \
- -o$(EBIN) $(R11_MODULES) >> $(EMAKEFILE)
+ $(ERL_TOP)/make/make_emakefile +inline $(ERL_COMPILE_FLAGS) \
+ -o$(EBIN) $(INLINE_MODULES) >> $(EMAKEFILE)
tests debug opt: make_emakefile
erl $(ERL_MAKE_FLAGS) -make
@@ -133,7 +142,7 @@ docs:
%_post_opt_SUITE.erl: %_SUITE.erl
sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@
-%_r11_SUITE.erl: %_SUITE.erl
+%_inline_SUITE.erl: %_SUITE.erl
sed -e 's;-module($(basename $<));-module($(basename $@));' $< > $@
# ----------------------------------------------------
@@ -145,11 +154,11 @@ release_spec: opt
release_tests_spec: make_emakefile
$(INSTALL_DIR) $(RELSYSDIR)
- $(INSTALL_DATA) compiler.dynspec compiler.cover \
+ $(INSTALL_DATA) compiler.spec compiler.cover \
$(EMAKEFILE) $(ERL_FILES) $(CORE_FILES) $(RELSYSDIR)
$(INSTALL_DATA) $(NO_OPT_ERL_FILES) $(POST_OPT_ERL_FILES) \
- $(R11_ERL_FILES) $(RELSYSDIR)
- chmod -f -R u+w $(RELSYSDIR)
+ $(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/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl
index a460d54239..f7388f1614 100644
--- a/lib/compiler/test/andor_SUITE.erl
+++ b/lib/compiler/test/andor_SUITE.erl
@@ -1,33 +1,52 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-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(andor_SUITE).
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
t_case/1,t_and_or/1,t_andalso/1,t_orelse/1,inside/1,overlap/1,
combined/1,in_case/1,before_and_inside_if/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [t_case,t_and_or,t_andalso,t_orelse,inside,overlap,combined,in_case,
- before_and_inside_if].
+ [t_case, t_and_or, t_andalso, t_orelse, inside, overlap,
+ combined, in_case, before_and_inside_if].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
t_case(Config) when is_list(Config) ->
%% We test boolean cases almost but not quite like cases
@@ -141,6 +160,10 @@ t_and_or(Config) when is_list(Config) ->
ok.
+-define(GUARD(E), if E -> true;
+ true -> false
+ end).
+
t_andalso(Config) when is_list(Config) ->
Bs = [true,false],
Ps = [{X,Y} || X <- Bs, Y <- Bs],
@@ -151,6 +174,11 @@ t_andalso(Config) when is_list(Config) ->
?line false = false andalso true,
?line false = false andalso false,
+ ?line true = ?GUARD(true andalso true),
+ ?line false = ?GUARD(true andalso false),
+ ?line false = ?GUARD(false andalso true),
+ ?line false = ?GUARD(false andalso false),
+
?line false = false andalso glurf,
?line false = false andalso exit(exit_now),
@@ -176,6 +204,11 @@ t_orelse(Config) when is_list(Config) ->
?line true = false orelse true,
?line false = false orelse false,
+ ?line true = ?GUARD(true orelse true),
+ ?line true = ?GUARD(true orelse false),
+ ?line true = ?GUARD(false orelse true),
+ ?line false = ?GUARD(false orelse false),
+
?line true = true orelse glurf,
?line true = true orelse exit(exit_now),
diff --git a/lib/compiler/test/apply_SUITE.erl b/lib/compiler/test/apply_SUITE.erl
index f23dd6c2db..25f8a8dfb5 100644
--- a/lib/compiler/test/apply_SUITE.erl
+++ b/lib/compiler/test/apply_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2005-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
@@ -18,15 +18,34 @@
%%
-module(apply_SUITE).
--export([all/1,mfa/1,fun_apply/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,mfa/1,fun_apply/1]).
-export([foo/0,bar/1,baz/2]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [mfa,fun_apply].
+ [mfa, fun_apply].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
-define(APPLY0(M, F), (fun(Res) -> Res = M:F() end)(apply(M, F, []))).
-define(APPLY1(M, F, A1), (fun(Res) -> Res = M:F(A1) end)(apply(M, F, [A1]))).
diff --git a/lib/compiler/test/beam_disasm_SUITE.erl b/lib/compiler/test/beam_disasm_SUITE.erl
new file mode 100644
index 0000000000..44574ae64a
--- /dev/null
+++ b/lib/compiler/test/beam_disasm_SUITE.erl
@@ -0,0 +1,65 @@
+%%
+%% %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_disasm_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]).
+
+-export([stripped/1]).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [stripped].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+stripped(doc) ->
+ ["Check that stripped beam files can be disassembled"];
+stripped(Config) when is_list(Config) ->
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line SrcName = filename:join(PrivDir, "tmp.erl"),
+ ?line BeamName = filename:join(PrivDir, "tmp.beam"),
+ Prog = <<"-module(tmp).\n-export([tmp/0]).\ntmp()->ok.\n">>,
+ ?line ok = file:write_file(SrcName, Prog),
+ ?line {ok, tmp} =
+ compile:file(SrcName, [{outdir, PrivDir}]),
+ ?line {beam_file, tmp, _, Attr, CompileInfo, [_|_]} =
+ beam_disasm:file(BeamName),
+ ?line true = is_list(Attr),
+ ?line true = is_list(CompileInfo),
+ ?line {ok, {tmp, _}} = beam_lib:strip(BeamName),
+ ?line {beam_file, tmp, _, none, none, [_|_]} =
+ beam_disasm:file(BeamName),
+ ok.
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index 74b5d7c7eb..556dc54a8f 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2004-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
@@ -18,7 +18,9 @@
%%
-module(beam_validator_SUITE).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-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,
beam_files/1,compiler_bug/1,stupid_but_valid/1,
xrange/1,yrange/1,stack/1,call_last/1,merge_undefined/1,
uninit/1,unsafe_catch/1,
@@ -30,34 +32,49 @@
state_after_fault_in_catch/1,no_exception_in_catch/1,
undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = test_server:timetrap(?t:minutes(10)),
[{watchdog,Dog}|Config].
-fin_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
+end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [beam_files,compiler_bug,stupid_but_valid,
- xrange,yrange,stack,call_last,merge_undefined,
- uninit,unsafe_catch,
- dead_code,mult_labels,
- overwrite_catchtag,overwrite_trytag,accessing_tags,bad_catch_try,
- cons_guard,
- freg_range,freg_uninit,freg_state,
- bin_match,bin_aligned,
- bad_dsetel,state_after_fault_in_catch,no_exception_in_catch,
- undef_label,illegal_instruction,failing_gc_guard_bif].
+ [beam_files, compiler_bug, stupid_but_valid, xrange,
+ yrange, stack, call_last, merge_undefined, uninit,
+ unsafe_catch, dead_code, mult_labels,
+ overwrite_catchtag, overwrite_trytag, accessing_tags,
+ bad_catch_try, cons_guard, freg_range, freg_uninit,
+ freg_state, bin_match, bin_aligned, bad_dsetel,
+ state_after_fault_in_catch, no_exception_in_catch,
+ undef_label, illegal_instruction, failing_gc_guard_bif].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
beam_files(Config) when is_list(Config) ->
- ?line {ok,Cwd} = file:get_cwd(),
- ?line Parent = filename:dirname(Cwd),
- ?line Wc = filename:join([Parent,"*","*.beam"]),
+ ?line DataDir = proplists:get_value(data_dir, Config),
+ ?line Wc = filename:join([DataDir,"..","..","*","*.beam"]),
%% Must have at least two files here, or there will be
%% a grammatical error in the output of the io:format/2 call below. ;-)
?line [_,_|_] = Fs = filelib:wildcard(Wc),
diff --git a/lib/compiler/test/bs_bincomp_SUITE.erl b/lib/compiler/test/bs_bincomp_SUITE.erl
index a64a5d590b..d39e340429 100644
--- a/lib/compiler/test/bs_bincomp_SUITE.erl
+++ b/lib/compiler/test/bs_bincomp_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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
@@ -21,19 +21,36 @@
-module(bs_bincomp_SUITE).
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
byte_aligned/1,bit_aligned/1,extended_byte_aligned/1,
extended_bit_aligned/1,mixed/1,filters/1,trim_coverage/1,
- nomatch/1,sizes/1]).
+ nomatch/1,sizes/1,tail/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [byte_aligned,bit_aligned,extended_byte_aligned,
- extended_bit_aligned,mixed,filters,trim_coverage,
- nomatch,sizes].
+ [byte_aligned, bit_aligned, extended_byte_aligned,
+ extended_bit_aligned, mixed, filters, trim_coverage,
+ nomatch, sizes, tail].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+end_per_group(_GroupName, Config) ->
+ Config.
byte_aligned(Config) when is_list(Config) ->
cs_init(),
@@ -270,6 +287,38 @@ sizes(Config) when is_list(Config) ->
?line cs_end(),
ok.
+tail(Config) when is_list(Config) ->
+ ?line [] = tail_1(<<0:7>>),
+ ?line [0] = tail_1(<<0>>),
+ ?line [0] = tail_1(<<0:12>>),
+ ?line [0,0] = tail_1(<<0:20>>),
+
+ ?line [] = tail_2(<<0:7>>),
+ ?line [42] = tail_2(<<0>>),
+ ?line [] = tail_2(<<0:12>>),
+ ?line [42,42] = tail_2(<<0,1>>),
+
+ ?line <<>> = tail_3(<<0:7>>),
+ ?line <<42>> = tail_3(<<0>>),
+ ?line <<42>> = tail_3(<<0:12>>),
+ ?line <<42,42>> = tail_3(<<0:20>>),
+
+ ?line [] = tail_4(<<0:15>>),
+ ?line [7] = tail_4(<<7,8>>),
+ ?line [9] = tail_4(<<9,17:12>>),
+ ok.
+
+tail_1(Bits) ->
+ [X || <<X:8/integer, _/bits>> <= Bits].
+
+tail_2(Bits) ->
+ [42 || <<_:8/integer, _/bytes>> <= Bits].
+
+tail_3(Bits) ->
+ << <<42>> || <<_:8/integer, _/bits>> <= Bits >>.
+
+tail_4(Bits) ->
+ [X || <<X:8/integer, Tail/bits>> <= Bits, bit_size(Tail) >= 8].
cs_init() ->
diff --git a/lib/compiler/test/bs_bit_binaries_SUITE.erl b/lib/compiler/test/bs_bit_binaries_SUITE.erl
index 6337460b13..30276f1259 100644
--- a/lib/compiler/test/bs_bit_binaries_SUITE.erl
+++ b/lib/compiler/test/bs_bit_binaries_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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
@@ -21,19 +21,39 @@
-module(bs_bit_binaries_SUITE).
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
misc/1,horrid_match/1,test_bitstr/1,test_bit_size/1,asymmetric_tests/1,
big_asymmetric_tests/1,binary_to_and_from_list/1,
big_binary_to_and_from_list/1,send_and_receive/1,
send_and_receive_alot/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [misc,horrid_match,test_bitstr,test_bit_size,asymmetric_tests,
- big_asymmetric_tests,binary_to_and_from_list,big_binary_to_and_from_list,
- send_and_receive,send_and_receive_alot].
+ [misc, horrid_match, test_bitstr, test_bit_size,
+ asymmetric_tests, big_asymmetric_tests,
+ binary_to_and_from_list, big_binary_to_and_from_list,
+ send_and_receive, send_and_receive_alot].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
misc(Config) when is_list(Config) ->
?line <<1:100>> = <<1:100>>,
diff --git a/lib/compiler/test/bs_construct_SUITE.erl b/lib/compiler/test/bs_construct_SUITE.erl
index 1862a28bbe..31c7890f26 100644
--- a/lib/compiler/test/bs_construct_SUITE.erl
+++ b/lib/compiler/test/bs_construct_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2004-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
@@ -23,23 +23,44 @@
-module(bs_construct_SUITE).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-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,
two/1,test1/1,fail/1,float_bin/1,in_guard/1,in_catch/1,
nasty_literals/1,coerce_to_float/1,side_effect/1,
opt/1,otp_7556/1,float_arith/1,otp_8054/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [two,test1,fail,float_bin,in_guard,in_catch,nasty_literals,
- side_effect,opt,otp_7556,float_arith,otp_8054].
+ [two, test1, fail, float_bin, in_guard, in_catch,
+ nasty_literals, side_effect, opt, otp_7556, float_arith,
+ otp_8054].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = test_server:timetrap(?t:minutes(1)),
[{watchdog,Dog}|Config].
-fin_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
+end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
@@ -66,6 +87,8 @@ id(I) -> I.
l(I_13, I_big1, I_16, Bin) ->
[
+ ?T(<<I_13:0>>,
+ []),
?T(<<-43>>,
[256-43]),
?T(<<4:4,7:4>>,
@@ -208,7 +231,7 @@ one_test({C_bin, E_bin, Str, Result}) ->
ok;
%% For situations where the final bits may not matter, like
%% for floats:
- N when integer(N) ->
+ N when is_integer(N) ->
io:format("Info: compiled and interpreted differ in the"
" last bytes:~n ~p, ~p.~n",
[bitstring_to_list(C_bin), bitstring_to_list(E_bin)]),
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index 5c2797170b..6a795f6634 100644
--- a/lib/compiler/test/bs_match_SUITE.erl
+++ b/lib/compiler/test/bs_match_SUITE.erl
@@ -1,26 +1,28 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2005-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2005-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(bs_match_SUITE).
-compile(nowarn_shadow_vars).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-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,
fun_shadow/1,int_float/1,otp_5269/1,null_fields/1,wiger/1,
bin_tail/1,save_restore/1,shadowed_size_var/1,
partitioned_bs_match/1,function_clause/1,
@@ -30,28 +32,50 @@
multiple_uses/1,zero_label/1,followed_by_catch/1,
matching_meets_construction/1,simon/1,matching_and_andalso/1,
otp_7188/1,otp_7233/1,otp_7240/1,otp_7498/1,
- match_string/1,zero_width/1,bad_size/1,haystack/1]).
+ match_string/1,zero_width/1,bad_size/1,haystack/1,
+ cover_beam_bool/1]).
--export([coverage_id/1]).
+-export([coverage_id/1,coverage_external_ignore/2]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [fun_shadow,int_float,otp_5269,null_fields,wiger,bin_tail,save_restore,
- shadowed_size_var,partitioned_bs_match,function_clause,unit,
- shared_sub_bins,bin_and_float,dec_subidentifiers,skip_optional_tag,
- wfbm,degenerated_match,bs_sum,coverage,multiple_uses,zero_label,
- followed_by_catch,matching_meets_construction,simon,matching_and_andalso,
- otp_7188,otp_7233,otp_7240,otp_7498,match_string,zero_width,bad_size,
- haystack].
+ [fun_shadow, int_float, otp_5269, null_fields, wiger,
+ bin_tail, save_restore, shadowed_size_var,
+ partitioned_bs_match, function_clause, unit,
+ shared_sub_bins, bin_and_float, dec_subidentifiers,
+ skip_optional_tag, wfbm, degenerated_match, bs_sum,
+ coverage, multiple_uses, zero_label, followed_by_catch,
+ matching_meets_construction, simon,
+ matching_and_andalso, otp_7188, otp_7233, otp_7240,
+ otp_7498, match_string, zero_width, bad_size, haystack,
+ cover_beam_bool].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = test_server:timetrap(?t:minutes(1)),
[{watchdog,Dog}|Config].
-fin_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
+end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
@@ -118,7 +142,14 @@ otp_5269(Config) when is_list(Config) ->
[X || <<X:X>> <- [<<1:32>>,<<2:32>>,<<3:8>>]] end,
%% "binsize variable" ^
[1,2]),
-
+ ?line check(fun() ->
+ (fun (<<A:1/binary, B:8/integer, _C:B/binary>>) ->
+ case A of
+ B -> wrong;
+ _ -> ok
+ end
+ end)(<<1,2,3,4>>) end,
+ ok),
ok.
null_fields(Config) when is_list(Config) ->
@@ -302,15 +333,15 @@ partitioned_bs_match(Config) when is_list(Config) ->
?line error = partitioned_bs_match(10, <<7,8,15,13>>),
?line error = partitioned_bs_match(100, {a,tuple,is,'not',a,binary}),
?line ok = partitioned_bs_match(0, <<>>),
- ?line {'EXIT',{function_clause,[{?MODULE,partitioned_bs_match,[-1,blurf]}|_]}} =
- (catch partitioned_bs_match(-1, blurf)),
- ?line {'EXIT',{function_clause,[{?MODULE,partitioned_bs_match,[-1,<<1,2,3>>]}|_]}} =
- (catch partitioned_bs_match(-1, <<1,2,3>>)),
-
+ ?line fc(partitioned_bs_match, [-1,blurf],
+ catch partitioned_bs_match(-1, blurf)),
+ ?line fc(partitioned_bs_match, [-1,<<1,2,3>>],
+ catch partitioned_bs_match(-1, <<1,2,3>>)),
?line {17,<<1,2,3>>} = partitioned_bs_match_2(1, <<17,1,2,3>>),
?line {7,<<1,2,3>>} = partitioned_bs_match_2(7, <<17,1,2,3>>),
- ?line {'EXIT',{function_clause,[{?MODULE,partitioned_bs_match_2,[4,<<0:17>>]}|_]}} =
- (catch partitioned_bs_match_2(4, <<0:17>>)),
+
+ ?line fc(partitioned_bs_match_2, [4,<<0:17>>],
+ catch partitioned_bs_match_2(4, <<0:17>>)),
ok.
partitioned_bs_match(_, <<42:8,T/binary>>) ->
@@ -327,12 +358,10 @@ partitioned_bs_match_2(Len, <<_:8,T/binary>>) ->
function_clause(Config) when is_list(Config) ->
?line ok = function_clause_1(<<0,7,0,7,42>>),
- ?line {'EXIT',{function_clause,
- [{?MODULE,function_clause_1,[<<0,1,2,3>>]}|_]}} =
- (catch function_clause_1(<<0,1,2,3>>)),
- ?line {'EXIT',{function_clause,
- [{?MODULE,function_clause_1,[<<0,1,2,3>>]}|_]}} =
- (catch function_clause_1(<<0,7,0,1,2,3>>)),
+ ?line fc(function_clause_1, [<<0,1,2,3>>],
+ catch function_clause_1(<<0,1,2,3>>)),
+ ?line fc(function_clause_1, [<<0,1,2,3>>],
+ catch function_clause_1(<<0,7,0,1,2,3>>)),
ok.
function_clause_1(<<0:8,7:8,T/binary>>) ->
@@ -349,22 +378,17 @@ unit(Config) when is_list(Config) ->
?line 99 = peek8(<<99>>),
?line 100 = peek8(<<100,101>>),
- ?line {'EXIT',{function_clause,[{?MODULE,peek8,[<<100,101,0:1>>]}|_]}} =
- (catch peek8(<<100,101,0:1>>)),
+ ?line fc(peek8, [<<100,101,0:1>>], catch peek8(<<100,101,0:1>>)),
?line 37484 = peek16(<<37484:16>>),
?line 37489 = peek16(<<37489:16,5566:16>>),
- ?line {'EXIT',{function_clause,[{?MODULE,peek16,[<<8>>]}|_]}} =
- (catch peek16(<<8>>)),
- ?line {'EXIT',{function_clause,[{?MODULE,peek16,[<<42:15>>]}|_]}} =
- (catch peek16(<<42:15>>)),
- ?line {'EXIT',{function_clause,[{?MODULE,peek16,[<<1,2,3,4,5>>]}|_]}} =
- (catch peek16(<<1,2,3,4,5>>)),
+ ?line fc(peek16, [<<8>>], catch peek16(<<8>>)),
+ ?line fc(peek16, [<<42:15>>], catch peek16(<<42:15>>)),
+ ?line fc(peek16, [<<1,2,3,4,5>>], catch peek16(<<1,2,3,4,5>>)),
?line 127 = peek7(<<127:7>>),
?line 100 = peek7(<<100:7,19:7>>),
- ?line {'EXIT',{function_clause,[{?MODULE,peek7,[<<1,2>>]}|_]}} =
- (catch peek7(<<1,2>>)),
+ ?line fc(peek7, [<<1,2>>], catch peek7(<<1,2>>)),
ok.
peek1(<<B:8,_/bitstring>>) -> B.
@@ -533,15 +557,13 @@ bs_sum(Config) when is_list(Config) ->
?line 6 = bs_sum_1([1,2,3|0]),
?line 7 = bs_sum_1([1,2,3|one]),
- ?line {'EXIT',{function_clause,_}} = (catch bs_sum_1({too,big,tuple})),
- ?line {'EXIT',{function_clause,_}} = (catch bs_sum_1([1,2,3|{too,big,tuple}])),
+ ?line fc(catch bs_sum_1({too,big,tuple})),
+ ?line fc(catch bs_sum_1([1,2,3|{too,big,tuple}])),
?line [] = sneaky_alias(<<>>),
?line [559,387655] = sneaky_alias(id(<<559:32,387655:32>>)),
- ?line {'EXIT',{function_clause,[{?MODULE,sneaky_alias,[<<1>>]}|_]}} =
- (catch sneaky_alias(id(<<1>>))),
- ?line {'EXIT',{function_clause,[{?MODULE,sneaky_alias,[[1,2,3,4]]}|_]}} =
- (catch sneaky_alias(lists:seq(1, 4))),
+ ?line fc(sneaky_alias, [<<1>>], catch sneaky_alias(id(<<1>>))),
+ ?line fc(sneaky_alias, [[1,2,3,4]], catch sneaky_alias(lists:seq(1, 4))),
ok.
bs_sum_1(<<H,T/binary>>) -> H+bs_sum_1(T);
@@ -559,23 +581,26 @@ sneaky_alias(<<From:32,L/binary>>) -> [From|sneaky_alias(L)].
coverage(Config) when is_list(Config) ->
?line 0 = coverage_fold(fun(B, A) -> A+B end, 0, <<>>),
?line 6 = coverage_fold(fun(B, A) -> A+B end, 0, <<1,2,3>>),
- ?line {'EXIT',{function_clause,_}} = (catch coverage_fold(fun(B, A) ->
- A+B
- end, 0, [a,b,c])),
+ ?line fc(catch coverage_fold(fun(B, A) ->
+ A+B
+ end, 0, [a,b,c])),
+ ?line {<<42.0:64/float>>,float} = coverage_build(<<>>, <<42>>, float),
?line {<<>>,not_a_tuple} = coverage_build(<<>>, <<>>, not_a_tuple),
?line {<<16#76,"abc",16#A9,"abc">>,{x,42,43}} =
coverage_build(<<>>, <<16#7,16#A>>, {x,y,z}),
+ ?line [<<2>>,<<1>>] = coverage_bc(<<1,2>>, []),
+
?line {x,<<"abc">>,z} = coverage_setelement(<<2,"abc">>, {x,y,z}),
?line [42] = coverage_apply(<<42>>, [coverage_id]),
+ ?line 42 = coverage_external(<<42>>),
?line do_coverage_bin_to_term_list([]),
?line do_coverage_bin_to_term_list([lists:seq(0, 10),{a,b,c},<<23:42>>]),
- ?line {'EXIT',{function_clause,
- [{?MODULE,coverage_bin_to_term_list,[<<0,0,0,7>>]}|_]}} =
- (catch do_coverage_bin_to_term_list_1(<<7:32>>)),
+ ?line fc(coverage_bin_to_term_list, [<<0,0,0,7>>],
+ catch do_coverage_bin_to_term_list_1(<<7:32>>)),
?line <<>> = coverage_per_key(<<4:32>>),
?line <<$a,$b,$c>> = coverage_per_key(<<7:32,"abc">>),
@@ -587,6 +612,10 @@ coverage_fold(Fun, Acc, <<H,T/binary>>) ->
coverage_fold(Fun, Fun(IdFun(H), IdFun(Acc)), T);
coverage_fold(Fun, Acc, <<>>) when is_function(Fun, 2) -> Acc.
+coverage_build(Acc0, <<H,T/binary>>, float) ->
+ Float = id(<<H:64/float>>),
+ Acc = <<Acc0/binary,Float/binary>>,
+ coverage_build(Acc, T, float);
coverage_build(Acc0, <<H,T/binary>>, Tuple0) ->
Str = id(<<H:(id(4)),(H-1):4,"abc">>),
Acc = id(<<Acc0/bitstring,Str/bitstring>>),
@@ -597,6 +626,11 @@ coverage_build(Acc0, <<H,T/binary>>, Tuple0) ->
end;
coverage_build(Acc, <<>>, Tuple) -> {Acc,Tuple}.
+coverage_bc(<<H,T/binary>>, Acc) ->
+ B = << <<C:8>> || C <- [H] >>,
+ coverage_bc(T, [B|Acc]);
+coverage_bc(<<>>, Acc) -> Acc.
+
coverage_setelement(<<H,T1/binary>>, Tuple) when element(1, Tuple) =:= x ->
setelement(H, Tuple, T1).
@@ -604,6 +638,13 @@ coverage_apply(<<H,T/binary>>, [F|Fs]) ->
[?MODULE:F(H)|coverage_apply(T, Fs)];
coverage_apply(<<>>, []) -> [].
+coverage_external(<<H,T/binary>>) ->
+ ?MODULE:coverage_external_ignore(T, T),
+ H.
+
+coverage_external_ignore(_, _) ->
+ ok.
+
coverage_id(I) -> id(I).
do_coverage_bin_to_term_list(L) ->
@@ -731,13 +772,12 @@ encode_octet_string(<<OctetString/binary>>, Len) ->
simon(Config) when is_list(Config) ->
?line one = simon(blurf, <<>>),
?line two = simon(0, <<42>>),
- ?line {'EXIT',{function_clause,[{?MODULE,simon,[17,<<1>>]}|_]}} = (catch simon(17, <<1>>)),
- ?line {'EXIT',{function_clause,[{?MODULE,simon,[0,<<1,2,3>>]}|_]}} = (catch simon(0, <<1,2,3>>)),
+ ?line fc(simon, [17,<<1>>], catch simon(17, <<1>>)),
+ ?line fc(simon, [0,<<1,2,3>>], catch simon(0, <<1,2,3>>)),
?line one = simon2(blurf, <<9>>),
?line two = simon2(0, <<9,1>>),
- ?line {'EXIT',{function_clause,[{?MODULE,simon2,[0,<<9,10,11>>]}|_]}} =
- (catch simon2(0, <<9,10,11>>)),
+ ?line fc(simon2, [0,<<9,10,11>>], catch simon2(0, <<9,10,11>>)),
ok.
simon(_, <<>>) -> one;
@@ -985,6 +1025,36 @@ haystack_2(Haystack) ->
B
end || {X,Y} <- Subs ].
+fc({'EXIT',{function_clause,_}}) -> ok;
+fc({'EXIT',{{case_clause,_},_}}) when ?MODULE =:= bs_match_inline_SUITE -> ok.
+
+fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Args}|_]}}) -> ok;
+fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Arity}|_]}})
+ when length(Args) =:= Arity ->
+ true = test_server:is_native(?MODULE);
+fc(_, Args, {'EXIT',{{case_clause,ActualArgs},_}})
+ when ?MODULE =:= bs_match_inline_SUITE ->
+ Args = tuple_to_list(ActualArgs).
+
+%% Cover the clause handling bs_context to binary in
+%% beam_block:initialized_regs/2.
+cover_beam_bool(Config) when is_list(Config) ->
+ ?line ok = do_cover_beam_bool(<<>>, 3),
+ ?line <<19>> = do_cover_beam_bool(<<19>>, 2),
+ ?line <<42>> = do_cover_beam_bool(<<42>>, 1),
+ ?line <<17>> = do_cover_beam_bool(<<13,17>>, 0),
+ ok.
+
+do_cover_beam_bool(Bin, X) when X > 0 ->
+ if
+ X =:= 1; X =:= 2 ->
+ Bin;
+ true ->
+ ok
+ end;
+do_cover_beam_bool(<<_,Bin/binary>>, X) ->
+ do_cover_beam_bool(Bin, X+1).
+
check(F, R) ->
R = F().
diff --git a/lib/compiler/test/bs_utf_SUITE.erl b/lib/compiler/test/bs_utf_SUITE.erl
index d93bdef73d..f30a4d3fef 100644
--- a/lib/compiler/test/bs_utf_SUITE.erl
+++ b/lib/compiler/test/bs_utf_SUITE.erl
@@ -1,36 +1,55 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2008-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2008-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(bs_utf_SUITE).
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
utf8_roundtrip/1,unused_utf_char/1,utf16_roundtrip/1,
utf32_roundtrip/1,guard/1,extreme_tripping/1,
literals/1,coverage/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
-all(suite) ->
+all() ->
test_lib:recompile(?MODULE),
- [utf8_roundtrip,unused_utf_char,utf16_roundtrip,
- utf32_roundtrip,guard,extreme_tripping,
- literals,coverage].
+ [utf8_roundtrip, unused_utf_char, utf16_roundtrip,
+ utf32_roundtrip, guard, extreme_tripping, literals,
+ coverage].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
utf8_roundtrip(Config) when is_list(Config) ->
?line [utf8_roundtrip_1(P) || P <- utf_data()],
@@ -314,7 +333,7 @@ coverage(Config) when is_list(Config) ->
?line 0 = coverage_2(<<4096/utf8,65536/utf8,0>>),
?line 1 = coverage_2(<<1024/utf8,1025/utf8,1>>),
- ?line {'EXIT',{function_clause,_}} = (catch coverage_3(1)),
+ ?line fc(catch coverage_3(1)),
%% Cover beam_flatten (combining the heap allocation in
%% a subsequent test_heap instruction into the bs_init2
@@ -394,3 +413,5 @@ utf32_data() ->
<<16#41:32/little,NotIdentical:32/little,
16#0391:32/little,16#2E:32/little>>}.
+fc({'EXIT',{function_clause,_}}) -> ok;
+fc({'EXIT',{{case_clause,_},_}}) when ?MODULE =:= bs_utf_inline_SUITE -> ok.
diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl
index d4843c9eba..1343fbd1c9 100644
--- a/lib/compiler/test/compilation_SUITE.erl
+++ b/lib/compiler/test/compilation_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-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
@@ -20,34 +20,46 @@
-module(compilation_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-compile(export_all).
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [self_compile_old_inliner,self_compile,
- compiler_1,compiler_3,compiler_5,
- beam_compiler_1, beam_compiler_2, beam_compiler_3,
- beam_compiler_4, beam_compiler_5, beam_compiler_6,
- beam_compiler_7, beam_compiler_8, beam_compiler_9,
- beam_compiler_10, beam_compiler_11, beam_compiler_12,
- nested_tuples_in_case_expr,
- otp_2330, guards, vsn,
- otp_2380, otp_2141, otp_2173, otp_4790,
- const_list_256,
- bin_syntax_1, bin_syntax_2, bin_syntax_3,
- bin_syntax_4, bin_syntax_5, bin_syntax_6,
- live_var, convopts,
- bad_functional_value,
- catch_in_catch, redundant_case, long_string,
- otp_5076, complex_guard, otp_5092, otp_5151,
- otp_5235,otp_5244,
- 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
- ].
+ [self_compile_old_inliner, self_compile, compiler_1,
+ compiler_3, compiler_5, beam_compiler_1,
+ beam_compiler_2, beam_compiler_3, beam_compiler_4,
+ beam_compiler_5, beam_compiler_6, beam_compiler_7,
+ beam_compiler_8, beam_compiler_9, beam_compiler_10,
+ beam_compiler_11, beam_compiler_12,
+ nested_tuples_in_case_expr, otp_2330, guards,
+ {group, vsn}, otp_2380, otp_2141, otp_2173, otp_4790,
+ const_list_256, bin_syntax_1, bin_syntax_2,
+ bin_syntax_3, bin_syntax_4, bin_syntax_5, bin_syntax_6,
+ live_var, convopts, bad_functional_value,
+ catch_in_catch, redundant_case, long_string, otp_5076,
+ complex_guard, otp_5092, otp_5151, otp_5235, otp_5244,
+ 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].
+
+groups() ->
+ [{vsn, [], [vsn_1, vsn_2, vsn_3]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-define(comp(N),
N(Config) when is_list(Config) -> try_it(N, Config)).
@@ -151,7 +163,7 @@ split({int, N}, <<N:16,B:N/binary,T/binary>>) ->
beam_compiler_7(doc) ->
"Code snippet submitted from Ulf Wiger which fails in R3 Beam.";
beam_compiler_7(suite) -> [];
-beam_compiler_7(Config) when list(Config) ->
+beam_compiler_7(Config) when is_list(Config) ->
?line done = empty(2, false).
empty(N, Toggle) when N > 0 ->
@@ -311,12 +323,11 @@ from(H, [H | T]) -> T;
from(H, [_ | T]) -> from(H, T);
from(_, []) -> [].
-vsn(suite) -> [vsn_1, vsn_2, vsn_3].
vsn_1(doc) ->
"Test generation of 'vsn' attribute";
vsn_1(suite) -> [];
-vsn_1(Conf) when list(Conf) ->
+vsn_1(Conf) when is_list(Conf) ->
?line M = vsn_1,
?line compile_load(M, ?config(data_dir, Conf), Conf),
@@ -340,7 +351,7 @@ vsn_1(Conf) when list(Conf) ->
vsn_2(doc) ->
"Test overriding of generation of 'vsn' attribute";
vsn_2(suite) -> [];
-vsn_2(Conf) when list(Conf) ->
+vsn_2(Conf) when is_list(Conf) ->
?line M = vsn_2,
?line compile_load(M, ?config(data_dir, Conf), Conf),
@@ -356,7 +367,7 @@ vsn_2(Conf) when list(Conf) ->
vsn_3(doc) ->
"Test that different code yields different generated 'vsn'";
vsn_3(suite) -> [];
-vsn_3(Conf) when list(Conf) ->
+vsn_3(Conf) when is_list(Conf) ->
?line M = vsn_3,
?line compile_load(M, ?config(data_dir, Conf), Conf),
@@ -596,4 +607,55 @@ otp_7345(ObjRef, _RdEnv, Args) ->
10},
id(LlUnitdataReq).
+%% Check the generation of the string table.
+
+string_table(Config) when is_list(Config) ->
+ ?line DataDir = ?config(data_dir, Config),
+ ?line File = filename:join(DataDir, "string_table.erl"),
+ ?line {ok,string_table,Beam,[]} = compile:file(File, [return, binary]),
+ ?line {ok,{string_table,[StringTableChunk]}} = beam_lib:chunks(Beam, ["StrT"]),
+ ?line {"StrT", <<"stringabletringtable">>} = StringTableChunk,
+ ok.
+
+otp_8949_a(Config) when is_list(Config) ->
+ value = otp_8949_a(),
+ ok.
+
+-record(cs, {exs,keys = [],flags = 1}).
+-record(exs, {children = []}).
+
+otp_8949_a() ->
+ case id([#cs{}]) of
+ [#cs{}=Cs] ->
+ SomeVar = id(value),
+ if
+ Cs#cs.flags band 1 =/= 0 ->
+ id(SomeVar);
+ (((Cs#cs.exs)#exs.children /= [])
+ and
+ (Cs#cs.flags band (1 bsl 0 bor (1 bsl 22)) == 0));
+ Cs#cs.flags band (1 bsl 22) =/= 0 ->
+ ok
+ end
+ end.
+
+otp_8949_b(Config) when is_list(Config) ->
+ self() ! something,
+ ?line value = otp_8949_b([], false),
+ ?line {'EXIT',_} = (catch otp_8949_b([], true)),
+ ok.
+
+%% Would cause an endless loop in beam_utils.
+otp_8949_b(A, B) ->
+ Var = id(value),
+ if
+ A == [], B == false ->
+ ok
+ end,
+ receive
+ something ->
+ id(Var)
+ end.
+
+
id(I) -> I.
diff --git a/lib/compiler/test/compilation_SUITE_data/string_table.erl b/lib/compiler/test/compilation_SUITE_data/string_table.erl
new file mode 100644
index 0000000000..1da1d015dd
--- /dev/null
+++ b/lib/compiler/test/compilation_SUITE_data/string_table.erl
@@ -0,0 +1,8 @@
+-module(string_table).
+-export([f/1, g/1]).
+
+f(<<"string">>) -> string;
+f(<<"stringtable">>) -> stringtable.
+
+g(<<"stringtable">>) -> stringtable;
+g(<<"table">>) -> table.
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index 7c3990a855..b3e5376ffd 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -1,52 +1,69 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1997-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(compile_SUITE).
%% Tests compile:file/1 and compile:file/2 with various options.
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,
+-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,
- binary/1, cond_and_ifdef/1, listings/1, listings_big/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_use/1, bad_record_use1/1, bad_record_use2/1, strict_record/1,
+ bad_record_use1/1, bad_record_use2/1, strict_record/1,
missing_testheap/1, cover/1, env/1, core/1, asm/1]).
-export([init/3]).
+suite() -> [{ct_hooks,[ts_install_cth]}].
%% To cover the stripping of 'type' and 'spec' in beam_asm.
-type all_return_type() :: [atom()].
--spec all('suite' | [_]) -> all_return_type().
+-spec all() -> all_return_type().
-all(suite) ->
+all() ->
test_lib:recompile(?MODULE),
- [app_test,
- file_1, module_mismatch, big_file, outdir, binary,
- cond_and_ifdef, listings, listings_big,
- other_output, package_forms,
- encrypted_abstr,
- bad_record_use, strict_record,
+ [app_test, file_1, 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].
+groups() ->
+ [{bad_record_use, [],
+ [bad_record_use1, bad_record_use2]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
%% Test that the Application file has no `basic' errors.";
app_test(Config) when is_list(Config) ->
@@ -132,6 +149,76 @@ binary(Config) when is_list(Config) ->
?line test_server:timetrap_cancel(Dog),
ok.
+%% Tests that the dependencies-Makefile-related options work.
+
+makedep(Config) when is_list(Config) ->
+ ?line Dog = test_server:timetrap(test_server:seconds(60)),
+ ?line {Simple,Target} = files(Config, "makedep"),
+ ?line DataDir = ?config(data_dir, Config),
+ ?line SimpleRootname = filename:rootname(Simple),
+ ?line IncludeDir = filename:join(filename:dirname(Simple), "include"),
+ ?line IncludeOptions = [
+ {d,need_foo},
+ {d,foo_value,42},
+ {d,include_generated},
+ {i,IncludeDir}
+ ],
+ %% Basic rule.
+ ?line BasicMf1Name = SimpleRootname ++ "-basic1.mk",
+ ?line {ok,BasicMf1} = file:read_file(BasicMf1Name),
+ ?line {ok,_,Mf1} = compile:file(Simple, [binary,makedep]),
+ ?line BasicMf1 = makedep_canonicalize_result(Mf1, DataDir),
+ %% Basic rule with one existing header.
+ ?line BasicMf2Name = SimpleRootname ++ "-basic2.mk",
+ ?line {ok,BasicMf2} = file:read_file(BasicMf2Name),
+ ?line {ok,_,Mf2} = compile:file(Simple, [binary,makedep|IncludeOptions]),
+ ?line BasicMf2 = makedep_canonicalize_result(Mf2, DataDir),
+ %% Rule with one existing header and one missing header.
+ ?line MissingMfName = SimpleRootname ++ "-missing.mk",
+ ?line {ok,MissingMf} = file:read_file(MissingMfName),
+ ?line {ok,_,Mf3} = compile:file(Simple,
+ [binary,makedep,makedep_add_missing|IncludeOptions]),
+ ?line MissingMf = makedep_canonicalize_result(Mf3, DataDir),
+ %% Rule with modified target.
+ ?line TargetMf1Name = SimpleRootname ++ "-target1.mk",
+ ?line {ok,TargetMf1} = file:read_file(TargetMf1Name),
+ ?line {ok,_,Mf4} = compile:file(Simple,
+ [binary,makedep,{makedep_target,"$target"}|IncludeOptions]),
+ ?line TargetMf1 = makedep_modify_target(
+ makedep_canonicalize_result(Mf4, DataDir), "$$target"),
+ %% Rule with quoted modified target.
+ ?line TargetMf2Name = SimpleRootname ++ "-target2.mk",
+ ?line {ok,TargetMf2} = file:read_file(TargetMf2Name),
+ ?line {ok,_,Mf5} = compile:file(Simple,
+ [binary,makedep,{makedep_target,"$target"},makedep_quote_target|
+ IncludeOptions]),
+ ?line TargetMf2 = makedep_modify_target(
+ makedep_canonicalize_result(Mf5, DataDir), "$$target"),
+ %% Basic rule written to some file.
+ ?line {ok,_} = compile:file(Simple,
+ [makedep,{makedep_output,Target}|IncludeOptions]),
+ ?line {ok,Mf6} = file:read_file(Target),
+ ?line BasicMf2 = makedep_canonicalize_result(Mf6, DataDir),
+
+ ?line ok = file:delete(Target),
+ ?line ok = file:del_dir(filename:dirname(Target)),
+ ?line test_server:timetrap_cancel(Dog),
+ ok.
+
+makedep_canonicalize_result(Mf, DataDir) ->
+ Mf0 = binary_to_list(Mf),
+ %% Replace the Datadir by "$(srcdir)".
+ Mf1 = re:replace(Mf0, DataDir, "$(srcdir)/",
+ [global,multiline,{return,list}]),
+ %% Long lines are splitted, put back everything on one line.
+ Mf2 = re:replace(Mf1, "\\\\\n ", "", [global,multiline,{return,list}]),
+ list_to_binary(Mf2).
+
+makedep_modify_target(Mf, Target) ->
+ Mf0 = binary_to_list(Mf),
+ Mf1 = re:replace(Mf0, Target, "$target", [{return,list}]),
+ list_to_binary(Mf1).
+
%% Tests that conditional compilation, defining values, including files work.
cond_and_ifdef(Config) when is_list(Config) ->
@@ -465,7 +552,6 @@ exists(Name) ->
{error, _} -> false
end.
-bad_record_use(suite) -> [bad_record_use1, bad_record_use2].
%% Tests that the compiler does not accept
%% bad use of records.
@@ -625,7 +711,7 @@ core(Config) when is_list(Config) ->
{raw_abstract_v1,Abstr}}]}} =
beam_lib:chunks(Beam, [abstract_code]),
{Mod,Abstr} end || Beam <- TestBeams],
- ?line Res = p_run(fun(F) -> do_core(F, Outdir) end, Abstr),
+ ?line Res = test_lib:p_run(fun(F) -> do_core(F, Outdir) end, Abstr),
?line test_server:timetrap_cancel(Dog),
Res.
@@ -661,7 +747,7 @@ asm(Config) when is_list(Config) ->
?line Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"),
?line TestBeams = filelib:wildcard(Wc),
- ?line Res = p_run(fun(F) -> do_asm(F, Outdir) end, TestBeams),
+ ?line Res = test_lib:p_run(fun(F) -> do_asm(F, Outdir) end, TestBeams),
?line test_server:timetrap_cancel(Dog),
Res.
@@ -688,35 +774,3 @@ do_asm(Beam, Outdir) ->
[M,Class,Error,erlang:get_stacktrace()]),
error
end.
-
-%% p_run(fun() -> ok|error, List) -> ok
-%% Will fail the test case if there were any errors.
-
-p_run(Test, List) ->
- N = erlang:system_info(schedulers) + 1,
- p_run_loop(Test, List, N, [], 0, 0).
-
-p_run_loop(_, [], _, [], Errors, Ws) ->
- case Errors of
- 0 ->
- case Ws of
- 0 -> ok;
- 1 -> {comment,"1 core_lint failure"};
- N -> {comment,integer_to_list(N)++" core_lint failures"}
- end;
- N -> ?t:fail({N,errors})
- end;
-p_run_loop(Test, [H|T], N, Refs, Errors, Ws) when length(Refs) < N ->
- {_,Ref} = erlang:spawn_monitor(fun() -> exit(Test(H)) end),
- p_run_loop(Test, T, N, [Ref|Refs], Errors, Ws);
-p_run_loop(Test, List, N, Refs0, Errors0, Ws0) ->
- receive
- {'DOWN',Ref,process,_,Res} ->
- {Errors,Ws} = case Res of
- ok -> {Errors0,Ws0};
- error -> {Errors0+1,Ws0};
- warning -> {Errors0,Ws0+1}
- end,
- Refs = Refs0 -- [Ref],
- p_run_loop(Test, List, N, Refs, Errors, Ws)
- end.
diff --git a/lib/compiler/test/compile_SUITE_data/simple-basic1.mk b/lib/compiler/test/compile_SUITE_data/simple-basic1.mk
new file mode 100644
index 0000000000..4073fa82d0
--- /dev/null
+++ b/lib/compiler/test/compile_SUITE_data/simple-basic1.mk
@@ -0,0 +1 @@
+simple.beam: $(srcdir)/simple.erl
diff --git a/lib/compiler/test/compile_SUITE_data/simple-basic2.mk b/lib/compiler/test/compile_SUITE_data/simple-basic2.mk
new file mode 100644
index 0000000000..761d1d9582
--- /dev/null
+++ b/lib/compiler/test/compile_SUITE_data/simple-basic2.mk
@@ -0,0 +1 @@
+simple.beam: $(srcdir)/simple.erl $(srcdir)/include/simple.hrl
diff --git a/lib/compiler/test/compile_SUITE_data/simple-missing.mk b/lib/compiler/test/compile_SUITE_data/simple-missing.mk
new file mode 100644
index 0000000000..b13d44ec36
--- /dev/null
+++ b/lib/compiler/test/compile_SUITE_data/simple-missing.mk
@@ -0,0 +1 @@
+simple.beam: $(srcdir)/simple.erl $(srcdir)/include/simple.hrl generated.hrl
diff --git a/lib/compiler/test/compile_SUITE_data/simple-target1.mk b/lib/compiler/test/compile_SUITE_data/simple-target1.mk
new file mode 100644
index 0000000000..dd9fa0d6e5
--- /dev/null
+++ b/lib/compiler/test/compile_SUITE_data/simple-target1.mk
@@ -0,0 +1 @@
+$target: $(srcdir)/simple.erl $(srcdir)/include/simple.hrl
diff --git a/lib/compiler/test/compile_SUITE_data/simple-target2.mk b/lib/compiler/test/compile_SUITE_data/simple-target2.mk
new file mode 100644
index 0000000000..a5fc6f461d
--- /dev/null
+++ b/lib/compiler/test/compile_SUITE_data/simple-target2.mk
@@ -0,0 +1 @@
+$$target: $(srcdir)/simple.erl $(srcdir)/include/simple.hrl
diff --git a/lib/compiler/test/compile_SUITE_data/simple.erl b/lib/compiler/test/compile_SUITE_data/simple.erl
index 2021056388..0c1c70a778 100644
--- a/lib/compiler/test/compile_SUITE_data/simple.erl
+++ b/lib/compiler/test/compile_SUITE_data/simple.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2009. All Rights Reserved.
+%% Copyright Ericsson AB 1997-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
@@ -37,3 +37,7 @@ foo() ->
{?included_value, ?foo_value}.
-endif.
+
+-ifdef(include_generated).
+-include("generated.hrl").
+-endif.
diff --git a/lib/compiler/test/compiler.cover b/lib/compiler/test/compiler.cover
index 5ec2408a35..9fc4c7dd43 100644
--- a/lib/compiler/test/compiler.cover
+++ b/lib/compiler/test/compiler.cover
@@ -1,3 +1,5 @@
+{incl_app,compiler,details}.
+
%% -*- erlang -*-
-{exclude,[sys_pre_attributes,core_parse]}.
+{excl_mods,[sys_pre_attributes,core_scan,core_parse]}.
diff --git a/lib/compiler/test/compiler.dynspec b/lib/compiler/test/compiler.dynspec
deleted file mode 100644
index 7e452cef6c..0000000000
--- a/lib/compiler/test/compiler.dynspec
+++ /dev/null
@@ -1,10 +0,0 @@
-%% -*- erlang -*-
-%% You can test this file using this command.
-%% file:script("compiler.dynspec", [{'Os',"Unix"}]).
-
-case Os of
- "VxWorks" ->
- [{skip,{compile_SUITE,listings,"VxWorks filesystem too slow"}}];
- _ ->
- []
-end.
diff --git a/lib/compiler/test/compiler.spec b/lib/compiler/test/compiler.spec
new file mode 100644
index 0000000000..f2546c3ced
--- /dev/null
+++ b/lib/compiler/test/compiler.spec
@@ -0,0 +1,2 @@
+%% -*- erlang -*-
+{suites,"../compiler_test",all}.
diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl
index 54cf799057..26173c62b8 100644
--- a/lib/compiler/test/core_SUITE.erl
+++ b/lib/compiler/test/core_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2006-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
@@ -18,10 +18,12 @@
%%
-module(core_SUITE).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-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]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-define(comp(N),
N(Config) when is_list(Config) -> try_it(N, Config)).
@@ -30,14 +32,32 @@ init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = test_server:timetrap(?t:minutes(5)),
[{watchdog,Dog}|Config].
-fin_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
+end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [dehydrated_itracer,nested_tries].
+ [dehydrated_itracer, nested_tries].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
?comp(dehydrated_itracer).
?comp(nested_tries).
diff --git a/lib/compiler/test/core_SUITE_data/.gitignore b/lib/compiler/test/core_SUITE_data/.gitignore
new file mode 100644
index 0000000000..d11d93d37f
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/.gitignore
@@ -0,0 +1 @@
+!*.core
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index 5f2c905d4a..ac14d36e82 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2007-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
@@ -18,18 +18,37 @@
%%
-module(core_fold_SUITE).
--export([all/1,
+-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]).
-export([foo/0,foo/1,foo/2,foo/3]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-all(suite) ->
+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].
+ [t_element, setelement, t_length, append, t_apply, bifs,
+ eq, nested_call_in_case, coverage].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
t_element(Config) when is_list(Config) ->
X = make_ref(),
diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl
index cdd2434b25..eb5e50818e 100644
--- a/lib/compiler/test/error_SUITE.erl
+++ b/lib/compiler/test/error_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2010. All Rights Reserved.
+%% 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
@@ -18,14 +18,154 @@
%%
-module(error_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,
- head_mismatch_line/1,r11b_binaries/1,warnings_as_errors/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ head_mismatch_line/1,warnings_as_errors/1, bif_clashes/1]).
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [head_mismatch_line,r11b_binaries,warnings_as_errors].
+ [head_mismatch_line, warnings_as_errors, bif_clashes].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+bif_clashes(Config) when is_list(Config) ->
+ Ts = [{bif_clashes1,
+ <<"
+ -export([t/0]).
+ t() ->
+ length([a,b,c]).
+
+ length(X) ->
+ erlang:length(X).
+ ">>,
+ [return_warnings],
+ {error,
+ [{4, erl_lint,{call_to_redefined_old_bif,{length,1}}}], []} }],
+ ?line [] = run(Config, Ts),
+ Ts1 = [{bif_clashes2,
+ <<"
+ -export([t/0]).
+ -import(x,[length/1]).
+ t() ->
+ length([a,b,c]).
+ ">>,
+ [return_warnings],
+ {error,
+ [{3, erl_lint,{redefine_old_bif_import,{length,1}}}], []} }],
+ ?line [] = run(Config, Ts1),
+ Ts00 = [{bif_clashes3,
+ <<"
+ -export([t/0]).
+ -compile({no_auto_import,[length/1]}).
+ t() ->
+ length([a,b,c]).
+
+ length(X) ->
+ erlang:length(X).
+ ">>,
+ [return_warnings],
+ []}],
+ ?line [] = run(Config, Ts00),
+ Ts11 = [{bif_clashes4,
+ <<"
+ -export([t/0]).
+ -compile({no_auto_import,[length/1]}).
+ -import(x,[length/1]).
+ t() ->
+ length([a,b,c]).
+ ">>,
+ [return_warnings],
+ []}],
+ ?line [] = run(Config, Ts11),
+ Ts000 = [{bif_clashes5,
+ <<"
+ -export([t/0]).
+ t() ->
+ binary_part(<<1,2,3,4>>,1,2).
+
+ binary_part(X,Y,Z) ->
+ erlang:binary_part(X,Y,Z).
+ ">>,
+ [return_warnings],
+ {warning,
+ [{4, erl_lint,{call_to_redefined_bif,{binary_part,3}}}]} }],
+ ?line [] = run(Config, Ts000),
+ Ts111 = [{bif_clashes6,
+ <<"
+ -export([t/0]).
+ -import(x,[binary_part/3]).
+ t() ->
+ binary_part(<<1,2,3,4>>,1,2).
+ ">>,
+ [return_warnings],
+ {warning,
+ [{3, erl_lint,{redefine_bif_import,{binary_part,3}}}]} }],
+ ?line [] = run(Config, Ts111),
+ Ts2 = [{bif_clashes7,
+ <<"
+ -export([t/0]).
+ -compile({no_auto_import,[length/1]}).
+ -import(x,[length/1]).
+ t() ->
+ length([a,b,c]).
+ length(X) ->
+ erlang:length(X).
+ ">>,
+ [],
+ {error,
+ [{7,erl_lint,{define_import,{length,1}}}],
+ []} }],
+ ?line [] = run2(Config, Ts2),
+ Ts3 = [{bif_clashes8,
+ <<"
+ -export([t/1]).
+ -compile({no_auto_import,[length/1]}).
+ t(X) when length(X) > 3 ->
+ length([a,b,c]).
+ length(X) ->
+ erlang:length(X).
+ ">>,
+ [],
+ {error,
+ [{4,erl_lint,{illegal_guard_local_call,{length,1}}}],
+ []} }],
+ ?line [] = run2(Config, Ts3),
+ Ts4 = [{bif_clashes9,
+ <<"
+ -export([t/1]).
+ -compile({no_auto_import,[length/1]}).
+ -import(x,[length/1]).
+ t(X) when length(X) > 3 ->
+ length([a,b,c]).
+ ">>,
+ [],
+ {error,
+ [{5,erl_lint,{illegal_guard_local_call,{length,1}}}],
+ []} }],
+ ?line [] = run2(Config, Ts4),
+
+ ok.
+
+
+
%% Tests that a head mismatch is reported on the correct line (OTP-2125).
head_mismatch_line(Config) when is_list(Config) ->
@@ -42,55 +182,48 @@ get_compilation_errors(Config, Filename) ->
?line {error, [{_Name, E}|_], []} = compile:file(File, [return_errors]),
E.
-r11b_binaries(Config) when is_list(Config) ->
- Ts = [{r11b_binaries,
- <<"
- t1(Bin) ->
- case Bin of
- _ when size(Bin) > 20 -> erlang:error(too_long);
- <<_,T/binary>> -> t1(T);
- <<>> -> ok
- end.
-
- t2(<<_,T/bytes>>) ->
- split_binary(T, 4).
-
- t3(X) ->
- <<42,X/binary>>.
-
- t4(X) ->
- <<N:32>> = X,
- N.
- ">>,
- [r11],
- {error,
- [{5,v3_core,no_binaries},
- {6,v3_core,no_binaries},
- {9,v3_core,no_binaries},
- {13,v3_core,no_binaries},
- {16,v3_core,no_binaries}],
- []} }],
- ?line [] = run(Config, Ts),
- ok.
-
warnings_as_errors(Config) when is_list(Config) ->
- Ts = [{warnings_as_errors,
+ ?line TestFile = test_filename(Config),
+ ?line BeamFile = filename:rootname(TestFile, ".erl") ++ ".beam",
+ ?line OutDir = ?config(priv_dir, Config),
+
+ Ts1 = [{warnings_as_errors,
<<"
t() ->
A = unused,
ok.
">>,
- [warnings_as_errors],
- {error,
- [],
- [{3,erl_lint,{unused_var,'A'}}]} }],
- ?line [] = run(Config, Ts),
+ [warnings_as_errors, export_all, {outdir, OutDir}],
+ {error,
+ [],
+ [{3,erl_lint,{unused_var,'A'}}]} }],
+ ?line [] = run(Ts1, TestFile, write_beam),
+ ?line false = filelib:is_regular(BeamFile),
+
+ Ts2 = [{warning_unused_var,
+ <<"
+ t() ->
+ A = unused,
+ ok.
+ ">>,
+ [return_warnings, export_all, {outdir, OutDir}],
+ {warning,
+ [{3,erl_lint,{unused_var,'A'}}]} }],
+
+ ?line [] = run(Ts2, TestFile, write_beam),
+ ?line true = filelib:is_regular(BeamFile),
+ ?line ok = file:delete(BeamFile),
+
ok.
run(Config, Tests) ->
+ ?line File = test_filename(Config),
+ run(Tests, File, dont_write_beam).
+
+run(Tests, File, WriteBeam) ->
F = fun({N,P,Ws,E}, BadL) ->
- case catch run_test(Config, P, Ws) of
+ case catch run_test(P, File, Ws, WriteBeam) of
E ->
BadL;
Bad ->
@@ -101,25 +234,70 @@ run(Config, Tests) ->
end,
lists:foldl(F, [], Tests).
+run2(Config, Tests) ->
+ ?line File = test_filename(Config),
+ run2(Tests, File, dont_write_beam).
+
+run2(Tests, File, WriteBeam) ->
+ F = fun({N,P,Ws,E}, BadL) ->
+ case catch filter(run_test(P, File, Ws, WriteBeam)) of
+ E ->
+ BadL;
+ Bad ->
+ ?t:format("~nTest ~p failed. Expected~n ~p~n"
+ "but got~n ~p~n", [N, E, Bad]),
+ fail()
+ end
+ end,
+ lists:foldl(F, [], Tests).
+
+filter({error,Es,_Ws}) ->
+ {error,Es,[]};
+filter(X) ->
+ X.
+
%% Compiles a test module and returns the list of errors and warnings.
-run_test(Conf, Test0, Warnings) ->
- Filename = 'errors_test.erl',
- ?line DataDir = ?config(priv_dir, Conf),
+test_filename(Conf) ->
+ Filename = "errors_test.erl",
+ DataDir = ?config(priv_dir, Conf),
+ filename:join(DataDir, Filename).
+
+run_test(Test0, File, Warnings, WriteBeam) ->
?line Test = ["-module(errors_test). ", Test0],
- ?line File = filename:join(DataDir, Filename),
- ?line Opts = [binary,export_all,return|Warnings],
+ ?line Opts = case WriteBeam of
+ dont_write_beam ->
+ [binary,return_errors|Warnings];
+ write_beam ->
+ [return_errors|Warnings]
+ end,
?line ok = file:write_file(File, Test),
%% Compile once just to print all errors and warnings.
- ?line compile:file(File, [binary,export_all,report|Warnings]),
+ ?line compile:file(File, [binary,report|Warnings]),
%% Test result of compilation.
?line Res = case compile:file(File, Opts) of
- {error,[{_File,Es}],Ws} ->
+ {ok,errors_test,_,[{_File,Ws}]} ->
+ %io:format("compile:file(~s,~p) ->~n~p~n",
+ % [File,Opts,Ws]),
+ {warning,Ws};
+ {ok,errors_test,_,[]} ->
+ %io:format("compile:file(~s,~p) ->~n~p~n",
+ % [File,Opts,Ws]),
+ [];
+ {ok,errors_test,[{_File,Ws}]} ->
+ {warning,Ws};
+ {ok,errors_test,[]} ->
+ [];
+ {error,[{XFile,Es}],Ws} = _ZZ when is_list(XFile) ->
+ %io:format("compile:file(~s,~p) ->~n~p~n",
+ % [File,Opts,_ZZ]),
{error,Es,Ws};
- {error,Es,[{_File,Ws}]} ->
+ {error,Es,[{_File,Ws}]} = _ZZ->
+ %io:format("compile:file(~s,~p) ->~n~p~n",
+ % [File,Opts,_ZZ]),
{error,Es,Ws}
end,
file:delete(File),
diff --git a/lib/compiler/test/float_SUITE.erl b/lib/compiler/test/float_SUITE.erl
index 3d2dbf47e9..afc04fd440 100644
--- a/lib/compiler/test/float_SUITE.erl
+++ b/lib/compiler/test/float_SUITE.erl
@@ -1,29 +1,50 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2002-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2002-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(float_SUITE).
--export([all/1,pending/1,bif_calls/1,math_functions/1,mixed_float_and_int/1]).
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ pending/1,bif_calls/1,math_functions/1,mixed_float_and_int/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [pending,bif_calls,math_functions,mixed_float_and_int].
+ [pending, bif_calls, math_functions,
+ mixed_float_and_int].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
%% Thanks to Tobias Lindahl <[email protected]>
%% Shows the effect of pending exceptions on the x86.
@@ -41,7 +62,7 @@ float_sub(A)->
float_mul(0, _, _)->
ok;
float_mul(Iter, A, B) when is_float(A), is_float(B) ->
- A*B,
+ _ = A*B,
float_mul(Iter-1, A, B).
%% Thanks to Mikael Pettersson and Tobias Lindahl (HiPE).
@@ -82,6 +103,14 @@ bad_negate(X, Y) when is_float(X) ->
Y1 = -Y, %BIF call.
{X2, Y1}.
+%% Some math functions are not implemented on all platforms.
+-define(OPTIONAL(Expected, Expr),
+ try
+ Expected = Expr
+ catch
+ error:undef -> ok
+ end).
+
math_functions(Config) when is_list(Config) ->
%% Mostly silly coverage.
?line 0.0 = math:tan(0),
@@ -93,6 +122,14 @@ math_functions(Config) when is_list(Config) ->
?line -1.0 = math:cos(math:pi()),
?line 1.0 = math:exp(0),
?line 1.0 = math:pow(math:pi(), 0),
+ ?line 0.0 = math:log(1),
+ ?line 0.0 = math:asin(0),
+ ?line 0.0 = math:acos(1),
+ ?line ?OPTIONAL(0.0, math:asinh(0)),
+ ?line ?OPTIONAL(0.0, math:acosh(1)),
+ ?line ?OPTIONAL(0.0, math:atanh(0)),
+ ?line ?OPTIONAL(0.0, math:erf(0)),
+ ?line ?OPTIONAL(1.0, math:erfc(0)),
?line 0.0 = math:tan(id(0)),
?line 0.0 = math:atan2(id(0), 1),
@@ -101,6 +138,14 @@ math_functions(Config) when is_list(Config) ->
?line 0.0 = math:tanh(id(0)),
?line 1.0 = math:log10(id(10)),
?line 1.0 = math:exp(id(0)),
+ ?line 0.0 = math:log(id(1)),
+ ?line 0.0 = math:asin(id(0)),
+ ?line 0.0 = math:acos(id(1)),
+ ?line ?OPTIONAL(0.0, math:asinh(id(0))),
+ ?line ?OPTIONAL(0.0, math:acosh(id(1))),
+ ?line ?OPTIONAL(0.0, math:atanh(id(0))),
+ ?line ?OPTIONAL(0.0, math:erf(id(0))),
+ ?line ?OPTIONAL(1.0, math:erfc(id(0))),
%% Only for coverage (of beam_type.erl).
?line {'EXIT',{undef,_}} = (catch math:fnurfla(0)),
diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl
index fb2667245a..368a5815bf 100644
--- a/lib/compiler/test/fun_SUITE.erl
+++ b/lib/compiler/test/fun_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2000-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
@@ -18,14 +18,33 @@
%%
-module(fun_SUITE).
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [test1,overwritten_fun,otp_7202,bif_fun].
+ [test1, overwritten_fun, otp_7202, bif_fun].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
%%% The help functions below are copied from emulator:bs_construct_SUITE.
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index 5ae41f13e7..0e69efba6b 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -1,26 +1,27 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-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(guard_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
misc/1,const_cond/1,basic_not/1,complex_not/1,nested_nots/1,
semicolon/1,complex_semicolon/1,comma/1,
or_guard/1,more_or_guards/1,
@@ -31,19 +32,35 @@
t_is_boolean/1,is_function_2/1,
tricky/1,rel_ops/1,literal_type_tests/1,
basic_andalso_orelse/1,traverse_dcd/1,
- check_qlc_hrl/1,andalso_semi/1,tuple_size/1]).
+ check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1]).
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [misc,const_cond,basic_not,complex_not,nested_nots,
- semicolon,complex_semicolon,
- comma,or_guard,more_or_guards,
- complex_or_guards,and_guard,
- xor_guard,more_xor_guards,
- build_in_guard,old_guard_tests,gbif,
- t_is_boolean,is_function_2,tricky,rel_ops,literal_type_tests,
- basic_andalso_orelse,traverse_dcd,check_qlc_hrl,andalso_semi,
- tuple_size].
+ [misc, const_cond, basic_not, complex_not, nested_nots,
+ semicolon, complex_semicolon, comma, or_guard,
+ more_or_guards, complex_or_guards, and_guard, xor_guard,
+ more_xor_guards, build_in_guard, old_guard_tests, gbif,
+ t_is_boolean, is_function_2, tricky, rel_ops,
+ literal_type_tests, basic_andalso_orelse, traverse_dcd,
+ check_qlc_hrl, andalso_semi, t_tuple_size, binary_part].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
misc(Config) when is_list(Config) ->
?line 42 = case id(42) of
@@ -94,8 +111,8 @@ const_cond(Config) when is_list(Config) ->
const_cond(T, Sz) ->
case T of
_X when false -> never;
- _X when tuple(T), eq == eq, tuple_size(T) == Sz -> ok;
- _X when tuple(T), eq == leq, tuple_size(T) =< Sz -> ok;
+ _X when is_tuple(T), eq == eq, tuple_size(T) == Sz -> ok;
+ _X when is_tuple(T), eq == leq, tuple_size(T) =< Sz -> ok;
_X -> error
end.
@@ -1137,7 +1154,7 @@ make_test([{T,L}|Ts]) ->
make_test([]) -> [].
test(T, L) ->
- S0 = io_lib:format("begin io:format(\"~~p~~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T,L,T,L]),
+ S0 = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p}]), if ~w(~w) -> true; true -> false end end. ", [T,L,T,L]),
S = lists:flatten(S0),
{ok,Toks,_Line} = erl_scan:string(S),
{ok,E} = erl_parse:parse_exprs(Toks),
@@ -1145,7 +1162,7 @@ test(T, L) ->
{match,0,{atom,0,Val},hd(E)}.
test(T, L1, L2) ->
- S0 = io_lib:format("begin io:format(\"~~p~~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ", [T,L1,L2,T,L1,L2]),
+ S0 = io_lib:format("begin io:format(\"~~p~n\", [{~p,~p,~p}]), if ~w(~w, ~w) -> true; true -> false end end. ", [T,L1,L2,T,L1,L2]),
S = lists:flatten(S0),
{ok,Toks,_Line} = erl_scan:string(S),
{ok,E} = erl_parse:parse_exprs(Toks),
@@ -1316,11 +1333,11 @@ cqlc(M, F, As, St) ->
andalso_semi(Config) when is_list(Config) ->
?line ok = andalso_semi_foo(0),
?line ok = andalso_semi_foo(1),
- ?line {'EXIT',{function_clause,_}} = (catch andalso_semi_foo(2)),
+ ?line fc(catch andalso_semi_foo(2)),
?line ok = andalso_semi_bar([a,b,c]),
?line ok = andalso_semi_bar(1),
- ?line {'EXIT',{function_clause,_}} = (catch andalso_semi_bar([a,b])),
+ ?line fc(catch andalso_semi_bar([a,b])),
ok.
andalso_semi_foo(Bar) when is_integer(Bar) andalso Bar =:= 0; Bar =:= 1 ->
@@ -1330,10 +1347,10 @@ andalso_semi_bar(Bar) when is_list(Bar) andalso length(Bar) =:= 3; Bar =:= 1 ->
ok.
-tuple_size(Config) when is_list(Config) ->
+t_tuple_size(Config) when is_list(Config) ->
?line 10 = do_tuple_size({1,2,3,4}),
- ?line {'EXIT',{function_clause,_}} = (catch do_tuple_size({1,2,3})),
- ?line {'EXIT',{function_clause,_}} = (catch do_tuple_size(42)),
+ ?line fc(catch do_tuple_size({1,2,3})),
+ ?line fc(catch do_tuple_size(42)),
?line error = ludicrous_tuple_size({a,b,c}),
?line error = ludicrous_tuple_size([a,b,c]),
@@ -1362,6 +1379,146 @@ ludicrous_tuple_size(T)
when tuple_size(T) =:= 16#FFFFFFFFFFFFFFFF -> ok;
ludicrous_tuple_size(_) -> error.
+%%
+%% The binary_part/2,3 guard BIFs
+%%
+-define(MASK_ERROR(EXPR),mask_error((catch (EXPR)))).
+mask_error({'EXIT',{Err,_}}) ->
+ Err;
+mask_error(Else) ->
+ Else.
+
+binary_part(doc) ->
+ ["Tests the binary_part/2,3 guard (GC) bif's"];
+binary_part(Config) when is_list(Config) ->
+ %% This is more or less a copy of what the guard_SUITE in emulator
+ %% does to cover the guard bif's
+ ?line 1 = bptest(<<1,2,3>>),
+ ?line 2 = bptest(<<2,1,3>>),
+ ?line error = bptest(<<1>>),
+ ?line error = bptest(<<>>),
+ ?line error = bptest(apa),
+ ?line 3 = bptest(<<2,3,3>>),
+ % With one variable (pos)
+ ?line 1 = bptest(<<1,2,3>>,1),
+ ?line 2 = bptest(<<2,1,3>>,1),
+ ?line error = bptest(<<1>>,1),
+ ?line error = bptest(<<>>,1),
+ ?line error = bptest(apa,1),
+ ?line 3 = bptest(<<2,3,3>>,1),
+ % With one variable (length)
+ ?line 1 = bptesty(<<1,2,3>>,1),
+ ?line 2 = bptesty(<<2,1,3>>,1),
+ ?line error = bptesty(<<1>>,1),
+ ?line error = bptesty(<<>>,1),
+ ?line error = bptesty(apa,1),
+ ?line 3 = bptesty(<<2,3,3>>,2),
+ % With one variable (whole tuple)
+ ?line 1 = bptestx(<<1,2,3>>,{1,1}),
+ ?line 2 = bptestx(<<2,1,3>>,{1,1}),
+ ?line error = bptestx(<<1>>,{1,1}),
+ ?line error = bptestx(<<>>,{1,1}),
+ ?line error = bptestx(apa,{1,1}),
+ ?line 3 = bptestx(<<2,3,3>>,{1,2}),
+ % With two variables
+ ?line 1 = bptest(<<1,2,3>>,1,1),
+ ?line 2 = bptest(<<2,1,3>>,1,1),
+ ?line error = bptest(<<1>>,1,1),
+ ?line error = bptest(<<>>,1,1),
+ ?line error = bptest(apa,1,1),
+ ?line 3 = bptest(<<2,3,3>>,1,2),
+ % Direct (autoimported) call, these will be evaluated by the compiler...
+ ?line <<2>> = binary_part(<<1,2,3>>,1,1),
+ ?line <<1>> = binary_part(<<2,1,3>>,1,1),
+ % Compiler warnings due to constant evaluation expected (3)
+ ?line badarg = ?MASK_ERROR(binary_part(<<1>>,1,1)),
+ ?line badarg = ?MASK_ERROR(binary_part(<<>>,1,1)),
+ ?line badarg = ?MASK_ERROR(binary_part(apa,1,1)),
+ ?line <<3,3>> = binary_part(<<2,3,3>>,1,2),
+ % Direct call through apply
+ ?line <<2>> = apply(erlang,binary_part,[<<1,2,3>>,1,1]),
+ ?line <<1>> = apply(erlang,binary_part,[<<2,1,3>>,1,1]),
+ % Compiler warnings due to constant evaluation expected (3)
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<1>>,1,1])),
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[<<>>,1,1])),
+ ?line badarg = ?MASK_ERROR(apply(erlang,binary_part,[apa,1,1])),
+ ?line <<3,3>> = apply(erlang,binary_part,[<<2,3,3>>,1,2]),
+ % Constant propagation
+ ?line Bin = <<1,2,3>>,
+ ?line ok = if
+ binary_part(Bin,1,1) =:= <<2>> ->
+ ok;
+ %% Compiler warning, clause cannot match (expected)
+ true ->
+ error
+ end,
+ ?line ok = if
+ binary_part(Bin,{1,1}) =:= <<2>> ->
+ ok;
+ %% Compiler warning, clause cannot match (expected)
+ true ->
+ error
+ end,
+ ok.
+
+
+bptest(B) when length(B) =:= 1337 ->
+ 1;
+bptest(B) when binary_part(B,{1,1}) =:= <<2>> ->
+ 1;
+bptest(B) when erlang:binary_part(B,1,1) =:= <<1>> ->
+ 2;
+bptest(B) when erlang:binary_part(B,{1,2}) =:= <<3,3>> ->
+ 3;
+bptest(_) ->
+ error.
+
+bptest(B,A) when length(B) =:= A ->
+ 1;
+bptest(B,A) when binary_part(B,{A,1}) =:= <<2>> ->
+ 1;
+bptest(B,A) when erlang:binary_part(B,A,1) =:= <<1>> ->
+ 2;
+bptest(B,A) when erlang:binary_part(B,{A,2}) =:= <<3,3>> ->
+ 3;
+bptest(_,_) ->
+ error.
+
+bptestx(B,A) when length(B) =:= A ->
+ 1;
+bptestx(B,A) when binary_part(B,A) =:= <<2>> ->
+ 1;
+bptestx(B,A) when erlang:binary_part(B,A) =:= <<1>> ->
+ 2;
+bptestx(B,A) when erlang:binary_part(B,A) =:= <<3,3>> ->
+ 3;
+bptestx(_,_) ->
+ error.
+
+bptesty(B,A) when length(B) =:= A ->
+ 1;
+bptesty(B,A) when binary_part(B,{1,A}) =:= <<2>> ->
+ 1;
+bptesty(B,A) when erlang:binary_part(B,1,A) =:= <<1>> ->
+ 2;
+bptesty(B,A) when erlang:binary_part(B,{1,A}) =:= <<3,3>> ->
+ 3;
+bptesty(_,_) ->
+ error.
+
+bptest(B,A,_C) when length(B) =:= A ->
+ 1;
+bptest(B,A,C) when binary_part(B,{A,C}) =:= <<2>> ->
+ 1;
+bptest(B,A,C) when erlang:binary_part(B,A,C) =:= <<1>> ->
+ 2;
+bptest(B,A,C) when erlang:binary_part(B,{A,C}) =:= <<3,3>> ->
+ 3;
+bptest(_,_,_) ->
+ error.
+
+
+
%% Call this function to turn off constant propagation.
id(I) -> I.
@@ -1374,3 +1531,6 @@ check(F, Result) ->
io:format(" Got: ~p\n", [Other]),
test_server:fail()
end.
+
+fc({'EXIT',{function_clause,_}}) -> ok;
+fc({'EXIT',{{case_clause,_},_}}) when ?MODULE =:= guard_inline_SUITE -> ok.
diff --git a/lib/compiler/test/inline_SUITE.erl b/lib/compiler/test/inline_SUITE.erl
index 396fb450b7..af2b8ec92a 100644
--- a/lib/compiler/test/inline_SUITE.erl
+++ b/lib/compiler/test/inline_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2000-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
@@ -20,7 +20,7 @@
-module(inline_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-compile(export_all).
-compile({inline,[badarg/2]}).
@@ -28,10 +28,29 @@
%% Needed by test case `lists'.
-compile(inline_list_funcs).
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [attribute,bsdecode,bsdes,barnes2,decode1,smith,itracer,pseudoknot,lists,
- really_inlined,otp_7223,coverage].
+ [attribute, bsdecode, bsdes, barnes2, decode1, smith,
+ itracer, pseudoknot, lists, really_inlined, otp_7223,
+ coverage].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
attribute(Config) when is_list(Config) ->
Name = "attribute",
@@ -49,7 +68,7 @@ attribute(Config) when is_list(Config) ->
ok.
-define(comp(Name),
- Name(Config) when list(Config) ->
+ Name(Config) when is_list(Config) ->
try_inline(Name, Config)).
?comp(bsdecode).
diff --git a/lib/compiler/test/inline_SUITE_data/decode1.erl b/lib/compiler/test/inline_SUITE_data/decode1.erl
index d51bedcb2e..9b4fc071a3 100644
--- a/lib/compiler/test/inline_SUITE_data/decode1.erl
+++ b/lib/compiler/test/inline_SUITE_data/decode1.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2006-2010. 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%
%%
%----------------------------------------------------------------------
@@ -37,25 +37,25 @@
FrameList = [89,128,0,8,132,0,26,133,133,0,38,148,94,
128,0,2,129,128,92,128,0,2,0,0,112,128,0,
10,194,69,0,0,0,0,0,18,52,95],
- Frame = concat_binary([list_to_binary([89]),list_to_binary([128]),
- list_to_binary([0]),list_to_binary([8]),
- list_to_binary([132]),list_to_binary([0]),
- list_to_binary([26]),list_to_binary([133]),
- list_to_binary([133]),list_to_binary([0]),
- list_to_binary([38]),list_to_binary([148]),
- list_to_binary([94]),list_to_binary([128]),
- list_to_binary([0]),list_to_binary([2]),
- list_to_binary([129]),list_to_binary([128]),
- list_to_binary([92]),list_to_binary([128]),
- list_to_binary([0]),list_to_binary([2]),
- list_to_binary([0]),list_to_binary([0]),
- list_to_binary([112]),list_to_binary([128]),
- list_to_binary([0]),list_to_binary([10]),
- list_to_binary([194]),list_to_binary([69]),
- list_to_binary([0]),list_to_binary([0]),
- list_to_binary([0]),list_to_binary([0]),
- list_to_binary([0]),list_to_binary([18]),
- list_to_binary([52]),list_to_binary([95])]),
+ Frame = list_to_binary([list_to_binary([89]),list_to_binary([128]),
+ list_to_binary([0]),list_to_binary([8]),
+ list_to_binary([132]),list_to_binary([0]),
+ list_to_binary([26]),list_to_binary([133]),
+ list_to_binary([133]),list_to_binary([0]),
+ list_to_binary([38]),list_to_binary([148]),
+ list_to_binary([94]),list_to_binary([128]),
+ list_to_binary([0]),list_to_binary([2]),
+ list_to_binary([129]),list_to_binary([128]),
+ list_to_binary([92]),list_to_binary([128]),
+ list_to_binary([0]),list_to_binary([2]),
+ list_to_binary([0]),list_to_binary([0]),
+ list_to_binary([112]),list_to_binary([128]),
+ list_to_binary([0]),list_to_binary([10]),
+ list_to_binary([194]),list_to_binary([69]),
+ list_to_binary([0]),list_to_binary([0]),
+ list_to_binary([0]),list_to_binary([0]),
+ list_to_binary([0]),list_to_binary([18]),
+ list_to_binary([52]),list_to_binary([95])]),
R = loop(2,0,Frame),
{R,R =:= {0,[{ie,112,itu_t_standard,ignore,10,<<194,69,0,0,0,0,0,18,52,95>>},
diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl
index e62b2cd77e..c8908858ba 100644
--- a/lib/compiler/test/lc_SUITE.erl
+++ b/lib/compiler/test/lc_SUITE.erl
@@ -1,39 +1,59 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2001-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(lc_SUITE).
-author('[email protected]').
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-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,
basic/1,deeply_nested/1,no_generator/1,
empty_generator/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
-all(suite) ->
+all() ->
test_lib:recompile(?MODULE),
- [basic,deeply_nested,no_generator,empty_generator].
+ [basic, deeply_nested, no_generator, empty_generator].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = test_server:timetrap(?t:minutes(1)),
[{watchdog,Dog}|Config].
-fin_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
+end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
@@ -66,8 +86,7 @@ basic(Config) when is_list(Config) ->
?line {'EXIT',_} = (catch [X || X <- L1, list_to_atom(X) == dum]),
?line [] = [X || X <- L1, X+1 < 2],
?line {'EXIT',_} = (catch [X || X <- L1, odd(X)]),
- ?line {'EXIT',{function_clause,[{?MODULE,_,[x]}|_]}} =
- (catch [E || E <- id(x)]),
+ ?line fc([x], catch [E || E <- id(x)]),
ok.
tuple_list() ->
@@ -160,3 +179,10 @@ empty_generator(Config) when is_list(Config) ->
id(I) -> I.
+fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args}|_]}}) -> ok;
+fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Arity}|_]}})
+ when length(Args) =:= Arity ->
+ true = test_server:is_native(?MODULE);
+fc(Args, {'EXIT',{{case_clause,ActualArgs},_}})
+ when ?MODULE =:= lc_inline_SUITE ->
+ Args = tuple_to_list(ActualArgs).
diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl
index 20969c0b26..9406d7de8f 100644
--- a/lib/compiler/test/match_SUITE.erl
+++ b/lib/compiler/test/match_SUITE.erl
@@ -1,34 +1,53 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2004-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(match_SUITE).
--export([all/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
pmatch/1,mixed/1,aliases/1,match_in_call/1,
untuplify/1,shortcut_boolean/1,letify_guard/1,
- selectify/1]).
+ selectify/1,underscore/1,coverage/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
-all(suite) ->
+all() ->
test_lib:recompile(?MODULE),
- [pmatch,mixed,aliases,match_in_call,untuplify,shortcut_boolean,
- letify_guard,selectify].
+ [pmatch, mixed, aliases, match_in_call, untuplify,
+ shortcut_boolean, letify_guard, selectify, underscore, coverage].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
pmatch(Config) when is_list(Config) ->
?line ok = doit(1),
@@ -112,6 +131,12 @@ aliases(Config) when is_list(Config) ->
?line {42,42,42,42} = multiple_aliases_1(42),
?line {7,7,7} = multiple_aliases_2(7),
?line {{a,b},{a,b},{a,b}} = multiple_aliases_3({a,b}),
+
+ %% Lists/literals.
+ ?line {a,b} = list_alias1([a,b]),
+ ?line {a,b} = list_alias2([a,b]),
+ ?line {a,b} = list_alias3([a,b]),
+
ok.
str_alias(V) ->
@@ -206,6 +231,15 @@ multiple_aliases_2((A=B)=(A=C)) ->
multiple_aliases_3((A={_,_}=B)={_,_}=C) ->
{A,B,C}.
+list_alias1([a,b]=[X,Y]) ->
+ {X,Y}.
+
+list_alias2([X,Y]=[a,b]) ->
+ {X,Y}.
+
+list_alias3([X,b]=[a,Y]) ->
+ {X,Y}.
+
%% OTP-7018.
match_in_call(Config) when is_list(Config) ->
@@ -352,4 +386,30 @@ sel_same_value2(V) when V =:= 42; V =:= 43 ->
sel_same_value2(_) ->
error.
+underscore(Config) when is_list(Config) ->
+ case Config of
+ [] ->
+ %% Assignment to _ at the end of a construct.
+ _ = length(Config);
+ [_|_] ->
+ %% Assignment to _ at the end of a construct.
+ _ = list_to_tuple(Config)
+ end,
+ _ = is_list(Config),
+ ok.
+
+coverage(Config) when is_list(Config) ->
+ %% Cover beam_dead.
+ ok = coverage_1(x, a),
+ ok = coverage_1(x, b).
+
+coverage_1(B, Tag) ->
+ case Tag of
+ a -> coverage_2(1, a, B);
+ b -> coverage_2(2, b, B)
+ end.
+
+coverage_2(1, a, x) -> ok;
+coverage_2(2, b, x) -> ok.
+
id(I) -> I.
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index e096571d50..c941a80e61 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -1,42 +1,112 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2006-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2006-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(misc_SUITE).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-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,
tobias/1,empty_string/1,md5/1,silly_coverage/1,
- confused_literals/1,integer_encoding/1]).
+ confused_literals/1,integer_encoding/1,override_bif/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
+
+%% For the override_bif testcase.
+%% NB, no other testcases in this testsuite can use these without erlang:prefix!
+-compile({no_auto_import,[abs/1]}).
+-compile({no_auto_import,[binary_part/3]}).
+-compile({no_auto_import,[binary_part/2]}).
+-import(test_lib,[binary_part/2]).
+
+%% This should do no harm (except for fun byte_size/1 which does not, by design, work with import
+-compile({no_auto_import,[byte_size/1]}).
+-import(erlang,[byte_size/1]).
+
+
+
+%% Include an opaque declaration to cover the stripping of
+%% opaque types from attributes in v3_kernel.
+-opaque misc_SUITE_test_cases() :: [atom()].
init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = test_server:timetrap(?t:minutes(10)),
[{watchdog,Dog}|Config].
-fin_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
+end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+-spec all() -> misc_SUITE_test_cases().
+all() ->
test_lib:recompile(?MODULE),
- [tobias,empty_string,md5,silly_coverage,confused_literals,
- integer_encoding].
+ [tobias, empty_string, md5, silly_coverage,
+ confused_literals, integer_encoding, override_bif].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+
+%%
+%% Functions that override new and old bif's
+%%
+abs(_N) ->
+ dummy_abs.
+
+binary_part(_,_,_) ->
+ dummy_bp.
+
+% Make sure that auto-imported BIF's are overridden correctly
+
+override_bif(suite) ->
+ [];
+override_bif(doc) ->
+ ["Test dat local functions and imports override auto-imported BIFs."];
+override_bif(Config) when is_list(Config) ->
+ ?line dummy_abs = abs(1),
+ ?line dummy_bp = binary_part(<<"hello">>,1,1),
+ ?line dummy = binary_part(<<"hello">>,{1,1}),
+ ?line 1 = erlang:abs(1),
+ ?line <<"e">> = erlang:binary_part(<<"hello">>,1,1),
+ ?line <<"e">> = erlang:binary_part(<<"hello">>,{1,1}),
+ F = fun(X) when byte_size(X) =:= 4 ->
+ four;
+ (X) ->
+ byte_size(X)
+ end,
+ ?line four = F(<<1,2,3,4>>),
+ ?line 5 = F(<<1,2,3,4,5>>),
+ ok.
%% A bug reported by Tobias Lindahl for a development version of R11B.
@@ -92,13 +162,23 @@ md5_1(Beam) ->
silly_coverage(Config) when is_list(Config) ->
%% sys_core_fold, sys_core_setel, v3_kernel
BadCoreErlang = {c_module,[],
- name,exports,attrs,
+ name,[],[],
[{{c_var,[],{foo,2}},seriously_bad_body}]},
?line expect_error(fun() -> sys_core_fold:module(BadCoreErlang, []) end),
?line expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end),
?line expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end),
- %% v3_codgen
+ %% v3_life
+ BadKernel = {k_mdef,[],?MODULE,
+ [{foo,0}],
+ [],
+ [{k_fdef,
+ {k,[],[],[]},
+ f,0,[],
+ seriously_bad_body}]},
+ ?line expect_error(fun() -> v3_life:module(BadKernel, []) end),
+
+ %% v3_codegen
CodegenInput = {?MODULE,[{foo,0}],[],[{function,foo,0,[a|b],a,b}]},
?line expect_error(fun() -> v3_codegen:module(CodegenInput, []) end),
@@ -154,6 +234,17 @@ silly_coverage(Config) when is_list(Config) ->
{test,bs_get_binary2,{f,99},0,[{x,0},{atom,all},1,[]],{x,0}},
{block,[a|b]}]}],0},
?line expect_error(fun() -> beam_bsm:module(BsmInput, []) end),
+
+ %% beam_receive.
+ ReceiveInput = {?MODULE,[{foo,0}],[],
+ [{function,foo,0,2,
+ [{label,1},
+ {func_info,{atom,?MODULE},{atom,foo},0},
+ {label,2},
+ {call_ext,0,{extfunc,erlang,make_ref,0}},
+ {block,[a|b]}]}],0},
+ ?line expect_error(fun() -> beam_receive:module(ReceiveInput, []) end),
+
ok.
expect_error(Fun) ->
diff --git a/lib/compiler/test/num_bif_SUITE.erl b/lib/compiler/test/num_bif_SUITE.erl
index c246f56611..3479cf5425 100644
--- a/lib/compiler/test/num_bif_SUITE.erl
+++ b/lib/compiler/test/num_bif_SUITE.erl
@@ -1,24 +1,24 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2004-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(num_bif_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
%% Tests optimization of the BIFs:
%% abs/1
@@ -30,17 +30,37 @@
%% round/1
%% trunc/1
--export([all/1, t_abs/1, t_float/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2, t_abs/1, t_float/1,
t_float_to_list/1, t_integer_to_list/1,
t_list_to_integer/1,
- t_list_to_float/1, t_list_to_float_safe/1, t_list_to_float_risky/1,
+ t_list_to_float_safe/1, t_list_to_float_risky/1,
t_round/1, t_trunc/1]).
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
[t_abs, t_float, t_float_to_list, t_integer_to_list,
- t_list_to_float, t_list_to_integer,
- t_round, t_trunc].
+ {group, t_list_to_float}, t_list_to_integer, t_round,
+ t_trunc].
+
+groups() ->
+ [{t_list_to_float, [],
+ [t_list_to_float_safe, t_list_to_float_risky]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
t_abs(Config) when is_list(Config) ->
%% Floats.
@@ -142,7 +162,6 @@ t_integer_to_list(Config) when is_list(Config) ->
%% Tests list_to_float/1.
-t_list_to_float(suite) -> [t_list_to_float_safe, t_list_to_float_risky].
t_list_to_float_safe(Config) when is_list(Config) ->
?line 0.0 = list_to_float("0.0"),
@@ -166,7 +185,7 @@ t_list_to_float_safe(Config) when is_list(Config) ->
t_list_to_float_risky(Config) when is_list(Config) ->
?line Many_Ones = lists:duplicate(25000, $1),
- ?line list_to_float("2."++Many_Ones),
+ ?line _ = list_to_float("2."++Many_Ones),
?line {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)),
ok.
@@ -186,7 +205,7 @@ t_list_to_integer(Config) when is_list(Config) ->
%% Bignums.
?line 123456932798748738738 = list_to_integer("123456932798748738738"),
- ?line list_to_integer(lists:duplicate(2000, $1)),
+ ?line _ = list_to_integer(lists:duplicate(2000, $1)),
ok.
%% Tests round/1.
diff --git a/lib/compiler/test/parteval_SUITE.erl b/lib/compiler/test/parteval_SUITE.erl
index 3ef84571b9..6b1ae38c1b 100644
--- a/lib/compiler/test/parteval_SUITE.erl
+++ b/lib/compiler/test/parteval_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
+%% 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
@@ -18,11 +18,31 @@
%%
-module(parteval_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1, pe2/1]).
+-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.
-all(suite) -> [pe2].
%% (This is more general than needed, since we once compiled the same
%% source code with and without a certain option.)
diff --git a/lib/compiler/test/pmod_SUITE.erl b/lib/compiler/test/pmod_SUITE.erl
index 293e110c45..9a317b5762 100644
--- a/lib/compiler/test/pmod_SUITE.erl
+++ b/lib/compiler/test/pmod_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2010. All Rights Reserved.
+%% Copyright Ericsson AB 2004-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
@@ -18,28 +18,48 @@
%%
-module(pmod_SUITE).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-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,
basic/1, otp_8447/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
[basic, otp_8447].
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
init_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = test_server:timetrap(?t:minutes(1)),
[{watchdog,Dog}|Config].
-fin_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
+end_per_testcase(Case, Config) when is_atom(Case), is_list(Config) ->
Dog = ?config(watchdog, Config),
?t:timetrap_cancel(Dog),
ok.
basic(Config) when is_list(Config) ->
?line basic_1(Config, []),
-% ?line basic_1(Config, [inline]),
-% ?line basic_1(Config, [{inline,500},inline]),
+ ?line basic_1(Config, [inline]),
+ ?line basic_1(Config, [{inline,500},inline]),
ok.
basic_1(Config, Opts) ->
diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl
index cb8833759a..2a67615e5e 100644
--- a/lib/compiler/test/receive_SUITE.erl
+++ b/lib/compiler/test/receive_SUITE.erl
@@ -1,42 +1,61 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2004-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2004-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%
%%
%%% Purpose : Compiles various modules with tough code
-module(receive_SUITE).
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
- recv/1,coverage/1,otp_7980/1]).
+-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,
+ export/1,recv/1,coverage/1,otp_7980/1,ref_opt/1]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
init_per_testcase(_Case, Config) ->
?line Dog = test_server:timetrap(test_server:minutes(2)),
[{watchdog, Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
Dog=?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ok.
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [recv,coverage,otp_7980].
+ [recv, coverage, otp_7980, ref_opt, export].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
-record(state, {ena = true}).
@@ -157,5 +176,73 @@ otp_7980_add_clients(Count) ->
end,
N - 1
end, Count, [1,2,3]).
-
+
+ref_opt(Config) when is_list(Config) ->
+ case ?MODULE of
+ receive_SUITE -> ref_opt_1(Config);
+ _ -> {skip,"Enough to run this case once."}
+ end.
+
+ref_opt_1(Config) ->
+ ?line DataDir = ?config(data_dir, Config),
+ ?line PrivDir = ?config(priv_dir, Config),
+ ?line Sources = filelib:wildcard(filename:join([DataDir,"ref_opt","*.erl"])),
+ ?line test_lib:p_run(fun(Src) ->
+ do_ref_opt(Src, PrivDir)
+ end, Sources),
+ ok.
+
+do_ref_opt(Source, PrivDir) ->
+ try
+ {ok,Mod} = c:c(Source, [{outdir,PrivDir}]),
+ ok = Mod:Mod(),
+ Base = filename:rootname(filename:basename(Source), ".erl"),
+ BeamFile = filename:join(PrivDir, Base),
+ {beam_file,Mod,_,_,_,Code} = beam_disasm:file(BeamFile),
+ case Base of
+ "no_"++_ ->
+ [] = collect_recv_opt_instrs(Code);
+ "yes_"++_ ->
+ [{recv_mark,{f,L}},{recv_set,{f,L}}] =
+ collect_recv_opt_instrs(Code)
+ end,
+ ok
+ catch Class:Error ->
+ io:format("~s: ~p ~p\n~p\n",
+ [Source,Class,Error,erlang:get_stacktrace()]),
+ error
+ end.
+
+collect_recv_opt_instrs(Code) ->
+ L = [ [I || I <- Is,
+ begin
+ case I of
+ {recv_mark,{f,_}} -> true;
+ {recv_set,{f,_}} -> true;
+ _ -> false
+ end
+ end] || {function,_,_,_,Is} <- Code],
+ lists:append(L).
+
+export(Config) when is_list(Config) ->
+ Ref = make_ref(),
+ ?line self() ! {result,Ref,42},
+ ?line 42 = export_1(Ref),
+ ?line {error,timeout} = export_1(Ref),
+ ok.
+
+export_1(Reference) ->
+ id(Reference),
+ receive
+ {result,Reference,Result} ->
+ Result
+ after 1 ->
+ Result = {error,timeout}
+ end,
+ %% Result ({x,1}) is used, but not the return value ({x,0})
+ %% of the receive. Used to be incorrectly optimized
+ %% by beam_block.
+ id({build,self()}),
+ Result.
+
id(I) -> I.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/no_1.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/no_1.erl
new file mode 100644
index 0000000000..bc63dac437
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/no_1.erl
@@ -0,0 +1,99 @@
+-module(no_1).
+-compile(export_all).
+
+?MODULE() ->
+ ok.
+
+f1(X) ->
+ Ref = make_ref(),
+ receive
+ _ when [X] =:= Ref ->
+ ok
+ end.
+
+f2(X, Y) ->
+ _Ref = make_ref(),
+ receive
+ _ when X =:= Y ->
+ ok
+ end.
+
+f3(X) ->
+ Ref = make_ref(),
+ receive
+ _ when X =:= Ref ->
+ ok
+ end.
+
+f4(X) ->
+ Ref = make_ref(),
+ receive
+ {X,_} when not X =:= Ref ->
+ ok
+ end.
+
+f5(X) ->
+ Ref = make_ref(),
+ receive
+ {Y,_} when X =:= Y; Y =:= Ref ->
+ ok
+ end.
+
+f6(X) ->
+ Ref = make_ref(),
+ receive
+ {Y,_} when Y =:= Ref; Ref =:= X ->
+ ok
+ end.
+
+f7(X) ->
+ Ref = make_ref(),
+ receive
+ {Y,_} when Y =:= Ref; not (X =:= Ref) ->
+ ok
+ end.
+
+f8(X) ->
+ Ref = make_ref(),
+ receive
+ {Y,_} when not (X =:= Ref); Y =:= Ref ->
+ ok
+ end.
+
+f9(X) ->
+ Ref = make_ref(),
+ receive
+ {Y,_} when (not (X =:= Ref)) or (Y =:= Ref) ->
+ ok
+ end.
+
+f10(X, Y) ->
+ Ref = make_ref(),
+ receive
+ {Z,_} when not (X =:= Y andalso Z =:= Ref) ->
+ ok
+ end.
+
+f11(X, Y) ->
+ Ref = make_ref(),
+ receive
+ {Z,_} when not ((X =:= Y) and (Z =:= Ref)) ->
+ ok
+ end.
+
+f12(X, Y) ->
+ Ref = make_ref(),
+ receive
+ {Z,_} when not ((Z =:= Ref) and (X =:= Y)) ->
+ ok
+ end.
+
+f13() ->
+ Ref = make_ref(),
+ RefCopy = id(Ref),
+ receive
+ _ when hd([RefCopy]) =:= Ref ->
+ ok
+ end.
+
+id(I) -> I.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/no_2.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/no_2.erl
new file mode 100644
index 0000000000..bc8d30c2ac
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/no_2.erl
@@ -0,0 +1,26 @@
+-module(no_2).
+-compile(export_all).
+
+?MODULE() ->
+ ok.
+
+f1() ->
+ Ref = make_ref(),
+ receive
+ {'DOWN',Ref} ->
+ ok;
+ {'DOWN',_} ->
+ ok
+ end.
+
+f2(Pid, Msg) ->
+ Ref = erlang:monitor(process, Pid),
+ Pid ! Msg,
+ receive
+ {ok,Ref,Reply} ->
+ {ok,Reply};
+ {error,Ref,Reply} ->
+ {error,Reply};
+ {error,A,B} ->
+ {error,A,B}
+ end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/no_3.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/no_3.erl
new file mode 100644
index 0000000000..44cf8d7f71
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/no_3.erl
@@ -0,0 +1,14 @@
+-module(no_3).
+-compile(export_all).
+
+?MODULE() ->
+ ok.
+
+f(X) ->
+ Ref = case X of
+ false -> ref;
+ true -> make_ref()
+ end,
+ receive
+ Ref -> ok
+ end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_1.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_1.erl
new file mode 100644
index 0000000000..e2ebe234c1
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_1.erl
@@ -0,0 +1,12 @@
+-module(yes_1).
+-compile(export_all).
+
+?MODULE() ->
+ ok.
+
+f() ->
+ Ref = make_ref(),
+ receive
+ {Ref,Reply} ->
+ Reply
+ end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_2.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_2.erl
new file mode 100644
index 0000000000..6077cdcab9
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_2.erl
@@ -0,0 +1,13 @@
+-module(yes_2).
+-compile(export_all).
+
+?MODULE() ->
+ ok.
+
+f(Pid, Msg) ->
+ Ref = make_ref(),
+ Pid ! Msg,
+ receive
+ {Ref,Reply} ->
+ Reply
+ end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_3.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_3.erl
new file mode 100644
index 0000000000..28efc542ae
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_3.erl
@@ -0,0 +1,16 @@
+-module(yes_3).
+-compile(export_all).
+
+?MODULE() ->
+ ok.
+
+f(Pid, Msg) ->
+ Ref = make_ref(),
+ do_send(Pid, Msg),
+ receive
+ {Ref,Reply} ->
+ Reply
+ end.
+
+do_send(Pid, Msg) ->
+ Pid ! Msg.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_4.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_4.erl
new file mode 100644
index 0000000000..d1ba4832c7
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_4.erl
@@ -0,0 +1,16 @@
+-module(yes_4).
+-compile(export_all).
+
+?MODULE() ->
+ ok.
+
+f(Pid, Msg) ->
+ Ref = make_ref(),
+ catch do_send(Pid, Msg),
+ receive
+ {Ref,Reply} ->
+ Reply
+ end.
+
+do_send(Pid, Msg) ->
+ Pid ! Msg.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl
new file mode 100644
index 0000000000..3f02fba6a6
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_5.erl
@@ -0,0 +1,46 @@
+-module(yes_5).
+-compile(export_all).
+
+?MODULE() ->
+ ok.
+
+do_call(Process, Label, Request, Timeout) ->
+ Node = case Process of
+ {_S, N} when is_atom(N) ->
+ N;
+ _ when is_pid(Process) ->
+ node(Process)
+ end,
+ try erlang:monitor(process, Process) of
+ Mref ->
+ catch erlang:send(Process, {Label, {self(), Mref}, Request},
+ [noconnect]),
+ receive
+ {Mref, Reply} ->
+ erlang:demonitor(Mref, [flush]),
+ {ok, Reply};
+ {'DOWN', Mref, _, _, noconnection} ->
+ exit({nodedown, Node});
+ {'DOWN', Mref, _, _, Reason} ->
+ exit(Reason)
+ after Timeout ->
+ erlang:demonitor(Mref),
+ receive
+ {'DOWN', Mref, _, _, _} -> true
+ after 0 -> true
+ end,
+ exit(timeout)
+ end
+ catch
+ error:_ ->
+ monitor_node(Node, true),
+ receive
+ {nodedown, Node} ->
+ monitor_node(Node, false),
+ exit({nodedown, Node})
+ after 0 ->
+ Tag = make_ref(),
+ Process ! {Label, {self(), Tag}, Request},
+ ?MODULE:wait_resp(Node, Tag, Timeout)
+ end
+ end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_6.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_6.erl
new file mode 100644
index 0000000000..c54b636aa6
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_6.erl
@@ -0,0 +1,15 @@
+-module(yes_6).
+-compile(export_all).
+
+?MODULE() ->
+ ok.
+
+f(Pid, Msg) ->
+ Ref = erlang:monitor(process, Pid),
+ Pid ! Msg,
+ receive
+ {ok,Ref,Reply} ->
+ {ok,Reply};
+ {error,Ref,Reply} ->
+ {error,Reply}
+ end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_7.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_7.erl
new file mode 100644
index 0000000000..849eab1746
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_7.erl
@@ -0,0 +1,12 @@
+-module(yes_7).
+-compile(export_all).
+
+?MODULE() ->
+ ok.
+
+f(X, Y) ->
+ Ref = make_ref(),
+ receive
+ {Z,_} when X =:= Y, Ref =:= Z ->
+ ok
+ end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_8.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_8.erl
new file mode 100644
index 0000000000..a47fe8cfbf
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_8.erl
@@ -0,0 +1,15 @@
+-module(yes_8).
+-compile(export_all).
+
+?MODULE() ->
+ ok.
+
+%% Cover use of floating point registers.
+
+f(Pid, X) when is_float(X) ->
+ Ref = make_ref(),
+ Pid ! {X+3},
+ receive
+ Ref ->
+ ok
+ end.
diff --git a/lib/compiler/test/receive_SUITE_data/ref_opt/yes_9.erl b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_9.erl
new file mode 100644
index 0000000000..97fce5e734
--- /dev/null
+++ b/lib/compiler/test/receive_SUITE_data/ref_opt/yes_9.erl
@@ -0,0 +1,13 @@
+-module(yes_9).
+-compile(export_all).
+
+?MODULE() ->
+ ok.
+
+f(Fun) ->
+ Ref = make_ref(),
+ Fun(),
+ receive
+ {Ref,Reply} ->
+ Reply
+ end.
diff --git a/lib/compiler/test/record_SUITE.erl b/lib/compiler/test/record_SUITE.erl
index bd2ffd7f65..363422ec7e 100644
--- a/lib/compiler/test/record_SUITE.erl
+++ b/lib/compiler/test/record_SUITE.erl
@@ -1,44 +1,66 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2003-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%
%%
%%% Purpose : Test records.
-module(record_SUITE).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
--export([all/1,init_per_testcase/2,fin_per_testcase/2,
+-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,
errors/1,record_test_2/1,record_test_3/1,record_access_in_guards/1,
- guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1]).
+ guard_opt/1,eval_once/1,foobar/1,missing_test_heap/1,
+ nested_access/1,coverage/1]).
init_per_testcase(_Case, Config) ->
?line Dog = test_server:timetrap(test_server:minutes(2)),
[{watchdog,Dog}|Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
Dog = ?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ok.
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [errors,record_test_2,record_test_3,record_access_in_guards,
- guard_opt,eval_once,foobar,missing_test_heap].
+ [errors, record_test_2, record_test_3,
+ record_access_in_guards, guard_opt, eval_once, foobar,
+ missing_test_heap, nested_access, coverage].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
-record(foo, {a,b,c,d}).
-record(bar, {a,b,c,d}).
@@ -522,4 +544,43 @@ missing_test_heap_1(A = #foo_rec {foo_1 = _B,
foo_3 = C + 1,
foo_2 = D + 1}.
+-record(nrec0, {name = <<"nested0">>}).
+-record(nrec1, {name = <<"nested1">>, nrec0=#nrec0{}}).
+-record(nrec2, {name = <<"nested2">>, nrec1=#nrec1{}}).
+
+nested_access(Config) when is_list(Config) ->
+ N0 = #nrec0{},
+ N1 = #nrec1{},
+ N2 = #nrec2{},
+ ?line <<"nested0">> = N0#nrec0.name,
+ ?line <<"nested1">> = N1#nrec1.name,
+ ?line <<"nested2">> = N2#nrec2.name,
+ ?line <<"nested0">> = N1#nrec1.nrec0#nrec0.name,
+ ?line <<"nested0">> = N2#nrec2.nrec1#nrec1.nrec0#nrec0.name,
+ ?line <<"nested1">> = N2#nrec2.nrec1#nrec1.name,
+ ?line <<"nested0">> = ((N2#nrec2.nrec1)#nrec1.nrec0)#nrec0.name,
+
+ N1a = N2#nrec2.nrec1#nrec1{name = <<"nested1a">>},
+ ?line <<"nested1a">> = N1a#nrec1.name,
+
+ N2a = N2#nrec2.nrec1#nrec1.nrec0#nrec0{name = <<"nested0a">>},
+ N2b = ((N2#nrec2.nrec1)#nrec1.nrec0)#nrec0{name = <<"nested0a">>},
+ ?line <<"nested0a">> = N2a#nrec0.name,
+ ?line N2a = N2b,
+ ok.
+
+-record(rr, {a,b,c}).
+
+coverage(Config) when is_list(Config) ->
+ %% There should only remain one record test in the code below.
+ R0 = id(#rr{a=1,b=2,c=3}),
+ B = R0#rr.b, %Test the record here.
+ R = R0#rr{c=42}, %No need to test here.
+ if
+ B > R#rr.a -> %No need to test here.
+ ok
+ end,
+ #rr{a=1,b=2,c=42} = id(R), %Test for correctness.
+ ok.
+
id(I) -> I.
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index 3099538071..53d8c04169 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -1,26 +1,26 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2003-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(test_lib).
-include("test_server.hrl").
-
--export([recompile/1,opt_opts/1,get_data_dir/1,smoke_disasm/1]).
+-compile({no_auto_import,[binary_part/2]}).
+-export([recompile/1,opt_opts/1,get_data_dir/1,smoke_disasm/1,p_run/2,binary_part/2]).
recompile(Mod) when is_atom(Mod) ->
case whereis(cover_server) of
@@ -41,7 +41,7 @@ smoke_disasm(Mod) when is_atom(Mod) ->
smoke_disasm(code:which(Mod));
smoke_disasm(File) when is_list(File) ->
Res = beam_disasm:file(File),
- {beam_file,Mod} = {element(1, Res),element(2, Res)}.
+ {beam_file,_Mod} = {element(1, Res),element(2, Res)}.
%% Retrieve the "interesting" compiler options (options for optimization
%% and compatibility) for the given module.
@@ -56,20 +56,55 @@ opt_opts(Mod) ->
(no_new_binaries) -> true;
(no_new_apply) -> true;
(no_gc_bifs) -> true;
- (no_constant_pool) -> true;
(no_stack_trimming) -> true;
- (no_binaries) -> true;
(debug_info) -> true;
+ (inline) -> true;
(_) -> false
end, Opts).
-%% Some test suites gets cloned (e.g. to "record_SUITE" to "record_no_opt_SUITE"),
-%% but the data directory is not cloned. This function retrieves the path to
-%% the original data directory.
+%% Some test suites gets cloned (e.g. to "record_SUITE" to
+%% "record_no_opt_SUITE"), but the data directory is not cloned.
+%% This function retrieves the path to the original data directory.
get_data_dir(Config) ->
Data0 = ?config(data_dir, Config),
- {ok,Data1,_} = regexp:sub(Data0, "_no_opt_SUITE", "_SUITE"),
- {ok,Data2,_} = regexp:sub(Data1, "_post_opt_SUITE", "_SUITE"),
- {ok,Data,_} = regexp:sub(Data2, "_r11_SUITE", "_SUITE"),
- Data.
+ Opts = [{return,list}],
+ Data1 = re:replace(Data0, "_no_opt_SUITE", "_SUITE", Opts),
+ Data = re:replace(Data1, "_post_opt_SUITE", "_SUITE", Opts),
+ re:replace(Data, "_inline_SUITE", "_SUITE", Opts).
+
+%% p_run(fun(Data) -> ok|error, List) -> ok
+%% Will fail the test case if there were any errors.
+
+p_run(Test, List) ->
+ N = erlang:system_info(schedulers) + 1,
+ p_run_loop(Test, List, N, [], 0, 0).
+
+p_run_loop(_, [], _, [], Errors, Ws) ->
+ case Errors of
+ 0 ->
+ case Ws of
+ 0 -> ok;
+ 1 -> {comment,"1 warning"};
+ N -> {comment,integer_to_list(N)++" warnings"}
+ end;
+ N -> ?t:fail({N,errors})
+ end;
+p_run_loop(Test, [H|T], N, Refs, Errors, Ws) when length(Refs) < N ->
+ {_,Ref} = erlang:spawn_monitor(fun() -> exit(Test(H)) end),
+ p_run_loop(Test, T, N, [Ref|Refs], Errors, Ws);
+p_run_loop(Test, List, N, Refs0, Errors0, Ws0) ->
+ receive
+ {'DOWN',Ref,process,_,Res} ->
+ {Errors,Ws} = case Res of
+ ok -> {Errors0,Ws0};
+ error -> {Errors0+1,Ws0};
+ warning -> {Errors0,Ws0+1}
+ end,
+ Refs = Refs0 -- [Ref],
+ p_run_loop(Test, List, N, Refs, Errors, Ws)
+ end.
+
+%% This is for the misc_SUITE:override_bif testcase
+binary_part(_A,_B) ->
+ dummy.
diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl
index c2f6dc24be..c6e0f8d85d 100644
--- a/lib/compiler/test/trycatch_SUITE.erl
+++ b/lib/compiler/test/trycatch_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
+%% Copyright Ericsson AB 2003-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
@@ -18,21 +18,40 @@
%%
-module(trycatch_SUITE).
--export([all/1,basic/1,lean_throw/1,try_of/1,try_after/1,%after_bind/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,basic/1,lean_throw/1,
+ try_of/1,try_after/1,%after_bind/1,
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]).
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [basic,lean_throw,try_of,try_after,%after_bind,
- catch_oops,after_oops,eclectic,rethrow,
- nested_of,nested_catch,nested_after,
- nested_horrid,last_call_optimization,
- bool,plain_catch_coverage,andalso_orelse].
+ [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].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
basic(Conf) when is_list(Conf) ->
diff --git a/lib/compiler/test/warnings_SUITE.erl b/lib/compiler/test/warnings_SUITE.erl
index 6e60ab88cb..f6a572abfa 100644
--- a/lib/compiler/test/warnings_SUITE.erl
+++ b/lib/compiler/test/warnings_SUITE.erl
@@ -1,19 +1,19 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2003-2009. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 2003-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(warnings_SUITE).
@@ -26,12 +26,14 @@
-define(privdir, "warnings_SUITE_priv").
-define(t, test_server).
-else.
--include("test_server.hrl").
+-include_lib("test_server/include/test_server.hrl").
-define(datadir, ?config(data_dir, Conf)).
-define(privdir, ?config(priv_dir, Conf)).
-endif.
--export([all/1,init_per_testcase/2,fin_per_testcase/2]).
+-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]).
-export([pattern/1,pattern2/1,pattern3/1,pattern4/1,
guard/1,bad_arith/1,bool_cases/1,bad_apply/1,
@@ -44,16 +46,34 @@ init_per_testcase(_Case, Config) ->
?line Dog = ?t:timetrap(?default_timeout),
[{watchdog, Dog} | Config].
-fin_per_testcase(_Case, Config) ->
+end_per_testcase(_Case, Config) ->
Dog = ?config(watchdog, Config),
test_server:timetrap_cancel(Dog),
ok.
-all(suite) ->
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
test_lib:recompile(?MODULE),
- [pattern,pattern2,pattern3,pattern4,
- guard,bad_arith,bool_cases,bad_apply,files,effect,
- bin_opt_info,bin_construction].
+ [pattern, pattern2, pattern3, pattern4, guard,
+ bad_arith, bool_cases, bad_apply, files, effect,
+ bin_opt_info, bin_construction].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
pattern(Config) when is_list(Config) ->
%% Test warnings generated by v3_core.
@@ -375,7 +395,12 @@ effect(Config) when is_list(Config) ->
comp_op ->
X =:= 2;
cookie ->
- erlang:get_cookie()
+ erlang:get_cookie();
+ result_ignore ->
+ _ = list_to_integer(X);
+ warn_lc_4 ->
+ %% No warning because of assignment to _.
+ [_ = abs(Z) || Z <- [1,2,3]]
end,
ok.
@@ -428,6 +453,16 @@ effect(Config) when is_list(Config) ->
true -> ok
end,
ok.
+
+ m8(A, B) ->
+ case {A,B} of
+ V -> V
+ end,
+ ok.
+
+ m9(Bs) ->
+ [{B,ok} = {B,foo:bar(B)} || B <- Bs],
+ ok.
">>,
[],
{warnings,[{5,sys_core_fold,{no_effect,{erlang,is_integer,1}}},
diff --git a/lib/compiler/vsn.mk b/lib/compiler/vsn.mk
index a5e6de7b5f..04290c0a7f 100644
--- a/lib/compiler/vsn.mk
+++ b/lib/compiler/vsn.mk
@@ -1 +1 @@
-COMPILER_VSN = 4.6.5
+COMPILER_VSN = 4.7.5