aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stdlib')
-rw-r--r--lib/stdlib/doc/src/assert_hrl.xml46
-rw-r--r--lib/stdlib/doc/src/c.xml44
-rw-r--r--lib/stdlib/doc/src/dets.xml61
-rw-r--r--lib/stdlib/doc/src/dict.xml10
-rw-r--r--lib/stdlib/doc/src/erl_expand_records.xml6
-rw-r--r--lib/stdlib/doc/src/erl_internal.xml10
-rw-r--r--lib/stdlib/doc/src/erl_tar.xml72
-rw-r--r--lib/stdlib/doc/src/ets.xml23
-rw-r--r--lib/stdlib/doc/src/filelib.xml54
-rw-r--r--lib/stdlib/doc/src/filename.xml12
-rw-r--r--lib/stdlib/doc/src/gb_trees.xml22
-rw-r--r--lib/stdlib/doc/src/gen_event.xml22
-rw-r--r--lib/stdlib/doc/src/gen_fsm.xml5
-rw-r--r--lib/stdlib/doc/src/gen_server.xml5
-rw-r--r--lib/stdlib/doc/src/io_lib.xml14
-rw-r--r--lib/stdlib/doc/src/math.xml3
-rw-r--r--lib/stdlib/doc/src/notes.xml2
-rw-r--r--lib/stdlib/doc/src/orddict.xml11
-rw-r--r--lib/stdlib/doc/src/ordsets.xml3
-rw-r--r--lib/stdlib/doc/src/proc_lib.xml6
-rw-r--r--lib/stdlib/doc/src/proplists.xml2
-rw-r--r--lib/stdlib/doc/src/rand.xml96
-rw-r--r--lib/stdlib/doc/src/shell.xml14
-rw-r--r--lib/stdlib/doc/src/supervisor.xml6
-rw-r--r--lib/stdlib/doc/src/sys.xml2
-rw-r--r--lib/stdlib/doc/src/unicode_usage.xml31
-rw-r--r--lib/stdlib/include/assert.hrl184
-rw-r--r--lib/stdlib/src/Makefile6
-rw-r--r--lib/stdlib/src/array.erl14
-rw-r--r--lib/stdlib/src/base64.erl67
-rw-r--r--lib/stdlib/src/beam_lib.erl54
-rw-r--r--lib/stdlib/src/binary.erl2
-rw-r--r--lib/stdlib/src/c.erl278
-rw-r--r--lib/stdlib/src/dets.erl487
-rw-r--r--lib/stdlib/src/dets.hrl162
-rw-r--r--lib/stdlib/src/dets_utils.erl26
-rw-r--r--lib/stdlib/src/dets_v8.erl1594
-rw-r--r--lib/stdlib/src/dets_v9.erl112
-rw-r--r--lib/stdlib/src/dict.erl23
-rw-r--r--lib/stdlib/src/epp.erl2
-rw-r--r--lib/stdlib/src/erl_anno.erl8
-rw-r--r--lib/stdlib/src/erl_compile.erl4
-rw-r--r--lib/stdlib/src/erl_expand_records.erl111
-rw-r--r--lib/stdlib/src/erl_internal.erl118
-rw-r--r--lib/stdlib/src/erl_lint.erl191
-rw-r--r--lib/stdlib/src/erl_parse.yrl104
-rw-r--r--lib/stdlib/src/erl_pp.erl133
-rw-r--r--lib/stdlib/src/erl_tar.erl2566
-rw-r--r--lib/stdlib/src/erl_tar.hrl394
-rw-r--r--lib/stdlib/src/error_logger_file_h.erl57
-rw-r--r--lib/stdlib/src/error_logger_tty_h.erl58
-rw-r--r--lib/stdlib/src/escript.erl8
-rw-r--r--lib/stdlib/src/ets.erl46
-rw-r--r--lib/stdlib/src/eval_bits.erl14
-rw-r--r--lib/stdlib/src/filelib.erl122
-rw-r--r--lib/stdlib/src/filename.erl110
-rw-r--r--lib/stdlib/src/gb_sets.erl7
-rw-r--r--lib/stdlib/src/gb_trees.erl52
-rw-r--r--lib/stdlib/src/gen_event.erl82
-rw-r--r--lib/stdlib/src/gen_fsm.erl2
-rw-r--r--lib/stdlib/src/gen_server.erl77
-rw-r--r--lib/stdlib/src/io_lib.erl26
-rw-r--r--lib/stdlib/src/io_lib_format.erl8
-rw-r--r--lib/stdlib/src/io_lib_pretty.erl46
-rw-r--r--lib/stdlib/src/math.erl19
-rw-r--r--lib/stdlib/src/orddict.erl19
-rw-r--r--lib/stdlib/src/otp_internal.erl217
-rw-r--r--lib/stdlib/src/proc_lib.erl19
-rw-r--r--lib/stdlib/src/proplists.erl17
-rw-r--r--lib/stdlib/src/qlc_pt.erl59
-rw-r--r--lib/stdlib/src/rand.erl220
-rw-r--r--lib/stdlib/src/sets.erl66
-rw-r--r--lib/stdlib/src/shell.erl17
-rw-r--r--lib/stdlib/src/shell_default.erl5
-rw-r--r--lib/stdlib/src/sofs.erl357
-rw-r--r--lib/stdlib/src/stdlib.app.src3
-rw-r--r--lib/stdlib/src/stdlib.appup.src8
-rw-r--r--lib/stdlib/src/timer.erl6
-rw-r--r--lib/stdlib/src/zip.erl2
-rw-r--r--lib/stdlib/test/Makefile1
-rw-r--r--lib/stdlib/test/base64_SUITE.erl2
-rw-r--r--lib/stdlib/test/beam_lib_SUITE.erl45
-rw-r--r--lib/stdlib/test/dets_SUITE.erl811
-rw-r--r--lib/stdlib/test/dets_SUITE_data/version_8.dets (renamed from lib/stdlib/test/dets_SUITE_data/version_r2d.dets)bin33885 -> 35143 bytes
-rw-r--r--lib/stdlib/test/dict_SUITE.erl27
-rw-r--r--lib/stdlib/test/dict_test_lib.erl20
-rw-r--r--lib/stdlib/test/epp_SUITE.erl16
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl159
-rw-r--r--lib/stdlib/test/erl_pp_SUITE.erl81
-rw-r--r--lib/stdlib/test/erl_scan_SUITE.erl21
-rw-r--r--lib/stdlib/test/error_logger_h_SUITE.erl4
-rw-r--r--lib/stdlib/test/ets_SUITE.erl723
-rw-r--r--lib/stdlib/test/ets_tough_SUITE.erl58
-rw-r--r--lib/stdlib/test/filelib_SUITE.erl60
-rw-r--r--lib/stdlib/test/filename_SUITE.erl8
-rw-r--r--lib/stdlib/test/gen_event_SUITE.erl126
-rw-r--r--lib/stdlib/test/gen_server_SUITE.erl14
-rw-r--r--lib/stdlib/test/gen_statem_SUITE.erl8
-rw-r--r--lib/stdlib/test/io_SUITE.erl50
-rw-r--r--lib/stdlib/test/io_proto_SUITE.erl2
-rw-r--r--lib/stdlib/test/lists_SUITE.erl2
-rw-r--r--lib/stdlib/test/math_SUITE.erl92
-rw-r--r--lib/stdlib/test/proc_lib_SUITE.erl31
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl24
-rw-r--r--lib/stdlib/test/rand_SUITE.erl215
-rw-r--r--lib/stdlib/test/random_iolist.erl38
-rw-r--r--lib/stdlib/test/random_unicode_list.erl38
-rw-r--r--lib/stdlib/test/re_testoutput1_replacement_test.erl2
-rw-r--r--lib/stdlib/test/re_testoutput1_split_test.erl2
-rw-r--r--lib/stdlib/test/run_pcre_tests.erl73
-rw-r--r--lib/stdlib/test/shell_SUITE.erl38
-rw-r--r--lib/stdlib/test/sofs_SUITE.erl9
-rw-r--r--lib/stdlib/test/tar_SUITE.erl229
-rw-r--r--lib/stdlib/test/tar_SUITE_data/bsd.tarbin0 -> 9216 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/gnu.tarbin0 -> 30720 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/pax_mtime.tarbin0 -> 10240 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/sparse00.tar (renamed from lib/stdlib/test/dets_SUITE_data/version_r3b02.dets)bin34484 -> 61440 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/sparse01.tar (renamed from lib/stdlib/test/dets_SUITE_data/dets_test_v8b.dets)bin37396 -> 61440 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/sparse01_empty.tarbin0 -> 10240 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/sparse10.tar (renamed from lib/stdlib/test/dets_SUITE_data/dets_test_v8b_little_endian.dets)bin37396 -> 61440 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/sparse10_empty.tarbin0 -> 10240 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/star.tarbin0 -> 10240 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/v7.tarbin0 -> 10240 bytes
-rw-r--r--lib/stdlib/test/timer_SUITE.erl2
-rw-r--r--lib/stdlib/test/timer_simple_SUITE.erl2
-rw-r--r--lib/stdlib/test/zip_SUITE.erl2
126 files changed, 6710 insertions, 5296 deletions
diff --git a/lib/stdlib/doc/src/assert_hrl.xml b/lib/stdlib/doc/src/assert_hrl.xml
index cb91b1f126..ea23cca2ee 100644
--- a/lib/stdlib/doc/src/assert_hrl.xml
+++ b/lib/stdlib/doc/src/assert_hrl.xml
@@ -4,7 +4,7 @@
<fileref>
<header>
<copyright>
- <year>2012</year><year>2016</year>
+ <year>2012</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -28,7 +28,7 @@
<date></date>
<rev></rev>
</header>
- <file>assert.hrl.xml</file>
+ <file>assert.hrl</file>
<filesummary>Assert macros.</filesummary>
<description>
<p>The include file <c>assert.hrl</c> provides macros for inserting
@@ -49,25 +49,33 @@
entries in the <c>Info</c> list are optional; do not rely programatically
on any of them being present.</p>
+ <p>Each assert macro has a corresponding version with an extra argument,
+ for adding comments to assertions. These can for example be printed as
+ part of error reports, to clarify the meaning of the check that
+ failed. For example, <c>?assertEqual(0, fib(0), "Fibonacci is defined
+ for zero")</c>. The comment text can be any character data (string,
+ UTF8-binary, or deep list of such data), and will be included in the
+ error term as <c>{comment, Text}</c>.</p>
+
<p>If the macro <c>NOASSERT</c> is defined when <c>assert.hrl</c> is read
by the compiler, the macros are defined as equivalent to the atom
- <c>ok</c>. The test is not performed and there is no cost at runtime.</p>
+ <c>ok</c>. The test will not be performed and there is no cost at runtime.</p>
<p>For example, using <c>erlc</c> to compile your modules, the following
- disable all assertions:</p>
+ disables all assertions:</p>
<code type="none">
erlc -DNOASSERT=true *.erl</code>
- <p>The value of <c>NOASSERT</c> does not matter, only the fact that it is
- defined.</p>
+ <p>(The value of <c>NOASSERT</c> does not matter, only the fact that it is
+ defined.)</p>
<p>A few other macros also have effect on the enabling or disabling of
assertions:</p>
<list type="bulleted">
- <item><p>If <c>NODEBUG</c> is defined, it implies <c>NOASSERT</c>, unless
- <c>DEBUG</c> is also defined, which is assumed to take precedence.</p>
+ <item><p>If <c>NODEBUG</c> is defined, it implies <c>NOASSERT</c> (unless
+ <c>DEBUG</c> is also defined, which overrides <c>NODEBUG</c>).</p>
</item>
<item><p>If <c>ASSERT</c> is defined, it overrides <c>NOASSERT</c>, that
is, the assertions remain enabled.</p></item>
@@ -84,16 +92,22 @@ erlc -DNOASSERT=true *.erl</code>
<title>Macros</title>
<taglist>
<tag><c>assert(BoolExpr)</c></tag>
+ <item></item>
+ <tag><c>URKAassert(BoolExpr, Comment)</c></tag>
<item>
<p>Tests that <c>BoolExpr</c> completes normally returning
<c>true</c>.</p>
</item>
<tag><c>assertNot(BoolExpr)</c></tag>
+ <item></item>
+ <tag><c>assertNot(BoolExpr, Comment)</c></tag>
<item>
<p>Tests that <c>BoolExpr</c> completes normally returning
<c>false</c>.</p>
</item>
<tag><c>assertMatch(GuardedPattern, Expr)</c></tag>
+ <item></item>
+ <tag><c>assertMatch(GuardedPattern, Expr, Comment)</c></tag>
<item>
<p>Tests that <c>Expr</c> completes normally yielding a value that
matches <c>GuardedPattern</c>, for example:</p>
@@ -104,6 +118,8 @@ erlc -DNOASSERT=true *.erl</code>
?assertMatch({bork, X} when X > 0, f())</code>
</item>
<tag><c>assertNotMatch(GuardedPattern, Expr)</c></tag>
+ <item></item>
+ <tag><c>assertNotMatch(GuardedPattern, Expr, Comment)</c></tag>
<item>
<p>Tests that <c>Expr</c> completes normally yielding a value that does
not match <c>GuardedPattern</c>.</p>
@@ -111,16 +127,22 @@ erlc -DNOASSERT=true *.erl</code>
<c>when</c> part.</p>
</item>
<tag><c>assertEqual(ExpectedValue, Expr)</c></tag>
+ <item></item>
+ <tag><c>assertEqual(ExpectedValue, Expr, Comment)</c></tag>
<item>
<p>Tests that <c>Expr</c> completes normally yielding a value that is
exactly equal to <c>ExpectedValue</c>.</p>
</item>
<tag><c>assertNotEqual(ExpectedValue, Expr)</c></tag>
+ <item></item>
+ <tag><c>assertNotEqual(ExpectedValue, Expr, Comment)</c></tag>
<item>
<p>Tests that <c>Expr</c> completes normally yielding a value that is
not exactly equal to <c>ExpectedValue</c>.</p>
</item>
<tag><c>assertException(Class, Term, Expr)</c></tag>
+ <item></item>
+ <tag><c>assertException(Class, Term, Expr, Comment)</c></tag>
<item>
<p>Tests that <c>Expr</c> completes abnormally with an exception of type
<c>Class</c> and with the associated <c>Term</c>. The assertion fails
@@ -130,6 +152,8 @@ erlc -DNOASSERT=true *.erl</code>
patterns, as in <c>assertMatch</c>.</p>
</item>
<tag><c>assertNotException(Class, Term, Expr)</c></tag>
+ <item></item>
+ <tag><c>assertNotException(Class, Term, Expr, Comment)</c></tag>
<item>
<p>Tests that <c>Expr</c> does not evaluate abnormally with an
exception of type <c>Class</c> and with the associated <c>Term</c>.
@@ -139,14 +163,20 @@ erlc -DNOASSERT=true *.erl</code>
be guarded patterns.</p>
</item>
<tag><c>assertError(Term, Expr)</c></tag>
+ <item></item>
+ <tag><c>assertError(Term, Expr, Comment)</c></tag>
<item>
<p>Equivalent to <c>assertException(error, Term, Expr)</c></p>
</item>
<tag><c>assertExit(Term, Expr)</c></tag>
+ <item></item>
+ <tag><c>assertExit(Term, Expr, Comment)</c></tag>
<item>
<p>Equivalent to <c>assertException(exit, Term, Expr)</c></p>
</item>
<tag><c>assertThrow(Term, Expr)</c></tag>
+ <item></item>
+ <tag><c>assertThrow(Term, Expr, Comment)</c></tag>
<item>
<p>Equivalent to <c>assertException(throw, Term, Expr)</c></p>
</item>
diff --git a/lib/stdlib/doc/src/c.xml b/lib/stdlib/doc/src/c.xml
index 92ab59c6b0..7666699183 100644
--- a/lib/stdlib/doc/src/c.xml
+++ b/lib/stdlib/doc/src/c.xml
@@ -52,13 +52,27 @@
<func>
<name name="c" arity="1"/>
<name name="c" arity="2"/>
- <fsummary>Compile and load code in a file.</fsummary>
+ <name name="c" arity="3"/>
+ <fsummary>Compile and load a file or module.</fsummary>
<desc>
- <p>Compiles and then purges and loads the code for a file.
- <c><anno>Options</anno></c> defaults to <c>[]</c>. Compilation is
- equivalent to:</p>
- <code type="none">
-compile:file(<anno>File</anno>, <anno>Options</anno> ++ [report_errors, report_warnings])</code>
+ <p>Compiles and then purges and loads the code for a module.
+ <c><anno>Module</anno></c> can be either a module name or a source
+ file path, with or without <c>.erl</c> extension.
+ <c><anno>Options</anno></c> defaults to <c>[]</c>.</p>
+ <p>If <c><anno>Module</anno></c> is an atom and is not the path of a
+ source file, then the code path is searched to locate the object
+ file for the module and extract its original compiler options and
+ source path. If the source file is not found in the original
+ location, <seealso
+ marker="filelib#find_source/1"><c>filelib:find_source/1</c></seealso>
+ is used to search for it relative to the directory of the object
+ file.</p>
+ <p>The source file is compiled with the the original
+ options appended to the given <c><anno>Options</anno></c>, the
+ output replacing the old object file if and only if compilation
+ succeeds. A function <c><anno>Filter</anno></c> can be specified
+ for removing elements from from the original compiler options
+ before the new options are added.</p>
<p>Notice that purging the code means that any processes
lingering in old code for the module are killed without
warning. For more information, see <c>code/3</c>.</p>
@@ -148,6 +162,15 @@ compile:file(<anno>File</anno>, <anno>Options</anno> ++ [report_errors, report_w
</func>
<func>
+ <name name="lm" arity="0"/>
+ <fsummary>Loads all modified modules.</fsummary>
+ <desc>
+ <p>Reloads all currently loaded modules that have changed on disk (see <c>mm()</c>).
+ Returns the list of results from calling <c>l(M)</c> for each such <c>M</c>.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="ls" arity="0"/>
<fsummary>List files in the current directory.</fsummary>
<desc>
@@ -182,6 +205,15 @@ compile:file(<anno>File</anno>, <anno>Options</anno> ++ [report_errors, report_w
</func>
<func>
+ <name name="mm" arity="0"/>
+ <fsummary>Lists all modified modules.</fsummary>
+ <desc>
+ <p>Lists all modified modules. Shorthand for
+ <seealso marker="kernel:code#modified_modules/0"><c>code:modified_modules/0</c></seealso>.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="memory" arity="0"/>
<fsummary>Memory allocation information.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/dets.xml b/lib/stdlib/doc/src/dets.xml
index 2e4261d72e..eb6e32aecf 100644
--- a/lib/stdlib/doc/src/dets.xml
+++ b/lib/stdlib/doc/src/dets.xml
@@ -100,18 +100,12 @@
provided by Dets, neither is the limited support for
concurrent updates that makes a sequence of <c>first</c> and
<c>next</c> calls safe to use on fixed ETS tables. Both these
- features will be provided by Dets in a future release of
+ features may be provided by Dets in a future release of
Erlang/OTP. Until then, the Mnesia application (or some
user-implemented method for locking) must be used to implement safe
concurrency. Currently, no Erlang/OTP library has support for
ordered disk-based term storage.</p>
- <p>Two versions of the format used for storing objects on file are
- supported by Dets. The first version, 8, is the format always used
- for tables created by Erlang/OTP R7 and earlier. The second version, 9,
- is the default version of tables created by Erlang/OTP R8 (and later
- releases). Erlang/OTP R8 can create version 8 tables, and convert version
- 8 tables to version 9, and conversely, upon request.</p>
<p>All Dets functions return <c>{error, Reason}</c> if an error
occurs (<seealso marker="#first/1"><c>first/1</c></seealso> and
<seealso marker="#next/2"><c>next/2</c></seealso> are exceptions, they
@@ -190,9 +184,6 @@
<datatype>
<name name="type"/>
</datatype>
- <datatype>
- <name name="version"/>
- </datatype>
</datatypes>
<funcs>
@@ -385,8 +376,7 @@
<p><c>{bchunk_format, binary()}</c> - An opaque binary
describing the format of the objects returned by
<c>bchunk/2</c>. The binary can be used as argument to
- <c>is_compatible_chunk_format/2</c>. Only available for
- version 9 tables.</p>
+ <c>is_compatible_chunk_format/2</c>.</p>
</item>
<item>
<p><c>{hash, Hash}</c> - Describes which BIF is
@@ -394,10 +384,6 @@
Dets table. Possible values of <c>Hash</c>:</p>
<list>
<item>
- <p><c>hash</c> - Implies that the <c>erlang:hash/2</c> BIF
- is used.</p>
- </item>
- <item>
<p><c>phash</c> - Implies that the <c>erlang:phash/2</c> BIF
is used.</p>
</item>
@@ -413,8 +399,7 @@
</item>
<item>
<p><c>{no_keys, integer >= 0()}</c> - The number of different
- keys stored in the table. Only available for version 9
- tables.</p>
+ keys stored in the table.</p>
</item>
<item>
<p><c>{no_objects, integer >= 0()}</c> - The number of objects
@@ -424,8 +409,7 @@
<p><c>{no_slots, {Min, Used, Max}}</c> - The
number of slots of the table. <c>Min</c> is the minimum number of
slots, <c>Used</c> is the number of currently used slots,
- and <c>Max</c> is the maximum number of slots. Only
- available for version 9 tables.</p>
+ and <c>Max</c> is the maximum number of slots.</p>
</item>
<item>
<p><c>{owner, pid()}</c> - The pid of the process that
@@ -466,10 +450,6 @@
time warp safe</seealso>. Time warp safe code must use
<c>safe_fixed_monotonic_time</c> instead.</p>
</item>
- <item>
- <p><c>{version, integer()}</c> - The version of the format of
- the table.</p>
- </item>
</list>
</desc>
</func>
@@ -662,8 +642,8 @@ ok
objects at a time, until at least one object matches or the
end of the table is reached. The default, indicated by
giving <c><anno>N</anno></c> the value <c>default</c>, is to let
- the number of objects vary depending on the sizes of the objects. If
- <c><anno>Name</anno></c> is a version 9 table, all objects with the
+ the number of objects vary depending on the sizes of the objects.
+ All objects with the
same key are always matched at the same time, which implies that
more than <anno>N</anno> objects can sometimes be matched.</p>
<p>The table is always to be protected using
@@ -743,9 +723,9 @@ ok
end of the table is reached. The default, indicated by
giving <c><anno>N</anno></c> the value <c>default</c>,
is to let the number
- of objects vary depending on the sizes of the objects. If
- <c><anno>Name</anno></c> is a version 9 table, all matching objects
- with the same key are always returned in the same reply, which implies
+ of objects vary depending on the sizes of the objects. All
+ matching objects with the same key are always returned
+ in the same reply, which implies
that more than <anno>N</anno> objects can sometimes be returned.</p>
<p>The table is always to be protected using
<seealso marker="#safe_fixtable/2"><c>safe_fixtable/2</c></seealso>
@@ -842,8 +822,7 @@ ok
maximal value. Notice that a higher value can
increase the table fragmentation, and
a smaller value can decrease the fragmentation, at
- the expense of execution time. Only available for version
- 9 tables.</p>
+ the expense of execution time.</p>
</item>
<item>
<p><c>{min_no_slots, </c><seealso marker="#type-no_slots">
@@ -880,12 +859,7 @@ ok
FileName}}</c> is returned if the table must be repaired.</p>
<p>Value <c>force</c> means that a reparation
is made even if the table is properly closed.
- This is how to convert tables created by older versions of
- STDLIB. An example is tables hashed with the deprecated
- <c>erlang:hash/2</c> BIF. Tables created with Dets from
- STDLIB version 1.8.2 or later use function
- <c>erlang:phash/2</c> or function <c>erlang:phash2/1</c>,
- which is preferred.</p>
+ This is a seldom needed option.</p>
<p>Option <c>repair</c> is ignored if the table is already open.</p>
</item>
<item>
@@ -893,15 +867,6 @@ ok
<c>type()</c></seealso><c>}</c> - The table type. Defaults to
<c>set</c>.</p>
</item>
- <item>
- <p><c>{version, </c><seealso marker="#type-version">
- <c>version()</c></seealso><c>}</c> - The version of the format
- used for the table. Defaults to <c>9</c>. Tables on the format
- used before Erlang/OTP R8 can be created by specifying value
- <c>8</c>. A version 8 table can be converted to a version 9
- table by specifying options <c>{version,9}</c>
- and <c>{repair,force}</c>.</p>
- </item>
</list>
</desc>
</func>
@@ -1041,8 +1006,8 @@ ok
a time, until at least one object matches or the end of the
table is reached. The default, indicated by giving
<c><anno>N</anno></c> the value <c>default</c>, is to let the number
- of objects vary depending on the sizes of the objects. If
- <c><anno>Name</anno></c> is a version 9 table, all objects with the
+ of objects vary depending on the sizes of the objects. All
+ objects with the
same key are always handled at the same time, which implies that the
match specification can be applied to more than <anno>N</anno>
objects.</p>
diff --git a/lib/stdlib/doc/src/dict.xml b/lib/stdlib/doc/src/dict.xml
index c926ff1b5b..c229a18721 100644
--- a/lib/stdlib/doc/src/dict.xml
+++ b/lib/stdlib/doc/src/dict.xml
@@ -106,6 +106,16 @@
</func>
<func>
+ <name name="take" arity="2"/>
+ <fsummary>Return value and new dictionary without element with this value.</fsummary>
+ <desc>
+ <p>This function returns value from dictionary and a
+ new dictionary without this value.
+ Returns <c>error</c> if the key is not present in the dictionary.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="filter" arity="2"/>
<fsummary>Select elements that satisfy a predicate.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/erl_expand_records.xml b/lib/stdlib/doc/src/erl_expand_records.xml
index 7e4aa2db37..b6aa75ed03 100644
--- a/lib/stdlib/doc/src/erl_expand_records.xml
+++ b/lib/stdlib/doc/src/erl_expand_records.xml
@@ -45,8 +45,10 @@
<name name="module" arity="2"/>
<fsummary>Expand all records in a module.</fsummary>
<desc>
- <p>Expands all records in a module. The returned module has no
- references to records, attributes, or code.</p>
+ <p>Expands all records in a module to use explicit tuple
+ operations and adds explicit module names to calls to BIFs and
+ imported functions. The returned module has no references to
+ records, attributes, or code.</p>
</desc>
</func>
</funcs>
diff --git a/lib/stdlib/doc/src/erl_internal.xml b/lib/stdlib/doc/src/erl_internal.xml
index cf49df0972..17cd0fb240 100644
--- a/lib/stdlib/doc/src/erl_internal.xml
+++ b/lib/stdlib/doc/src/erl_internal.xml
@@ -44,6 +44,16 @@
<funcs>
<func>
+ <name name="add_predefined_functions" arity="1"/>
+ <fsummary>Add code for pre-defined functions.</fsummary>
+ <desc>
+ <p>Adds to <c><anno>Forms</anno></c> the code for the standard
+ pre-defined functions (such as <c>module_info/0</c>) that are
+ to be included in every module.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="arith_op" arity="2"/>
<fsummary>Test for an arithmetic operator.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/erl_tar.xml b/lib/stdlib/doc/src/erl_tar.xml
index 24e7b64b9e..f28d8b425b 100644
--- a/lib/stdlib/doc/src/erl_tar.xml
+++ b/lib/stdlib/doc/src/erl_tar.xml
@@ -37,12 +37,13 @@
</modulesummary>
<description>
<p>This module archives and extract files to and from
- a tar file. This module supports the <c>ustar</c> format
- (IEEE Std 1003.1 and ISO/IEC&nbsp;9945-1). All modern <c>tar</c>
- programs (including GNU tar) can read this format. To ensure that
- that GNU tar produces a tar file that <c>erl_tar</c> can read,
- specify option <c>--format=ustar</c> to GNU tar.</p>
-
+ a tar file. This module supports reading most common tar formats,
+ namely v7, STAR, USTAR, and PAX, as well as some of GNU tar's extensions
+ to the USTAR format (sparse files most notably). It produces tar archives
+ in USTAR format, unless the files being archived require PAX format due to
+ restrictions in USTAR (such as unicode metadata, filename length, and more).
+ As such, <c>erl_tar</c> supports tar archives produced by most all modern
+ tar utilities, and produces tarballs which should be similarly portable.</p>
<p>By convention, the name of a tar file is to end in "<c>.tar</c>".
To abide to the convention, add "<c>.tar</c>" to the name.</p>
@@ -83,6 +84,8 @@
<p>If <seealso marker="kernel:file#native_name_encoding/0">
<c>file:native_name_encoding/0</c></seealso>
returns <c>latin1</c>, no translation of path names is done.</p>
+
+ <p>Unicode metadata stored in PAX headers is preserved</p>
</section>
<section>
@@ -104,21 +107,20 @@
<title>Limitations</title>
<list type="bulleted">
<item>
- <p>For maximum compatibility, it is safe to archive files with names
- up to 100 characters in length. Such tar files can generally be
- extracted by any <c>tar</c> program.</p>
- </item>
- <item>
- <p>For filenames exceeding 100 characters in length, the resulting tar
- file can only be correctly extracted by a POSIX-compatible <c>tar</c>
- program (such as Solaris <c>tar</c> or a modern GNU <c>tar</c>).</p>
- </item>
- <item>
- <p>Files with longer names than 256 bytes cannot be stored.</p>
+ <p>If you must remain compatible with the USTAR tar format, you must ensure file paths being
+ stored are less than 255 bytes in total, with a maximum filename component
+ length of 100 bytes. USTAR uses a header field (prefix) in addition to the name field, and
+ splits file paths longer than 100 bytes into two parts. This split is done on a directory boundary,
+ and is done in such a way to make the best use of the space available in those two fields, but in practice
+ this will often mean that you have less than 255 bytes for a path. <c>erl_tar</c> will
+ automatically upgrade the format to PAX to handle longer filenames, so this is only an issue if you
+ need to extract the archive with an older implementation of <c>erl_tar</c> or <c>tar</c> which does
+ not support PAX. In this case, the PAX headers will be extracted as regular files, and you will need to
+ apply them manually.</p>
</item>
<item>
- <p>The file name a symbolic link points is always limited
- to 100 characters.</p>
+ <p>Like the above, if you must remain USTAR compatible, you must also ensure than paths for
+ symbolic/hard links are no more than 100 bytes, otherwise PAX headers will be used.</p>
</item>
</list>
</section>
@@ -129,7 +131,9 @@
<fsummary>Add a file to an open tar file.</fsummary>
<type>
<v>TarDescriptor = term()</v>
- <v>Filename = filename()</v>
+ <v>FilenameOrBin = filename()|binary()</v>
+ <v>NameInArchive = filename()</v>
+ <v>Filename = filename()|{NameInArchive,FilenameOrBin}</v>
<v>Options = [Option]</v>
<v>Option = dereference|verbose|{chunks,ChunkSize}</v>
<v>ChunkSize = positive_integer()</v>
@@ -139,6 +143,9 @@
<desc>
<p>Adds a file to a tar file that has been opened for writing by
<seealso marker="#open/2"><c>open/1</c></seealso>.</p>
+ <p><c>NameInArchive</c> is the name under which the file becomes
+ stored in the tar file. The file gets this name when it is
+ extracted from the tar file.</p>
<p>Options:</p>
<taglist>
<tag><c>dereference</c></tag>
@@ -183,9 +190,6 @@
<seealso marker="#open/2"><c>open/2</c></seealso>. This function
accepts the same options as
<seealso marker="#add/3"><c>add/3</c></seealso>.</p>
- <p><c>NameInArchive</c> is the name under which the file becomes
- stored in the tar file. The file gets this name when it is
- extracted from the tar file.</p>
</desc>
</func>
@@ -206,8 +210,8 @@
<fsummary>Create a tar archive.</fsummary>
<type>
<v>Name = filename()</v>
- <v>FileList = [Filename|{NameInArchive, binary()},{NameInArchive,
- Filename}]</v>
+ <v>FileList = [Filename|{NameInArchive, FilenameOrBin}]</v>
+ <v>FilenameOrBin = filename()|binary()</v>
<v>Filename = filename()</v>
<v>NameInArchive = filename()</v>
<v>RetValue = ok|{error,{Name,Reason}}</v>
@@ -225,8 +229,8 @@
<fsummary>Create a tar archive with options.</fsummary>
<type>
<v>Name = filename()</v>
- <v>FileList = [Filename|{NameInArchive, binary()},{NameInArchive,
- Filename}]</v>
+ <v>FileList = [Filename|{NameInArchive, FilenameOrBin}]</v>
+ <v>FilenameOrBin = filename()|binary()</v>
<v>Filename = filename()</v>
<v>NameInArchive = filename()</v>
<v>OptionList = [Option]</v>
@@ -275,7 +279,8 @@
<name>extract(Name) -> RetValue</name>
<fsummary>Extract all files from a tar file.</fsummary>
<type>
- <v>Name = filename()</v>
+ <v>Name = filename() | {binary,binary()} | {file,Fd}</v>
+ <v>Fd = file_descriptor()</v>
<v>RetValue = ok|{error,{Name,Reason}}</v>
<v>Reason = term()</v>
</type>
@@ -294,8 +299,7 @@
<name>extract(Name, OptionList)</name>
<fsummary>Extract files from a tar file.</fsummary>
<type>
- <v>Name = filename() | {binary,Binary} | {file,Fd}</v>
- <v>Binary = binary()</v>
+ <v>Name = filename() | {binary,binary()} | {file,Fd}</v>
<v>Fd = file_descriptor()</v>
<v>OptionList = [Option]</v>
<v>Option = {cwd,Cwd}|{files,FileList}|keep_old_files|verbose|memory</v>
@@ -521,7 +525,7 @@ erl_tar:close(TarDesc)</code>
<name>table(Name) -> RetValue</name>
<fsummary>Retrieve the name of all files in a tar file.</fsummary>
<type>
- <v>Name = filename()</v>
+ <v>Name = filename()|{binary,binary()}|{file,file_descriptor()}</v>
<v>RetValue = {ok,[string()]}|{error,{Name,Reason}}</v>
<v>Reason = term()</v>
</type>
@@ -535,7 +539,7 @@ erl_tar:close(TarDesc)</code>
<fsummary>Retrieve name and information of all files in a tar file.
</fsummary>
<type>
- <v>Name = filename()</v>
+ <v>Name = filename()|{binary,binary()}|{file,file_descriptor()}</v>
</type>
<desc>
<p>Retrieves the names of all files in the tar file <c>Name</c>.</p>
@@ -546,7 +550,7 @@ erl_tar:close(TarDesc)</code>
<name>t(Name)</name>
<fsummary>Print the name of each file in a tar file.</fsummary>
<type>
- <v>Name = filename()</v>
+ <v>Name = filename()|{binary,binary()}|{file,file_descriptor()}</v>
</type>
<desc>
<p>Prints the names of all files in the tar file <c>Name</c> to the
@@ -559,7 +563,7 @@ erl_tar:close(TarDesc)</code>
<fsummary>Print name and information for each file in a tar file.
</fsummary>
<type>
- <v>Name = filename()</v>
+ <v>Name = filename()|{binary,binary()}|{file,file_descriptor()}</v>
</type>
<desc>
<p>Prints names and information about all files in the tar file
diff --git a/lib/stdlib/doc/src/ets.xml b/lib/stdlib/doc/src/ets.xml
index 5f5d2b7f36..d1ec176f81 100644
--- a/lib/stdlib/doc/src/ets.xml
+++ b/lib/stdlib/doc/src/ets.xml
@@ -541,10 +541,6 @@ Error: fun containing local Erlang function calls
<c><anno>Tab</anno></c> is
not of the correct type, or if <c><anno>Item</anno></c> is not
one of the allowed values, a <c>badarg</c> exception is raised.</p>
- <warning>
- <p>In Erlang/OTP R11B and earlier, this function would not fail but
- return <c>undefined</c> for invalid values for <c>Item</c>.</p>
- </warning>
<p>In addition to the <c>{<anno>Item</anno>,<anno>Value</anno>}</c>
pairs defined for <seealso marker="#info/1"><c>info/1</c></seealso>,
the following items are allowed:</p>
@@ -1495,6 +1491,25 @@ is_integer(X), is_integer(Y), X + Y < 4711]]></code>
</func>
<func>
+ <name name="select_replace" arity="2"/>
+ <fsummary>Match and replace objects atomically in an ETS table</fsummary>
+ <desc>
+ <p>Matches the objects in the table <c><anno>Tab</anno></c> using a
+ <seealso marker="#match_spec">match specification</seealso>. If
+ an object is matched, the existing object is replaced with
+ the match specification result, which <em>must</em> retain
+ the original key or the operation will fail with <c>badarg</c>.</p>
+ <p>For the moment, due to performance and semantic constraints,
+ tables of type <c>bag</c> are not yet supported.</p>
+ <p>The function returns the total number of replaced objects.</p>
+ <note>
+ <p>The match/replacement operation atomicity scope is limited
+ to each individual object.</p>
+ </note>
+ </desc>
+ </func>
+
+ <func>
<name name="select_reverse" arity="1"/>
<fsummary>Continue matching objects in an ETS table.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/filelib.xml b/lib/stdlib/doc/src/filelib.xml
index 7c6380ce28..ad73fc254a 100644
--- a/lib/stdlib/doc/src/filelib.xml
+++ b/lib/stdlib/doc/src/filelib.xml
@@ -60,6 +60,12 @@
<datatype>
<name name="filename_all"/>
</datatype>
+ <datatype>
+ <name name="find_file_rule"/>
+ </datatype>
+ <datatype>
+ <name name="find_source_rule"/>
+ </datatype>
</datatypes>
<funcs>
@@ -226,7 +232,51 @@ filelib:wildcard("lib/**/*.{erl,hrl}")</code>
directory.</p>
</desc>
</func>
+
+ <func>
+ <name name="find_file" arity="2"/>
+ <name name="find_file" arity="3"/>
+ <fsummary>Find a file relative to a given directory.</fsummary>
+ <desc>
+ <p>Looks for a file of the given name by applying suffix rules to
+ the given directory path. For example, a rule <c>{"ebin", "src"}</c>
+ means that if the directory path ends with <c>"ebin"</c>, the
+ corresponding path ending in <c>"src"</c> should be searched.</p>
+ <p>If <c><anno>Rules</anno></c> is left out or is an empty list, the
+ default system rules are used. See also the Kernel application
+ parameter <seealso
+ marker="kernel:kernel_app#source_search_rules"><c>source_search_rules</c></seealso>.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="find_source" arity="1"/>
+ <fsummary>Find the source file for a given object file.</fsummary>
+ <desc>
+ <p>Equivalent to <c>find_source(Base, Dir)</c>, where <c>Dir</c> is
+ <c>filename:dirname(<anno>FilePath</anno>)</c> and <c>Base</c> is
+ <c>filename:basename(<anno>FilePath</anno>)</c>.</p>
+ </desc>
+ </func>
+ <func>
+ <name name="find_source" arity="2"/>
+ <name name="find_source" arity="3"/>
+ <fsummary>Find a source file relative to a given directory.</fsummary>
+ <desc>
+ <p>Applies file extension specific rules to find the source file for
+ a given object file relative to the object directory. For example,
+ for a file with the extension <c>.beam</c>, the default rule is to
+ look for a file with a corresponding extension <c>.erl</c> by
+ replacing the suffix <c>"ebin"</c> of the object directory path with
+ <c>"src"</c>.
+ The file search is done through <seealso
+ marker="#find_file/3"><c>find_file/3</c></seealso>. The directory of
+ the object file is always tried before any other directory specified
+ by the rules.</p>
+ <p>If <c><anno>Rules</anno></c> is left out or is an empty list, the
+ default system rules are used. See also the Kernel application
+ parameter <seealso
+ marker="kernel:kernel_app#source_search_rules"><c>source_search_rules</c></seealso>.</p>
+ </desc>
+ </func>
</funcs>
</erlref>
-
-
diff --git a/lib/stdlib/doc/src/filename.xml b/lib/stdlib/doc/src/filename.xml
index f20500709c..0ccca37a9d 100644
--- a/lib/stdlib/doc/src/filename.xml
+++ b/lib/stdlib/doc/src/filename.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1997</year><year>2017</year>
+ <year>1997</year><year>2016</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -356,10 +356,12 @@ true
<p>Finds the source filename and compiler options for a module.
The result can be fed to <seealso marker="compiler:compile#file/2">
<c>compile:file/2</c></seealso> to compile the file again.</p>
- <warning><p>It is not recommended to use this function. If possible,
- use the <seealso marker="beam_lib"><c>beam_lib(3)</c></seealso>
- module to extract the abstract code format from the Beam file and
- compile that instead.</p></warning>
+ <warning>
+ <p>This function is deprecated. Use <seealso marker="filelib#find_source/1">
+ <c>filelib:find_source/1</c></seealso> instead for finding source files.</p>
+ <p>If possible, use the <seealso marker="beam_lib"><c>beam_lib(3)</c></seealso>
+ module to extract the compiler options and the abstract code
+ format from the Beam file and compile that instead.</p></warning>
<p>Argument <c><anno>Beam</anno></c>, which can be a string or an atom,
specifies either the module name or the path to the source
code, with or without extension <c>".erl"</c>. In either
diff --git a/lib/stdlib/doc/src/gb_trees.xml b/lib/stdlib/doc/src/gb_trees.xml
index 790d4b8bf1..5cfff021c1 100644
--- a/lib/stdlib/doc/src/gb_trees.xml
+++ b/lib/stdlib/doc/src/gb_trees.xml
@@ -109,6 +109,28 @@
</func>
<func>
+ <name name="take" arity="2"/>
+ <fsummary>Returns a value and new tree without node with key <c>Key</c>.</fsummary>
+ <desc>
+ <p>Returns a value <c><anno>Value</anno></c> from node with key <c><anno>Key</anno></c>
+ and new <c><anno>Tree2</anno></c> without the node with this value.
+ Assumes that the node with key is present in the tree,
+ crashes otherwise.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="take_any" arity="2"/>
+ <fsummary>Returns a value and new tree without node with key <c>Key</c>.</fsummary>
+ <desc>
+ <p>Returns a value <c><anno>Value</anno></c> from node with key <c><anno>Key</anno></c>
+ and new <c><anno>Tree2</anno></c> without the node with this value.
+ Returns <c>error</c> if the node with the key is not present in
+ the tree.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="empty" arity="0"/>
<fsummary>Return an empty tree.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/gen_event.xml b/lib/stdlib/doc/src/gen_event.xml
index c24542002a..42e952fd46 100644
--- a/lib/stdlib/doc/src/gen_event.xml
+++ b/lib/stdlib/doc/src/gen_event.xml
@@ -350,13 +350,18 @@ gen_event:stop -----> Module:terminate/2
<func>
<name>start() -> Result</name>
- <name>start(EventMgrName) -> Result</name>
+ <name>start(EventMgrName | Options) -> Result</name>
+ <name>start(EventMgrName, Options) -> Result</name>
<fsummary>Create a stand-alone event manager process.</fsummary>
<type>
- <v>EventMgrName = {local,Name} | {global,GlobalName}
- | {via,Module,ViaName}</v>
+ <v>EventMgrName = {local,Name} | {global,GlobalName} | {via,Module,ViaName}</v>
<v>&nbsp;Name = atom()</v>
<v>&nbsp;GlobalName = ViaName = term()</v>
+ <v>Options = [Option]</v>
+ <v>&nbsp;Option = {debug,Dbgs} | {timeout,Time} | {spawn_opt,SOpts}</v>
+ <v>&nbsp;&nbsp;Dbgs = [Dbg]</v>
+ <v>&nbsp;&nbsp;&nbsp;Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v>
+ <v>&nbsp;&nbsp;SOpts = [term()]</v>
<v>Result = {ok,Pid} | {error,{already_started,Pid}}</v>
<v>&nbsp;Pid = pid()</v>
</type>
@@ -371,14 +376,19 @@ gen_event:stop -----> Module:terminate/2
<func>
<name>start_link() -> Result</name>
- <name>start_link(EventMgrName) -> Result</name>
+ <name>start_link(EventMgrName | Options) -> Result</name>
+ <name>start_link(EventMgrName, Options) -> Result</name>
<fsummary>Create a generic event manager process in a supervision tree.
</fsummary>
<type>
- <v>EventMgrName = {local,Name} | {global,GlobalName}
- | {via,Module,ViaName}</v>
+ <v>EventMgrName = {local,Name} | {global,GlobalName} | {via,Module,ViaName}</v>
<v>&nbsp;Name = atom()</v>
<v>&nbsp;GlobalName = ViaName = term()</v>
+ <v>Options = [Option]</v>
+ <v>&nbsp;Option = {debug,Dbgs} | {timeout,Time} | {spawn_opt,SOpts}</v>
+ <v>&nbsp;&nbsp;Dbgs = [Dbg]</v>
+ <v>&nbsp;&nbsp;&nbsp;Dbg = trace | log | statistics | {log_to_file,FileName} | {install,{Func,FuncState}}</v>
+ <v>&nbsp;&nbsp;SOpts = [term()]</v>
<v>Result = {ok,Pid} | {error,{already_started,Pid}}</v>
<v>&nbsp;Pid = pid()</v>
</type>
diff --git a/lib/stdlib/doc/src/gen_fsm.xml b/lib/stdlib/doc/src/gen_fsm.xml
index de06987d38..719ab2b558 100644
--- a/lib/stdlib/doc/src/gen_fsm.xml
+++ b/lib/stdlib/doc/src/gen_fsm.xml
@@ -534,11 +534,6 @@ gen_fsm:sync_send_all_state_event -----> Module:handle_sync_event/4
the function call fails.</p>
<p>Return value <c>Reply</c> is defined in the return value
of <c>Module:StateName/3</c>.</p>
- <note>
- <p>The ancient behavior of sometimes consuming the server
- exit message if the server died during the call while
- linked to the client was removed in Erlang 5.6/OTP R12B.</p>
- </note>
</desc>
</func>
</funcs>
diff --git a/lib/stdlib/doc/src/gen_server.xml b/lib/stdlib/doc/src/gen_server.xml
index 4a7dd60858..662076b5f0 100644
--- a/lib/stdlib/doc/src/gen_server.xml
+++ b/lib/stdlib/doc/src/gen_server.xml
@@ -162,11 +162,6 @@ gen_server:abcast -----> Module:handle_cast/2
of <c>Module:handle_call/3</c>.</p>
<p>The call can fail for many reasons, including time-out and the
called <c>gen_server</c> process dying before or during the call.</p>
- <note>
- <p>The ancient behavior of sometimes consuming the server
- exit message if the server died during the call while
- linked to the client was removed in Erlang 5.6/OTP R12B.</p>
- </note>
</desc>
</func>
diff --git a/lib/stdlib/doc/src/io_lib.xml b/lib/stdlib/doc/src/io_lib.xml
index 931e50f6f2..5ae400da62 100644
--- a/lib/stdlib/doc/src/io_lib.xml
+++ b/lib/stdlib/doc/src/io_lib.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2016</year>
+ <year>1996</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -147,7 +147,7 @@
format string (that is, <c>~ts</c> or <c>~tc</c>), the resulting list
can contain characters beyond the ISO Latin-1 character range
(that is, numbers &gt; 255). If so, the
- result is not an ordinary Erlang <c>string()</c>, but can well be
+ result is still an ordinary Erlang <c>string()</c>, and can well be
used in any context where Unicode data is allowed.</p>
</desc>
</func>
@@ -384,6 +384,16 @@
</func>
<func>
+ <name name="write_atom_as_latin1" arity="1"/>
+ <fsummary>Write an atom.</fsummary>
+ <desc>
+ <p>Returns the list of characters needed to print atom
+ <c><anno>Atom</anno></c>. Non-Latin-1 characters
+ are escaped.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="write_char" arity="1"/>
<fsummary>Write a character.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/math.xml b/lib/stdlib/doc/src/math.xml
index 1358ce5cbf..b4f096217a 100644
--- a/lib/stdlib/doc/src/math.xml
+++ b/lib/stdlib/doc/src/math.xml
@@ -57,9 +57,12 @@
<name name="atan" arity="1"/>
<name name="atan2" arity="2"/>
<name name="atanh" arity="1"/>
+ <name name="ceil" arity="1"/>
<name name="cos" arity="1"/>
<name name="cosh" arity="1"/>
<name name="exp" arity="1"/>
+ <name name="floor" arity="1"/>
+ <name name="fmod" arity="2"/>
<name name="log" arity="1"/>
<name name="log10" arity="1"/>
<name name="log2" arity="1"/>
diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml
index bb35224182..428d8a6e70 100644
--- a/lib/stdlib/doc/src/notes.xml
+++ b/lib/stdlib/doc/src/notes.xml
@@ -3267,7 +3267,7 @@
<p>
Two bugs in io:format for ~F.~Ps has been corrected. When
length(S) >= abs(F) > P, the precision P was incorrectly
- ignored. When F == P > lenght(S) the result was
+ ignored. When F == P > length(S) the result was
incorrectly left adjusted. Bug found by Ali Yakout who
also provided a fix.</p>
<p>
diff --git a/lib/stdlib/doc/src/orddict.xml b/lib/stdlib/doc/src/orddict.xml
index d048983c61..26bbf499c6 100644
--- a/lib/stdlib/doc/src/orddict.xml
+++ b/lib/stdlib/doc/src/orddict.xml
@@ -38,7 +38,7 @@
<p>This module provides a <c>Key</c>-<c>Value</c> dictionary.
An <c>orddict</c> is a representation of a dictionary, where a
list of pairs is used to store the keys and values. The list is
- ordered after the keys.</p>
+ ordered after the keys in the <em>Erlang term order</em>.</p>
<p>This module provides the same interface as the
<seealso marker="dict"><c>dict(3)</c></seealso> module
@@ -113,6 +113,15 @@
</func>
<func>
+ <name name="take" arity="2"/>
+ <fsummary>Return value and new dictionary without element with this value.</fsummary>
+ <desc>
+ <p>This function returns value from dictionary and new dictionary without this value.
+ Returns <c>error</c> if the key is not present in the dictionary.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="filter" arity="2"/>
<fsummary>Select elements that satisfy a predicate.</fsummary>
<desc>
diff --git a/lib/stdlib/doc/src/ordsets.xml b/lib/stdlib/doc/src/ordsets.xml
index 148281fcf7..7b590932e4 100644
--- a/lib/stdlib/doc/src/ordsets.xml
+++ b/lib/stdlib/doc/src/ordsets.xml
@@ -39,7 +39,8 @@
<p>Sets are collections of elements with no duplicate elements.
An <c>ordset</c> is a representation of a set, where an ordered
list is used to store the elements of the set. An ordered list
- is more efficient than an unordered list.</p>
+ is more efficient than an unordered list. Elements are ordered
+ according to the <em>Erlang term order</em>.</p>
<p>This module provides the same interface as the
<seealso marker="sets"><c>sets(3)</c></seealso> module
diff --git a/lib/stdlib/doc/src/proc_lib.xml b/lib/stdlib/doc/src/proc_lib.xml
index da03c39a26..e64b2ce18a 100644
--- a/lib/stdlib/doc/src/proc_lib.xml
+++ b/lib/stdlib/doc/src/proc_lib.xml
@@ -66,6 +66,12 @@
<seealso marker="sasl:error_logging">SASL Error Logging</seealso>
in the SASL User's Guide.</p>
+ <p>Unlike in "plain Erlang", <c>proc_lib</c> processes will not generate
+ <em>error reports</em>, which are written to the terminal by the
+ emulator and do not require SASL to be started. All exceptions are
+ converted to <em>exits</em> which are ignored by the default
+ <c>error_logger</c> handler.</p>
+
<p>The crash report contains the previously stored information, such
as ancestors and initial function, the termination reason, and
information about other processes that terminate as a result
diff --git a/lib/stdlib/doc/src/proplists.xml b/lib/stdlib/doc/src/proplists.xml
index fe6b8cc3bf..990d47b313 100644
--- a/lib/stdlib/doc/src/proplists.xml
+++ b/lib/stdlib/doc/src/proplists.xml
@@ -344,7 +344,7 @@ split([{c, 2}, {e, 1}, a, {c, 3, 4}, d, {b, 5}, b], [a, b, c])</code>
with <c>{K2, true}</c>, thus changing the name of the option and
simultaneously negating the value specified by
<seealso marker="#get_bool/2">
- <c>get_bool(Key, <anno>ListIn</anno></c></seealso>.
+ <c>get_bool(Key, <anno>ListIn</anno>)</c></seealso>.
If the same <c>K1</c> occurs more than once in
<c><anno>Negations</anno></c>, only the first occurrence is used.</p>
<p>For example, <c>substitute_negations([{no_foo, foo}], L)</c>
diff --git a/lib/stdlib/doc/src/rand.xml b/lib/stdlib/doc/src/rand.xml
index eb7870e367..2ddf3021ac 100644
--- a/lib/stdlib/doc/src/rand.xml
+++ b/lib/stdlib/doc/src/rand.xml
@@ -41,6 +41,11 @@
Sebastiano Vigna</url>. The normal distribution algorithm uses the
<url href="http://www.jstatsoft.org/v05/i08">Ziggurat Method by Marsaglia
and Tsang</url>.</p>
+ <p>For some algorithms, jump functions are provided for generating
+ non-overlapping sequences for parallel computations.
+ The jump functions perform calculations
+ equivalent to perform a large number of repeated calls
+ for calculating new states. </p>
<p>The following algorithms are provided:</p>
@@ -48,14 +53,17 @@
<tag><c>exsplus</c></tag>
<item>
<p>Xorshift116+, 58 bits precision and period of 2^116-1</p>
+ <p>Jump function: equivalent to 2^64 calls</p>
</item>
<tag><c>exs64</c></tag>
<item>
<p>Xorshift64*, 64 bits precision and a period of 2^64-1</p>
+ <p>Jump function: not available</p>
</item>
<tag><c>exs1024</c></tag>
<item>
<p>Xorshift1024*, 64 bits precision and a period of 2^1024-1</p>
+ <p>Jump function: equivalent to 2^512 calls</p>
</item>
</taglist>
@@ -112,27 +120,50 @@ S0 = rand:seed_s(exsplus),
{SND0, S2} = rand:normal_s(S1),</pre>
<note>
- <p>This random number generator is not cryptographically
- strong. If a strong cryptographic random number generator is
- needed, use one of functions in the
- <seealso marker="crypto:crypto"><c>crypto</c></seealso>
- module, for example, <seealso marker="crypto:crypto">
- <c>crypto:strong_rand_bytes/1</c></seealso>.</p>
+ <p>The builtin random number generator algorithms are not
+ cryptographically strong. If a cryptographically strong
+ random number generator is needed, use something like
+ <seealso marker="crypto:crypto#rand_seed-0"><c>crypto:rand_seed/0</c></seealso>.
+ </p>
</note>
</description>
<datatypes>
<datatype>
+ <name name="builtin_alg"/>
+ </datatype>
+ <datatype>
<name name="alg"/>
</datatype>
<datatype>
+ <name name="alg_handler"/>
+ </datatype>
+ <datatype>
+ <name name="alg_state"/>
+ </datatype>
+ <datatype>
+ <name name="exs64_state"/>
+ <desc><p>Algorithm specific internal state</p></desc>
+ </datatype>
+ <datatype>
+ <name name="exsplus_state"/>
+ <desc><p>Algorithm specific internal state</p></desc>
+ </datatype>
+ <datatype>
+ <name name="exs1024_state"/>
+ <desc><p>Algorithm specific internal state</p></desc>
+ </datatype>
+ <datatype>
<name name="state"/>
<desc><p>Algorithm-dependent state.</p></desc>
</datatype>
<datatype>
<name name="export_state"/>
- <desc><p>Algorithm-dependent state that can be printed or saved to
- file.</p></desc>
+ <desc>
+ <p>
+ Algorithm-dependent state that can be printed or saved to file.
+ </p>
+ </desc>
</datatype>
</datatypes>
@@ -156,6 +187,33 @@ S0 = rand:seed_s(exsplus),
</func>
<func>
+ <name name="jump" arity="0"/>
+ <fsummary>Return the seed after performing jump calculation
+ to the state in the process dictionary.</fsummary>
+ <desc><marker id="jump-0" />
+ <p>Returns the state
+ after performing jump calculation
+ to the state in the process dictionary.</p>
+ <p>This function generates a <c>not_implemented</c> error exception
+ when the jump function is not implemented for
+ the algorithm specified in the state
+ in the process dictionary.</p>
+ </desc>
+ </func>
+
+ <func>
+ <name name="jump" arity="1"/>
+ <fsummary>Return the seed after performing jump calculation.</fsummary>
+ <desc><marker id="jump-1" />
+ <p>Returns the state after performing jump calculation
+ to the given state. </p>
+ <p>This function generates a <c>not_implemented</c> error exception
+ when the jump function is not implemented for
+ the algorithm specified in the state.</p>
+ </desc>
+ </func>
+
+ <func>
<name name="normal" arity="0"/>
<fsummary>Return a standard normal distributed random float.</fsummary>
<desc>
@@ -180,8 +238,11 @@ S0 = rand:seed_s(exsplus),
<fsummary>Seed random number generator.</fsummary>
<desc>
<marker id="seed-1"/>
- <p>Seeds random number generation with the specifed algorithm and
- time-dependent data if <anno>AlgOrExpState</anno> is an algorithm.</p>
+ <p>
+ Seeds random number generation with the specifed algorithm and
+ time-dependent data if <c><anno>AlgOrStateOrExpState</anno></c>
+ is an algorithm.
+ </p>
<p>Otherwise recreates the exported seed in the process dictionary,
and returns the state. See also
<seealso marker="#export_seed-0"><c>export_seed/0</c></seealso>.</p>
@@ -201,8 +262,11 @@ S0 = rand:seed_s(exsplus),
<name name="seed_s" arity="1"/>
<fsummary>Seed random number generator.</fsummary>
<desc>
- <p>Seeds random number generation with the specifed algorithm and
- time-dependent data if <anno>AlgOrExpState</anno> is an algorithm.</p>
+ <p>
+ Seeds random number generation with the specifed algorithm and
+ time-dependent data if <c><anno>AlgOrStateOrExpState</anno></c>
+ is an algorithm.
+ </p>
<p>Otherwise recreates the exported seed and returns the state.
See also <seealso marker="#export_seed-0">
<c>export_seed/0</c></seealso>.</p>
@@ -223,7 +287,7 @@ S0 = rand:seed_s(exsplus),
<fsummary>Return a random float.</fsummary>
<desc><marker id="uniform-0"/>
<p>Returns a random float uniformly distributed in the value
- range <c>0.0 &lt; <anno>X</anno> &lt; 1.0</c> and
+ range <c>0.0 =&lt; <anno>X</anno> &lt; 1.0</c> and
updates the state in the process dictionary.</p>
</desc>
</func>
@@ -234,7 +298,7 @@ S0 = rand:seed_s(exsplus),
<desc><marker id="uniform-1"/>
<p>Returns, for a specified integer <c><anno>N</anno> >= 1</c>,
a random integer uniformly distributed in the value range
- <c>1 &lt;= <anno>X</anno> &lt;= <anno>N</anno></c> and
+ <c>1 =&lt; <anno>X</anno> =&lt; <anno>N</anno></c> and
updates the state in the process dictionary.</p>
</desc>
</func>
@@ -244,7 +308,7 @@ S0 = rand:seed_s(exsplus),
<fsummary>Return a random float.</fsummary>
<desc>
<p>Returns, for a specified state, random float
- uniformly distributed in the value range <c>0.0 &lt;
+ uniformly distributed in the value range <c>0.0 =&lt;
<anno>X</anno> &lt; 1.0</c> and a new state.</p>
</desc>
</func>
@@ -255,7 +319,7 @@ S0 = rand:seed_s(exsplus),
<desc>
<p>Returns, for a specified integer <c><anno>N</anno> >= 1</c>
and a state, a random integer uniformly distributed in the value
- range <c>1 &lt;= <anno>X</anno> &lt;= <anno>N</anno></c> and a
+ range <c>1 =&lt; <anno>X</anno> =&lt; <anno>N</anno></c> and a
new state.</p>
</desc>
</func>
diff --git a/lib/stdlib/doc/src/shell.xml b/lib/stdlib/doc/src/shell.xml
index d6e8036d4e..ab62c2fcdd 100644
--- a/lib/stdlib/doc/src/shell.xml
+++ b/lib/stdlib/doc/src/shell.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2016</year>
+ <year>1996</year><year>2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -165,12 +165,12 @@
<item>
<p>Evaluates <c>shell_default:help()</c>.</p>
</item>
- <tag><c>c(File)</c></tag>
+ <tag><c>c(Mod)</c></tag>
<item>
- <p>Evaluates <c>shell_default:c(File)</c>. This compiles
- and loads code in <c>File</c> and purges old versions of
- code, if necessary. Assumes that the file and module names
- are the same.</p>
+ <p>Evaluates <c>shell_default:c(Mod)</c>. This compiles and
+ loads the module <c>Mod</c> and purges old versions of the
+ code, if necessary. <c>Mod</c> can be either a module name or a
+ a source file path, with or without <c>.erl</c> extension.</p>
</item>
<tag><c>catch_exception(Bool)</c></tag>
<item>
@@ -854,7 +854,7 @@ q - quit erlang
<c>{history, N}</c>, where <c>N</c> is the current command number. The
function is to return a list of characters or an atom. This
constraint is because of the Erlang I/O protocol. Unicode characters
- beyond code point 255 are allowed in the list. Notice
+ beyond code point 255 are allowed in the list and the atom. Notice
that in restricted mode the call <c>Mod:Func(L)</c> must be
allowed or the default shell prompt function is called.</p>
</section>
diff --git a/lib/stdlib/doc/src/supervisor.xml b/lib/stdlib/doc/src/supervisor.xml
index 294196f746..bb06d3645e 100644
--- a/lib/stdlib/doc/src/supervisor.xml
+++ b/lib/stdlib/doc/src/supervisor.xml
@@ -133,8 +133,10 @@ sup_flags() = #{strategy => strategy(), % optional
map. Assuming the values <c>MaxR</c> for <c>intensity</c>
and <c>MaxT</c> for <c>period</c>, then, if more than <c>MaxR</c>
restarts occur within <c>MaxT</c> seconds, the supervisor
- terminates all child processes and then itself. <c>intensity</c>
- defaults to <c>1</c> and <c>period</c> defaults to <c>5</c>.</p>
+ terminates all child processes and then itself. The termination
+ reason for the supervisor itself in that case will be <c>shutdown</c>.
+ <c>intensity</c> defaults to <c>1</c> and <c>period</c> defaults to
+ <c>5</c>.</p>
<marker id="child_spec"/>
<p>The type definition of a child specification is as follows:</p>
diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml
index 0fed649660..45171f814d 100644
--- a/lib/stdlib/doc/src/sys.xml
+++ b/lib/stdlib/doc/src/sys.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>1996</year><year>2017</year>
+ <year>1996</year><year>2016</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
diff --git a/lib/stdlib/doc/src/unicode_usage.xml b/lib/stdlib/doc/src/unicode_usage.xml
index efc8b75075..a8ef8ff5c5 100644
--- a/lib/stdlib/doc/src/unicode_usage.xml
+++ b/lib/stdlib/doc/src/unicode_usage.xml
@@ -62,6 +62,10 @@
<item><p>In Erlang/OTP 17.0, the encoding default for Erlang
source files was switched to UTF-8.</p></item>
+
+ <item><p>In Erlang/OTP 20.0, atoms and function can contain
+ Unicode characters. Module names are still restricted to
+ the ISO-Latin-1 range.</p></item>
</list>
<p>This section outlines the current Unicode support and gives some
@@ -339,9 +343,10 @@
<tag>The language</tag>
<item>
<p>Having the source code in UTF-8 also allows you to write string
- literals containing Unicode characters with code points &gt; 255,
- although atoms, module names, and function names are restricted to
- the ISO Latin-1 range. Binary literals, where you use type
+ literals, function names, and atoms containing Unicode
+ characters with code points &gt; 255.
+ Module names are still restricted to the ISO Latin-1 range.
+ Binary literals, where you use type
<c>/utf8</c>, can also be expressed using Unicode characters &gt; 255.
Having module names using characters other than 7-bit ASCII can cause
trouble on operating systems with inconsistent file naming schemes,
@@ -432,15 +437,17 @@ external_charlist() = maybe_improper_list(char() | external_unicode_binary() |
<section>
<title>Basic Language Support</title>
- <p><marker id="unicode_in_erlang"/>As from Erlang/OTP R16, Erlang source
- files can be written in UTF-8 or bytewise (<c>latin1</c>) encoding. For
- information about how to state the encoding of an Erlang source file, see
- the <seealso marker="stdlib:epp#encoding"><c>epp(3)</c></seealso> module.
- Strings and comments can be written using Unicode, but functions must
- still be named using characters from the ISO Latin-1 character set, and
- atoms are restricted to the same ISO Latin-1 range. These restrictions in
- the language are of course independent of the encoding of the source
- file.</p>
+ <p><marker id="unicode_in_erlang"/>As from Erlang/OTP R16, Erlang
+ source files can be written in UTF-8 or bytewise (<c>latin1</c>)
+ encoding. For information about how to state the encoding of an
+ Erlang source file, see the <seealso
+ marker="stdlib:epp#encoding"><c>epp(3)</c></seealso> module. As
+ from Erlang/OTP R16, strings and comments can be written using
+ Unicode. As from Erlang/OTP 20, also atoms and functions can be
+ written using Unicode. Modules names must still be named using
+ characters from the ISO Latin-1 character set. (These
+ restrictions in the language are independent of the encoding of
+ the source file.)</p>
<section>
<title>Bit Syntax</title>
diff --git a/lib/stdlib/include/assert.hrl b/lib/stdlib/include/assert.hrl
index 9e5d4eb598..2fbaeba0b2 100644
--- a/lib/stdlib/include/assert.hrl
+++ b/lib/stdlib/include/assert.hrl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright (C) 2004-2016 Richard Carlsson, Mickaël Rémond
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -15,8 +10,7 @@
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
-%% %CopyrightEnd%
-%%
+%% Copyright (C) 2004-2016 Richard Carlsson, Mickaël Rémond
-ifndef(ASSERT_HRL).
-define(ASSERT_HRL, true).
@@ -56,7 +50,8 @@
%% It is not possible to nest assert macros.
-ifdef(NOASSERT).
--define(assert(BoolExpr),ok).
+-define(assert(BoolExpr), ok).
+-define(assert(BoolExpr, Comment), ok).
-else.
%% The assert macro is written the way it is so as not to cause warnings
%% for clauses that cannot match, even if the expression is a constant or
@@ -79,11 +74,31 @@
end
end)())
end).
+-define(assert(BoolExpr, Comment),
+ begin
+ ((fun () ->
+ __T = is_process_alive(self()), % cheap source of truth
+ case (BoolExpr) of
+ __T -> ok;
+ __V -> erlang:error({assert,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {comment, (Comment)},
+ {expression, (??BoolExpr)},
+ {expected, true},
+ case not __T of
+ __V -> {value, false};
+ _ -> {not_boolean, __V}
+ end]})
+ end
+ end)())
+ end).
-endif.
%% This is the inverse case of assert, for convenience.
-ifdef(NOASSERT).
-define(assertNot(BoolExpr),ok).
+-define(assertNot(BoolExpr, Comment), ok).
-else.
-define(assertNot(BoolExpr),
begin
@@ -103,12 +118,32 @@
end
end)())
end).
+-define(assertNot(BoolExpr, Comment),
+ begin
+ ((fun () ->
+ __F = not is_process_alive(self()),
+ case (BoolExpr) of
+ __F -> ok;
+ __V -> erlang:error({assert,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {comment, (Comment)},
+ {expression, (??BoolExpr)},
+ {expected, false},
+ case not __F of
+ __V -> {value, true};
+ _ -> {not_boolean, __V}
+ end]})
+ end
+ end)())
+ end).
-endif.
%% This is mostly a convenience which gives more detailed reports.
%% Note: Guard is a guarded pattern, and can not be used for value.
-ifdef(NOASSERT).
-define(assertMatch(Guard, Expr), ok).
+-define(assertMatch(Guard, Expr, Comment), ok).
-else.
-define(assertMatch(Guard, Expr),
begin
@@ -124,11 +159,27 @@
end
end)())
end).
+-define(assertMatch(Guard, Expr, Comment),
+ begin
+ ((fun () ->
+ case (Expr) of
+ Guard -> ok;
+ __V -> erlang:error({assertMatch,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {comment, (Comment)},
+ {expression, (??Expr)},
+ {pattern, (??Guard)},
+ {value, __V}]})
+ end
+ end)())
+ end).
-endif.
%% This is the inverse case of assertMatch, for convenience.
-ifdef(NOASSERT).
-define(assertNotMatch(Guard, Expr), ok).
+-define(assertNotMatch(Guard, Expr, Comment), ok).
-else.
-define(assertNotMatch(Guard, Expr),
begin
@@ -145,12 +196,29 @@
end
end)())
end).
+-define(assertNotMatch(Guard, Expr, Comment),
+ begin
+ ((fun () ->
+ __V = (Expr),
+ case __V of
+ Guard -> erlang:error({assertNotMatch,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {comment, (Comment)},
+ {expression, (??Expr)},
+ {pattern, (??Guard)},
+ {value, __V}]});
+ _ -> ok
+ end
+ end)())
+ end).
-endif.
%% This is a convenience macro which gives more detailed reports when
%% the expected LHS value is not a pattern, but a computed value
-ifdef(NOASSERT).
-define(assertEqual(Expect, Expr), ok).
+-define(assertEqual(Expect, Expr, Comment), ok).
-else.
-define(assertEqual(Expect, Expr),
begin
@@ -167,11 +235,28 @@
end
end)())
end).
+-define(assertEqual(Expect, Expr, Comment),
+ begin
+ ((fun () ->
+ __X = (Expect),
+ case (Expr) of
+ __X -> ok;
+ __V -> erlang:error({assertEqual,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {comment, (Comment)},
+ {expression, (??Expr)},
+ {expected, __X},
+ {value, __V}]})
+ end
+ end)())
+ end).
-endif.
%% This is the inverse case of assertEqual, for convenience.
-ifdef(NOASSERT).
-define(assertNotEqual(Unexpected, Expr), ok).
+-define(assertNotEqual(Unexpected, Expr, Comment), ok).
-else.
-define(assertNotEqual(Unexpected, Expr),
begin
@@ -187,12 +272,28 @@
end
end)())
end).
+-define(assertNotEqual(Unexpected, Expr, Comment),
+ begin
+ ((fun () ->
+ __X = (Unexpected),
+ case (Expr) of
+ __X -> erlang:error({assertNotEqual,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {comment, (Comment)},
+ {expression, (??Expr)},
+ {value, __X}]});
+ _ -> ok
+ end
+ end)())
+ end).
-endif.
%% Note: Class and Term are patterns, and can not be used for value.
%% Term can be a guarded pattern, but Class cannot.
-ifdef(NOASSERT).
-define(assertException(Class, Term, Expr), ok).
+-define(assertException(Class, Term, Expr, Comment), ok).
-else.
-define(assertException(Class, Term, Expr),
begin
@@ -222,17 +323,54 @@
end
end)())
end).
+-define(assertException(Class, Term, Expr, Comment),
+ begin
+ ((fun () ->
+ try (Expr) of
+ __V -> erlang:error({assertException,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {comment, (Comment)},
+ {expression, (??Expr)},
+ {pattern,
+ "{ "++(??Class)++" , "++(??Term)
+ ++" , [...] }"},
+ {unexpected_success, __V}]})
+ catch
+ Class:Term -> ok;
+ __C:__T ->
+ erlang:error({assertException,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {comment, (Comment)},
+ {expression, (??Expr)},
+ {pattern,
+ "{ "++(??Class)++" , "++(??Term)
+ ++" , [...] }"},
+ {unexpected_exception,
+ {__C, __T,
+ erlang:get_stacktrace()}}]})
+ end
+ end)())
+ end).
-endif.
-define(assertError(Term, Expr), ?assertException(error, Term, Expr)).
+-define(assertError(Term, Expr, Comment),
+ ?assertException(error, Term, Expr, Comment)).
-define(assertExit(Term, Expr), ?assertException(exit, Term, Expr)).
+-define(assertExit(Term, Expr, Comment),
+ ?assertException(exit, Term, Expr, Comment)).
-define(assertThrow(Term, Expr), ?assertException(throw, Term, Expr)).
+-define(assertThrow(Term, Expr, Comment),
+ ?assertException(throw, Term, Expr, Comment)).
%% This is the inverse case of assertException, for convenience.
%% Note: Class and Term are patterns, and can not be used for value.
%% Both Class and Term can be guarded patterns.
-ifdef(NOASSERT).
-define(assertNotException(Class, Term, Expr), ok).
+-define(assertNotException(Class, Term, Expr, Comment), ok).
-else.
-define(assertNotException(Class, Term, Expr),
begin
@@ -263,6 +401,36 @@
end
end)())
end).
+-define(assertNotException(Class, Term, Expr, Comment),
+ begin
+ ((fun () ->
+ try (Expr) of
+ _ -> ok
+ catch
+ __C:__T ->
+ case __C of
+ Class ->
+ case __T of
+ Term ->
+ erlang:error({assertNotException,
+ [{module, ?MODULE},
+ {line, ?LINE},
+ {comment, (Comment)},
+ {expression, (??Expr)},
+ {pattern,
+ "{ "++(??Class)++" , "
+ ++(??Term)++" , [...] }"},
+ {unexpected_exception,
+ {__C, __T,
+ erlang:get_stacktrace()
+ }}]});
+ _ -> ok
+ end;
+ _ -> ok
+ end
+ end
+ end)())
+ end).
-endif.
-endif. % ASSERT_HRL
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile
index 302834f9d0..ed3dfb342c 100644
--- a/lib/stdlib/src/Makefile
+++ b/lib/stdlib/src/Makefile
@@ -51,7 +51,6 @@ MODULES= \
dets_server \
dets_sup \
dets_utils \
- dets_v8 \
dets_v9 \
dict \
digraph \
@@ -131,7 +130,7 @@ HRL_FILES= \
../include/qlc.hrl \
../include/zip.hrl
-INTERNAL_HRL_FILES= dets.hrl
+INTERNAL_HRL_FILES= dets.hrl erl_tar.hrl
ERL_FILES= $(MODULES:%=%.erl)
@@ -225,12 +224,11 @@ $(EBIN)/beam_lib.beam: ../include/erl_compile.hrl ../../kernel/include/file.hrl
$(EBIN)/dets.beam: dets.hrl ../../kernel/include/file.hrl
$(EBIN)/dets_server.beam: dets.hrl
$(EBIN)/dets_utils.beam: dets.hrl
-$(EBIN)/dets_v8.beam: dets.hrl
$(EBIN)/dets_v9.beam: dets.hrl
$(EBIN)/erl_bits.beam: ../include/erl_bits.hrl
$(EBIN)/erl_compile.beam: ../include/erl_compile.hrl ../../kernel/include/file.hrl
$(EBIN)/erl_lint.beam: ../include/erl_bits.hrl
-$(EBIN)/erl_tar.beam: ../../kernel/include/file.hrl
+$(EBIN)/erl_tar.beam: ../../kernel/include/file.hrl erl_tar.hrl
$(EBIN)/file_sorter.beam: ../../kernel/include/file.hrl
$(EBIN)/filelib.beam: ../../kernel/include/file.hrl
$(EBIN)/filename.beam: ../../kernel/include/file.hrl
diff --git a/lib/stdlib/src/array.erl b/lib/stdlib/src/array.erl
index d5757dda5b..079b761463 100644
--- a/lib/stdlib/src/array.erl
+++ b/lib/stdlib/src/array.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -14,13 +9,12 @@
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
-%%
-%% %CopyrightEnd%
%%
-%% @author Richard Carlsson <[email protected]>
+%% Copyright (C) 2006-2016 Richard Carlsson and Ericsson AB
+%%
+%% @author Richard Carlsson <[email protected]>
%% @author Dan Gudmundsson <[email protected]>
-%% @version 1.0
-
+%%
%% @doc Functional, extendible arrays. Arrays can have fixed size, or
%% can grow automatically as needed. A default value is used for entries
%% that have not been explicitly set.
diff --git a/lib/stdlib/src/base64.erl b/lib/stdlib/src/base64.erl
index bf259e6691..0c8d817910 100644
--- a/lib/stdlib/src/base64.erl
+++ b/lib/stdlib/src/base64.erl
@@ -219,38 +219,49 @@ mime_decode_binary(Result, <<0:8,T/bits>>) ->
mime_decode_binary(Result, T);
mime_decode_binary(Result0, <<C:8,T/bits>>) ->
case element(C, ?DECODE_MAP) of
- Bits when is_integer(Bits) ->
- mime_decode_binary(<<Result0/bits,Bits:6>>, T);
- eq ->
- case tail_contains_more(T, false) of
- {<<>>, Eq} ->
- %% No more valid data.
- case bit_size(Result0) rem 8 of
- 0 ->
- %% '====' is not uncommon.
- Result0;
- 4 when Eq ->
- %% enforce at least one more '=' only ignoring illegals and spacing
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:4>> = Result0,
- Result;
- 2 ->
- %% remove 2 bits
- Split = byte_size(Result0) - 1,
- <<Result:Split/bytes,_:2>> = Result0,
- Result
- end;
- {More, _} ->
- %% More valid data, skip the eq as invalid
- mime_decode_binary(Result0, More)
- end;
- _ ->
- mime_decode_binary(Result0, T)
+ Bits when is_integer(Bits) ->
+ mime_decode_binary(<<Result0/bits,Bits:6>>, T);
+ eq ->
+ mime_decode_binary_after_eq(Result0, T, false);
+ _ ->
+ mime_decode_binary(Result0, T)
end;
-mime_decode_binary(Result, <<>>) ->
+mime_decode_binary(Result, _) ->
true = is_binary(Result),
Result.
+mime_decode_binary_after_eq(Result, <<0:8,T/bits>>, Eq) ->
+ mime_decode_binary_after_eq(Result, T, Eq);
+mime_decode_binary_after_eq(Result0, <<C:8,T/bits>>, Eq) ->
+ case element(C, ?DECODE_MAP) of
+ bad ->
+ mime_decode_binary_after_eq(Result0, T, Eq);
+ ws ->
+ mime_decode_binary_after_eq(Result0, T, Eq);
+ eq ->
+ mime_decode_binary_after_eq(Result0, T, true);
+ Bits when is_integer(Bits) ->
+ %% More valid data, skip the eq as invalid
+ mime_decode_binary(<<Result0/bits,Bits:6>>, T)
+ end;
+mime_decode_binary_after_eq(Result0, <<>>, Eq) ->
+ %% No more valid data.
+ case bit_size(Result0) rem 8 of
+ 0 ->
+ %% '====' is not uncommon.
+ Result0;
+ 4 when Eq ->
+ %% enforce at least one more '=' only ignoring illegals and spacing
+ Split = byte_size(Result0) - 1,
+ <<Result:Split/bytes,_:4>> = Result0,
+ Result;
+ 2 ->
+ %% remove 2 bits
+ Split = byte_size(Result0) - 1,
+ <<Result:Split/bytes,_:2>> = Result0,
+ Result
+ end.
+
decode([], A) -> A;
decode([$=,$=,C2,C1|Cs], A) ->
Bits2x6 = (b64d(C1) bsl 18) bor (b64d(C2) bsl 12),
diff --git a/lib/stdlib/src/beam_lib.erl b/lib/stdlib/src/beam_lib.erl
index d7ee5c1f5d..461acf03be 100644
--- a/lib/stdlib/src/beam_lib.erl
+++ b/lib/stdlib/src/beam_lib.erl
@@ -63,7 +63,7 @@
-type label() :: integer().
-type chunkid() :: nonempty_string(). % approximation of the strings below
-%% "Abst" | "Attr" | "CInf" | "ExpT" | "ImpT" | "LocT" | "Atom".
+%% "Abst" | "Attr" | "CInf" | "ExpT" | "ImpT" | "LocT" | "Atom" | "AtU8".
-type chunkname() :: 'abstract_code' | 'attributes' | 'compile_info'
| 'exports' | 'labeled_exports'
| 'imports' | 'indexed_imports'
@@ -520,6 +520,8 @@ read_chunk_data(File0, ChunkNames0, Options)
end.
%% -> {ok, list()} | throw(Error)
+check_chunks([atoms | Ids], File, IL, L) ->
+ check_chunks(Ids, File, ["Atom", "AtU8" | IL], [{atom_chunk, atoms} | L]);
check_chunks([ChunkName | Ids], File, IL, L) when is_atom(ChunkName) ->
ChunkId = chunk_name_to_id(ChunkName, File),
check_chunks(Ids, File, [ChunkId | IL], [{ChunkId, ChunkName} | L]);
@@ -537,6 +539,10 @@ scan_beam(File, What0, AllowMissingChunks) ->
case scan_beam1(File, What0) of
{missing, _FD, Mod, Data, What} when AllowMissingChunks ->
{ok, Mod, [{Id, missing_chunk} || Id <- What] ++ Data};
+ {missing, _FD, Mod, Data, ["Atom"]} ->
+ {ok, Mod, Data};
+ {missing, _FD, Mod, Data, ["AtU8"]} ->
+ {ok, Mod, Data};
{missing, FD, _Mod, _Data, What} ->
error({missing_chunk, filename(FD), hd(What)});
R ->
@@ -581,18 +587,23 @@ scan_beam(FD, Pos, What, Mod, Data) ->
error({invalid_beam_file, filename(FD), Pos})
end.
-get_data(Cs, "Atom"=Id, FD, Size, Pos, Pos2, _Mod, Data) ->
+get_atom_data(Cs, Id, FD, Size, Pos, Pos2, Data, Encoding) ->
NewCs = del_chunk(Id, Cs),
{NFD, Chunk} = get_chunk(Id, Pos, Size, FD),
<<_Num:32, Chunk2/binary>> = Chunk,
- {Module, _} = extract_atom(Chunk2),
+ {Module, _} = extract_atom(Chunk2, Encoding),
C = case Cs of
info ->
{Id, Pos, Size};
_ ->
{Id, Chunk}
end,
- scan_beam(NFD, Pos2, NewCs, Module, [C | Data]);
+ scan_beam(NFD, Pos2, NewCs, Module, [C | Data]).
+
+get_data(Cs, "Atom" = Id, FD, Size, Pos, Pos2, _Mod, Data) ->
+ get_atom_data(Cs, Id, FD, Size, Pos, Pos2, Data, latin1);
+get_data(Cs, "AtU8" = Id, FD, Size, Pos, Pos2, _Mod, Data) ->
+ get_atom_data(Cs, Id, FD, Size, Pos, Pos2, Data, utf8);
get_data(info, Id, FD, Size, Pos, Pos2, Mod, Data) ->
scan_beam(FD, Pos2, info, Mod, [{Id, Pos, Size} | Data]);
get_data(Chunks, Id, FD, Size, Pos, Pos2, Mod, Data) ->
@@ -624,6 +635,9 @@ get_chunk(Id, Pos, Size, FD) ->
{NFD, Chunk}
end.
+chunks_to_data([{atom_chunk, Name} | CNs], Chunks, File, Cs, Module, Atoms, L) ->
+ {NewAtoms, Ret} = chunk_to_data(Name, <<"">>, File, Cs, Atoms, Module),
+ chunks_to_data(CNs, Chunks, File, Cs, Module, NewAtoms, [Ret | L]);
chunks_to_data([{Id, Name} | CNs], Chunks, File, Cs, Module, Atoms, L) ->
{_Id, Chunk} = lists:keyfind(Id, 1, Chunks),
{NewAtoms, Ret} = chunk_to_data(Name, Chunk, File, Cs, Atoms, Module),
@@ -651,7 +665,7 @@ chunk_to_data(abstract_code=Id, Chunk, File, _Cs, AtomTable, Mod) ->
<<>> ->
{AtomTable, {Id, no_abstract_code}};
<<0:8,N:8,Mode0:N/binary,Rest/binary>> ->
- Mode = list_to_atom(binary_to_list(Mode0)),
+ Mode = binary_to_atom(Mode0, utf8),
decrypt_abst(Mode, Mod, File, Id, AtomTable, Rest);
_ ->
case catch binary_to_term(Chunk) of
@@ -683,7 +697,6 @@ chunk_to_data(ChunkId, Chunk, _File,
_Cs, AtomTable, _Module) when is_list(ChunkId) ->
{AtomTable, {ChunkId, Chunk}}. % Chunk is a binary
-chunk_name_to_id(atoms, _) -> "Atom";
chunk_name_to_id(indexed_imports, _) -> "ImpT";
chunk_name_to_id(imports, _) -> "ImpT";
chunk_name_to_id(exports, _) -> "ExpT";
@@ -738,25 +751,30 @@ atm(AT, N) ->
%% AT is updated.
ensure_atoms({empty, AT}, Cs) ->
- {_Id, AtomChunk} = lists:keyfind("Atom", 1, Cs),
- extract_atoms(AtomChunk, AT),
+ case lists:keyfind("AtU8", 1, Cs) of
+ {_Id, AtomChunk} when is_binary(AtomChunk) ->
+ extract_atoms(AtomChunk, AT, utf8);
+ _ ->
+ {_Id, AtomChunk} = lists:keyfind("Atom", 1, Cs),
+ extract_atoms(AtomChunk, AT, latin1)
+ end,
AT;
ensure_atoms(AT, _Cs) ->
AT.
-extract_atoms(<<_Num:32, B/binary>>, AT) ->
- extract_atoms(B, 1, AT).
+extract_atoms(<<_Num:32, B/binary>>, AT, Encoding) ->
+ extract_atoms(B, 1, AT, Encoding).
-extract_atoms(<<>>, _I, _AT) ->
+extract_atoms(<<>>, _I, _AT, _Encoding) ->
true;
-extract_atoms(B, I, AT) ->
- {Atom, B1} = extract_atom(B),
+extract_atoms(B, I, AT, Encoding) ->
+ {Atom, B1} = extract_atom(B, Encoding),
true = ets:insert(AT, {I, Atom}),
- extract_atoms(B1, I+1, AT).
+ extract_atoms(B1, I+1, AT, Encoding).
-extract_atom(<<Len, B/binary>>) ->
+extract_atom(<<Len, B/binary>>, Encoding) ->
<<SB:Len/binary, Tail/binary>> = B,
- {list_to_atom(binary_to_list(SB)), Tail}.
+ {binary_to_atom(SB, Encoding), Tail}.
%%% Utils.
@@ -856,12 +874,12 @@ significant_chunks() ->
%% for a module. They are listed in the order that they should be MD5:ed.
md5_chunks() ->
- ["Atom", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT"].
+ ["Atom", "AtU8", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT"].
%% The following chunks are mandatory in every Beam file.
mandatory_chunks() ->
- ["Code", "ExpT", "ImpT", "StrT", "Atom"].
+ ["Code", "ExpT", "ImpT", "StrT"].
%%% ====================================================================
%%% The rest of the file handles encrypted debug info.
diff --git a/lib/stdlib/src/binary.erl b/lib/stdlib/src/binary.erl
index ccc827ca2d..45666fbcb4 100644
--- a/lib/stdlib/src/binary.erl
+++ b/lib/stdlib/src/binary.erl
@@ -24,7 +24,7 @@
-export_type([cp/0]).
--opaque cp() :: {'am' | 'bm', binary()}.
+-opaque cp() :: {'am' | 'bm', reference()}.
-type part() :: {Start :: non_neg_integer(), Length :: integer()}.
%%% BIFs.
diff --git a/lib/stdlib/src/c.erl b/lib/stdlib/src/c.erl
index ad4915eabe..bb7b485490 100644
--- a/lib/stdlib/src/c.erl
+++ b/lib/stdlib/src/c.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -23,10 +23,10 @@
%% Avoid warning for local function error/2 clashing with autoimported BIF.
-compile({no_auto_import,[error/2]}).
--export([help/0,lc/1,c/1,c/2,nc/1,nc/2, nl/1,l/1,i/0,i/1,ni/0,
+-export([help/0,lc/1,c/1,c/2,c/3,nc/1,nc/2, nl/1,l/1,i/0,i/1,ni/0,
y/1, y/2,
lc_batch/0, lc_batch/1,
- i/3,pid/3,m/0,m/1,
+ i/3,pid/3,m/0,m/1,mm/0,lm/0,
bt/1, q/0,
erlangrc/0,erlangrc/1,bi/1, flush/0, regs/0, uptime/0,
nregs/0,pwd/0,ls/0,ls/1,cd/1,memory/1,memory/0, xm/1]).
@@ -35,7 +35,7 @@
-export([appcall/4]).
-import(lists, [reverse/1,flatten/1,sublist/3,sort/1,keysort/2,
- concat/1,max/1,min/1,foreach/2,foldl/3,flatmap/2]).
+ max/1,min/1,foreach/2,foldl/3,flatmap/2]).
-import(io, [format/1, format/2]).
%%-----------------------------------------------------------------------
@@ -44,7 +44,7 @@
help() ->
io:put_chars(<<"bt(Pid) -- stack backtrace for a process\n"
- "c(File) -- compile and load code in <File>\n"
+ "c(Mod) -- compile and load module or file <Mod>\n"
"cd(Dir) -- change working directory\n"
"flush() -- flush any messages sent to the shell\n"
"help() -- help info\n"
@@ -52,11 +52,13 @@ help() ->
"ni() -- information about the networked system\n"
"i(X,Y,Z) -- information about pid <X,Y,Z>\n"
"l(Module) -- load or reload module\n"
+ "lm() -- load all modified modules\n"
"lc([File]) -- compile a list of Erlang modules\n"
"ls() -- list files in the current directory\n"
"ls(Dir) -- list files in directory <Dir>\n"
"m() -- which modules are loaded\n"
"m(Mod) -- information about module <Mod>\n"
+ "mm() -- list all modified modules\n"
"memory() -- memory allocation information\n"
"memory(T) -- memory allocation information of type <T>\n"
"nc(File) -- compile and load code in <File> on all nodes\n"
@@ -70,32 +72,224 @@ help() ->
"xm(M) -- cross reference check a module\n"
"y(File) -- generate a Yecc parser\n">>).
-%% c(FileName)
-%% Compile a file/module.
-
--spec c(File) -> {'ok', Module} | 'error' when
- File :: file:name(),
- Module :: module().
+%% c(Module)
+%% Compile a module/file.
+
+-spec c(Module) -> {'ok', ModuleName} | 'error' when
+ Module :: file:name(),
+ ModuleName :: module().
+
+c(Module) -> c(Module, []).
+
+-spec c(Module, Options) -> {'ok', ModuleName} | 'error' when
+ Module :: file:name(),
+ Options :: [compile:option()] | compile:option(),
+ ModuleName :: module().
+
+c(Module, SingleOption) when not is_list(SingleOption) ->
+ c(Module, [SingleOption]);
+c(Module, Opts) when is_atom(Module) ->
+ %% either a module name or a source file name (possibly without
+ %% suffix); if such a source file exists, it is used to compile from
+ %% scratch with the given options, otherwise look for an object file
+ Suffix = case filename:extension(Module) of
+ "" -> src_suffix(Opts);
+ S -> S
+ end,
+ SrcFile = filename:rootname(Module, Suffix) ++ Suffix,
+ case filelib:is_file(SrcFile) of
+ true ->
+ compile_and_load(SrcFile, Opts);
+ false ->
+ c(Module, Opts, fun (_) -> true end)
+ end;
+c(Module, Opts) ->
+ %% we never interpret a string as a module name, only as a file
+ compile_and_load(Module, Opts).
-c(File) -> c(File, []).
+%% This tries to find an existing object file and use its compile_info and
+%% source path to recompile the module, overwriting the old object file.
+%% The Filter parameter is applied to the old compile options
--spec c(File, Options) -> {'ok', Module} | 'error' when
- File :: file:name(),
+-spec c(Module, Options, Filter) -> {'ok', ModuleName} | 'error' when
+ Module :: atom(),
Options :: [compile:option()],
- Module :: module().
+ Filter :: fun ((compile:option()) -> boolean()),
+ ModuleName :: module().
+
+c(Module, Options, Filter) when is_atom(Module) ->
+ case find_beam(Module) of
+ BeamFile when is_list(BeamFile) ->
+ c(Module, Options, Filter, BeamFile);
+ Error ->
+ {error, Error}
+ end.
+
+c(Module, Options, Filter, BeamFile) ->
+ case compile_info(Module, BeamFile) of
+ Info when is_list(Info) ->
+ case find_source(BeamFile, Info) of
+ SrcFile when is_list(SrcFile) ->
+ c(SrcFile, Options, Filter, BeamFile, Info);
+ Error ->
+ Error
+ end;
+ Error ->
+ Error
+ end.
-c(File, Opts0) when is_list(Opts0) ->
- Opts = [report_errors,report_warnings|Opts0],
+c(SrcFile, NewOpts, Filter, BeamFile, Info) ->
+ %% Filter old options; also remove options that will be replaced.
+ %% Write new beam over old beam unless other outdir is specified.
+ F = fun (Opt) -> not is_outdir_opt(Opt) andalso Filter(Opt) end,
+ Options = (NewOpts ++ [{outdir,filename:dirname(BeamFile)}]
+ ++ lists:filter(F, old_options(Info))),
+ format("Recompiling ~s\n", [SrcFile]),
+ safe_recompile(SrcFile, Options, BeamFile).
+
+old_options(Info) ->
+ case lists:keyfind(options, 1, Info) of
+ {options, Opts} -> Opts;
+ false -> []
+ end.
+
+%% prefer the source path in the compile info if the file exists,
+%% otherwise do a standard source search relative to the beam file
+find_source(BeamFile, Info) ->
+ case lists:keyfind(source, 1, Info) of
+ {source, SrcFile} ->
+ case filelib:is_file(SrcFile) of
+ true -> SrcFile;
+ false -> find_source(BeamFile)
+ end;
+ _ ->
+ find_source(BeamFile)
+ end.
+
+find_source(BeamFile) ->
+ case filelib:find_source(BeamFile) of
+ {ok, SrcFile} -> SrcFile;
+ _ -> {error, no_source}
+ end.
+
+%% find the beam file for a module, preferring the path reported by code:which()
+%% if it still exists, or otherwise by searching the code path
+find_beam(Module) when is_atom(Module) ->
+ case code:which(Module) of
+ Beam when is_list(Beam), Beam =/= "" ->
+ case erlang:module_loaded(Module) of
+ false ->
+ Beam; % code:which/1 found this in the path
+ true ->
+ case filelib:is_file(Beam) of
+ true -> Beam;
+ false -> find_beam_1(Module) % file moved?
+ end
+ end;
+ Other when Other =:= ""; Other =:= cover_compiled ->
+ %% module is loaded but not compiled directly from source
+ find_beam_1(Module);
+ Error ->
+ Error
+ end.
+
+find_beam_1(Module) ->
+ File = atom_to_list(Module) ++ code:objfile_extension(),
+ case code:where_is_file(File) of
+ Beam when is_list(Beam) ->
+ Beam;
+ Error ->
+ Error
+ end.
+
+%% get the compile_info for a module
+%% -will report the info for the module in memory, if loaded
+%% -will try to find and examine the beam file if not in memory
+%% -will not cause a module to become loaded by accident
+compile_info(Module, Beam) when is_atom(Module) ->
+ case erlang:module_loaded(Module) of
+ true ->
+ %% getting the compile info for a loaded module should normally
+ %% work, but return an empty info list if it fails
+ try erlang:get_module_info(Module, compile)
+ catch _:_ -> []
+ end;
+ false ->
+ case beam_lib:chunks(Beam, [compile_info]) of
+ {ok, {_Module, [{compile_info, Info}]}} ->
+ Info;
+ Error ->
+ Error
+ end
+ end.
+
+%% compile module, backing up any existing target file and restoring the
+%% old version if compilation fails (this should only be used when we have
+%% an old beam file that we want to preserve)
+safe_recompile(File, Options, BeamFile) ->
+ %% Note that it's possible that because of options such as 'to_asm',
+ %% the compiler might not actually write a new beam file at all
+ Backup = BeamFile ++ ".bak",
+ case file:rename(BeamFile, Backup) of
+ Status when Status =:= ok; Status =:= {error,enoent} ->
+ case compile_and_load(File, Options) of
+ {ok, _} = Result ->
+ _ = if Status =:= ok -> file:delete(Backup);
+ true -> ok
+ end,
+ Result;
+ Error ->
+ _ = if Status =:= ok -> file:rename(Backup, BeamFile);
+ true -> ok
+ end,
+ Error
+ end;
+ Error ->
+ Error
+ end.
+
+%% Compile the file and load the resulting object code (if any).
+%% Automatically ensures that there is an outdir option, by default the
+%% directory of File, and that a 'from' option will be passed to match the
+%% actual source suffix if needed (unless already specified).
+compile_and_load(File, Opts0) when is_list(Opts0) ->
+ Opts = [report_errors, report_warnings
+ | ensure_from(filename:extension(File),
+ ensure_outdir(filename:dirname(File), Opts0))],
case compile:file(File, Opts) of
{ok,Mod} -> %Listing file.
- machine_load(Mod, File, Opts);
+ purge_and_load(Mod, File, Opts);
{ok,Mod,_Ws} -> %Warnings maybe turned on.
- machine_load(Mod, File, Opts);
+ purge_and_load(Mod, File, Opts);
Other -> %Errors go here
Other
end;
-c(File, Opt) ->
- c(File, [Opt]).
+compile_and_load(File, Opt) ->
+ compile_and_load(File, [Opt]).
+
+ensure_from(Suffix, Opts0) ->
+ case lists:partition(fun is_from_opt/1, Opts0++from_opt(Suffix)) of
+ {[Opt|_], Opts} -> [Opt | Opts];
+ {[], Opts} -> Opts
+ end.
+
+ensure_outdir(Dir, Opts0) ->
+ {[Opt|_], Opts} = lists:partition(fun is_outdir_opt/1,
+ Opts0++[{outdir,Dir}]),
+ [Opt | Opts].
+
+is_outdir_opt({outdir, _}) -> true;
+is_outdir_opt(_) -> false.
+
+is_from_opt(from_core) -> true;
+is_from_opt(from_asm) -> true;
+is_from_opt(from_beam) -> true;
+is_from_opt(_) -> false.
+
+from_opt(".core") -> [from_core];
+from_opt(".S") -> [from_asm];
+from_opt(".beam") -> [from_beam];
+from_opt(_) -> [].
%%% Obtain the 'outdir' option from the argument. Return "." if no
%%% such option was given.
@@ -111,18 +305,29 @@ outdir([Opt|Rest]) ->
outdir(Rest)
end.
+%% mimic how suffix is selected in compile:file().
+src_suffix([from_core|_]) -> ".core";
+src_suffix([from_asm|_]) -> ".S";
+src_suffix([from_beam|_]) -> ".beam";
+src_suffix([_|Opts]) -> src_suffix(Opts);
+src_suffix([]) -> ".erl".
+
%%% We have compiled File with options Opts. Find out where the
-%%% output file went to, and load it.
-machine_load(Mod, File, Opts) ->
+%%% output file went and load it, purging any old version.
+purge_and_load(Mod, File, Opts) ->
Dir = outdir(Opts),
- File2 = filename:join(Dir, filename:basename(File, ".erl")),
+ Base = filename:basename(File, src_suffix(Opts)),
+ OutFile = filename:join(Dir, Base),
case compile:output_generated(Opts) of
true ->
- Base = atom_to_list(Mod),
- case filename:basename(File, ".erl") of
+ case atom_to_list(Mod) of
Base ->
code:purge(Mod),
- check_load(code:load_abs(File2,Mod), Mod);
+ %% Note that load_abs() adds the object file suffix
+ case code:load_abs(OutFile, Mod) of
+ {error, _R}=Error -> Error;
+ _ -> {ok, Mod}
+ end;
_OtherMod ->
format("** Module name '~p' does not match file name '~tp' **~n",
[Mod,File]),
@@ -133,13 +338,6 @@ machine_load(Mod, File, Opts) ->
ok
end.
-%%% This function previously warned if the loaded module was
-%%% loaded from some other place than current directory.
-%%% Now, loading from other than current directory is supposed to work.
-%%% so this function does nothing special.
-check_load({error, _R} = Error, _) -> Error;
-check_load(_, Mod) -> {ok, Mod}.
-
%% Compile a list of modules
%% enables the nice unix shell cmd
%% erl -s c lc f1 f2 f3 @d c1=v1 @c2 @i IDir @o ODir -s erlang halt
@@ -202,7 +400,7 @@ split_def([], Res) -> {d, list_to_atom(reverse(Res))}.
make_term(Str) ->
case erl_scan:string(Str) of
{ok, Tokens, _} ->
- case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of
+ case erl_parse:parse_term(Tokens ++ [{dot, erl_anno:new(1)}]) of
{ok, Term} -> Term;
{error, {_,_,Reason}} ->
io:format("~ts: ~ts~n", [Reason, Str]),
@@ -459,6 +657,16 @@ m() ->
mformat(A1, A2) ->
format("~-20s ~ts\n", [A1,A2]).
+-spec mm() -> [module()].
+
+mm() ->
+ code:modified_modules().
+
+-spec lm() -> [code:load_ret()].
+
+lm() ->
+ [l(M) || M <- mm()].
+
%% erlangrc(Home)
%% Try to run a ".erlang" file, first in the current directory
%% else in home directory.
diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl
index bf22949870..e81383775b 100644
--- a/lib/stdlib/src/dets.erl
+++ b/lib/stdlib/src/dets.erl
@@ -105,9 +105,6 @@
%%% the file with the split indicator, size etc is held in ram by the
%%% server at all times.
%%%
-%%% The parts specific for formats up to and including 8(c) are
-%%% implemented in dets_v8.erl, parts specific for format 9 are
-%%% implemented in dets_v9.erl.
%% The method of hashing is the so called linear hashing algorithm
%% with segments.
@@ -140,28 +137,33 @@
%%% written, and a repair is forced next time the file is opened.
-record(dets_cont, {
- what, % object | bindings | select | bchunk
- no_objs, % requested number of objects: default | integer() > 0
- bin, % small chunk not consumed, or 'eof' at end-of-file
- alloc, % the part of the file not yet scanned, mostly a binary
- tab,
- proc, % the pid of the Dets process
- match_program % true | compiled_match_spec() | undefined
+ what :: 'undefined' | 'bchunk' | 'bindings' | 'object' | 'select',
+ no_objs :: 'default' | pos_integer(), % requested number of objects
+ bin :: 'eof' | binary(), % small chunk not consumed,
+ % or 'eof' at end-of-file
+ alloc :: binary() % the part of the file not yet scanned
+ | {From :: non_neg_integer(),
+ To :: non_neg_integer,
+ binary()},
+ tab :: tab_name(),
+ proc :: 'undefined' | pid(), % the pid of the Dets process
+ match_program :: 'true'
+ | 'undefined'
+ | {'match_spec', ets:comp_match_spec()}
}).
-record(open_args, {
- file,
- type,
- keypos,
- repair,
- min_no_slots,
- max_no_slots,
- ram_file,
- delayed_write,
- auto_save,
- access,
- version,
- debug
+ file :: list(),
+ type :: type(),
+ keypos :: keypos(),
+ repair :: 'force' | boolean(),
+ min_no_slots :: no_slots(),
+ max_no_slots :: no_slots(),
+ ram_file :: boolean(),
+ delayed_write :: cache_parms(),
+ auto_save :: auto_save(),
+ access :: access(),
+ debug :: boolean()
}).
-define(PATTERN_TO_OBJECT_MATCH_SPEC(Pat), [{Pat,[],['$_']}]).
@@ -177,20 +179,13 @@
%%-define(PROFILE(C), C).
-define(PROFILE(C), void).
--type access() :: 'read' | 'read_write'.
--type auto_save() :: 'infinity' | non_neg_integer().
-opaque bindings_cont() :: #dets_cont{}.
-opaque cont() :: #dets_cont{}.
--type keypos() :: pos_integer().
-type match_spec() :: ets:match_spec().
-type object() :: tuple().
--type no_slots() :: non_neg_integer() | 'default'.
-opaque object_cont() :: #dets_cont{}.
-type pattern() :: atom() | tuple().
-opaque select_cont() :: #dets_cont{}.
--type tab_name() :: term().
--type type() :: 'bag' | 'duplicate_bag' | 'set'.
--type version() :: 8 | 9 | 'default'.
%%% Some further debug code was added in R12B-1 (stdlib-1.15.1):
%%% - there is a new open_file() option 'debug';
@@ -273,19 +268,20 @@ delete_all_objects(Tab) ->
delete_object(Tab, O) ->
badarg(treq(Tab, {delete_object, [O]}), [Tab, O]).
+%% Backwards compatibility.
+fsck(Fname, _Version) ->
+ fsck(Fname).
+
%% Given a filename, fsck it. Debug.
fsck(Fname) ->
- fsck(Fname, default).
-
-fsck(Fname, Version) ->
catch begin
{ok, Fd, FH} = read_file_header(Fname, read, false),
?DEBUGF("FileHeader: ~p~n", [FH]),
- case (FH#fileheader.mod):check_file_header(FH, Fd) of
+ case dets_v9:check_file_header(FH, Fd) of
{error, not_closed} ->
- fsck(Fd, make_ref(), Fname, FH, default, default, Version);
- {ok, _Head, _Extra} ->
- fsck(Fd, make_ref(), Fname, FH, default, default, Version);
+ fsck(Fd, make_ref(), Fname, FH, default, default);
+ {ok, _Head} ->
+ fsck(Fd, make_ref(), Fname, FH, default, default);
Error ->
Error
end
@@ -372,7 +368,7 @@ info(Tab) ->
Item :: 'access' | 'auto_save' | 'bchunk_format'
| 'hash' | 'file_size' | 'filename' | 'keypos' | 'memory'
| 'no_keys' | 'no_objects' | 'no_slots' | 'owner' | 'ram_file'
- | 'safe_fixed' | 'safe_fixed_monotonic_time' | 'size' | 'type' | 'version',
+ | 'safe_fixed' | 'safe_fixed_monotonic_time' | 'size' | 'type',
Value :: term().
info(Tab, owner) ->
@@ -640,8 +636,7 @@ open_file(File) ->
| {'keypos', keypos()}
| {'ram_file', boolean()}
| {'repair', boolean() | 'force'}
- | {'type', type()}
- | {'version', version()},
+ | {'type', type()},
Reason :: term().
open_file(Tab, Args) when is_list(Args) ->
@@ -674,13 +669,13 @@ remove_user(Pid, From) ->
Continuation2 :: select_cont(),
MatchSpec :: match_spec().
-repair_continuation(#dets_cont{match_program = B}=Cont, MS)
- when is_binary(B) ->
+repair_continuation(#dets_cont{match_program = {match_spec, B}}=Cont, MS) ->
case ets:is_compiled_ms(B) of
true ->
Cont;
false ->
- Cont#dets_cont{match_program = ets:match_spec_compile(MS)}
+ Cont#dets_cont{match_program = {match_spec,
+ ets:match_spec_compile(MS)}}
end;
repair_continuation(#dets_cont{}=Cont, _MS) ->
Cont;
@@ -999,7 +994,9 @@ init_chunk_match(Tab, Pat, What, N, Safe) when is_integer(N), N >= 0;
case req(Proc, {match, MP, Spec, N, Safe}) of
{done, L} ->
{L, #dets_cont{tab = Tab, proc = Proc,
- what = What, bin = eof}};
+ what = What, bin = eof,
+ no_objs = default,
+ alloc = <<>>}};
{cont, State} ->
chunk_match(State#dets_cont{what = What,
tab = Tab,
@@ -1041,17 +1038,17 @@ chunk_match(#dets_cont{proc = Proc}=State, Safe) ->
do_foldl_bins(Bins, true) ->
foldl_bins(Bins, []);
-do_foldl_bins(Bins, MP) ->
+do_foldl_bins(Bins, {match_spec, MP}) ->
foldl_bins(Bins, MP, []).
foldl_bins([], Terms) ->
- %% Preserve time order (version 9).
+ %% Preserve time order.
Terms;
foldl_bins([Bin | Bins], Terms) ->
foldl_bins(Bins, [binary_to_term(Bin) | Terms]).
foldl_bins([], _MP, Terms) ->
- %% Preserve time order (version 9).
+ %% Preserve time order.
Terms;
foldl_bins([Bin | Bins], MP, Terms) ->
Term = binary_to_term(Bin),
@@ -1066,11 +1063,8 @@ foldl_bins([Bin | Bins], MP, Terms) ->
compile_match_spec(select, ?PATTERN_TO_OBJECT_MATCH_SPEC('_') = Spec) ->
{Spec, true};
compile_match_spec(select, Spec) ->
- case catch ets:match_spec_compile(Spec) of
- X when is_binary(X) ->
- {Spec, X};
- _ ->
- badarg
+ try {Spec, {match_spec, ets:match_spec_compile(Spec)}}
+ catch error:_ -> badarg
end;
compile_match_spec(object, Pat) ->
compile_match_spec(select, ?PATTERN_TO_OBJECT_MATCH_SPEC(Pat));
@@ -1091,16 +1085,10 @@ defaults(Tab, Args) ->
delayed_write = ?DEFAULT_CACHE,
auto_save = timer:minutes(?DEFAULT_AUTOSAVE),
access = read_write,
- version = default,
debug = false},
Fun = fun repl/2,
Defaults = lists:foldl(Fun, Defaults0, Args),
- case Defaults#open_args.version of
- 8 ->
- Defaults#open_args{max_no_slots = default};
- _ ->
- is_comp_min_max(Defaults)
- end.
+ is_comp_min_max(Defaults).
to_list(T) when is_atom(T) -> atom_to_list(T);
to_list(T) -> T.
@@ -1131,7 +1119,6 @@ repl({file, File}, Defs) when is_atom(File) ->
repl({keypos, P}, Defs) when is_integer(P), P > 0 ->
Defs#open_args{keypos =P};
repl({max_no_slots, I}, Defs) ->
- %% Version 9 only.
MaxSlots = is_max_no_slots(I),
Defs#open_args{max_no_slots = MaxSlots};
repl({min_no_slots, I}, Defs) ->
@@ -1147,8 +1134,9 @@ repl({type, T}, Defs) ->
mem(T, [set, bag, duplicate_bag]),
Defs#open_args{type =T};
repl({version, Version}, Defs) ->
- V = is_version(Version),
- Defs#open_args{version = V};
+ %% Backwards compatibility.
+ is_version(Version),
+ Defs;
repl({debug, Bool}, Defs) ->
%% Not documented.
mem(Bool, [true, false]),
@@ -1164,16 +1152,15 @@ is_max_no_slots(default) -> default;
is_max_no_slots(I) when is_integer(I), I > 0, I < 1 bsl 31 -> I.
is_comp_min_max(Defs) ->
- #open_args{max_no_slots = Max, min_no_slots = Min, version = V} = Defs,
- case V of
- _ when Min =:= default -> Defs;
- _ when Max =:= default -> Defs;
- _ -> true = Min =< Max, Defs
+ #open_args{max_no_slots = Max, min_no_slots = Min} = Defs,
+ if
+ Min =:= default -> Defs;
+ Max =:= default -> Defs;
+ true -> true = Min =< Max, Defs
end.
-is_version(default) -> default;
-is_version(8) -> 8;
-is_version(9) -> 9.
+is_version(default) -> true;
+is_version(9) -> true.
mem(X, L) ->
case lists:member(X, L) of
@@ -1288,17 +1275,23 @@ badarg_exit(Reply, _A) ->
init(Parent, Server) ->
process_flag(trap_exit, true),
- open_file_loop(#head{parent = Parent, server = Server}).
-
-open_file_loop(Head) ->
%% The Dets server pretends the file is open before
%% internal_open() has been called, which means that unless the
%% internal_open message is applied first, other processes can
%% find the pid by calling dets_server:get_pid() and do things
%% before Head has been initialized properly.
receive
- ?DETS_CALL(From, {internal_open, _Ref, _Args}=Op) ->
- do_apply_op(Op, From, Head, 0)
+ ?DETS_CALL(From, {internal_open, Ref, Args}=Op) ->
+ try do_internal_open(Parent, Server, From, Ref, Args) of
+ Head ->
+ open_file_loop(Head, 0)
+ catch
+ exit:normal ->
+ exit(normal);
+ _:Bad ->
+ bug_found(no_name, Op, Bad, From),
+ exit(Bad) % give up
+ end
end.
open_file_loop(Head, N) when element(1, Head#head.update_mode) =:= error ->
@@ -1379,28 +1372,7 @@ do_apply_op(Op, From, Head, N) ->
exit:normal ->
exit(normal);
_:Bad ->
- Name = Head#head.name,
- case dets_utils:debug_mode() of
- true ->
- %% If stream_op/5 found more requests, this is not
- %% the last operation.
- error_logger:format
- ("** dets: Bug was found when accessing table ~w,~n"
- "** dets: operation was ~p and reply was ~w.~n"
- "** dets: Stacktrace: ~w~n",
- [Name, Op, Bad, erlang:get_stacktrace()]);
- false ->
- error_logger:format
- ("** dets: Bug was found when accessing table ~w~n",
- [Name])
- end,
- if
- From =/= self() ->
- From ! {self(), {error, {dets_bug, Name, Op, Bad}}},
- ok;
- true -> % auto_save | may_grow | {delayed_write, _}
- ok
- end,
+ bug_found(Head#head.name, Op, Bad, From),
open_file_loop(Head, N)
end.
@@ -1408,10 +1380,7 @@ apply_op(Op, From, Head, N) ->
case Op of
{add_user, Tab, OpenArgs}->
#open_args{file = Fname, type = Type, keypos = Keypos,
- ram_file = Ram, access = Access,
- version = Version} = OpenArgs,
- VersionOK = (Version =:= default) or
- (Head#head.version =:= Version),
+ ram_file = Ram, access = Access} = OpenArgs,
%% min_no_slots and max_no_slots are not tested
Res = if
Tab =:= Head#head.name,
@@ -1419,7 +1388,6 @@ apply_op(Op, From, Head, N) ->
Head#head.type =:= Type,
Head#head.ram_file =:= Ram,
Head#head.access =:= Access,
- VersionOK,
Fname =:= Head#head.filename ->
ok;
true ->
@@ -1475,21 +1443,14 @@ apply_op(Op, From, Head, N) ->
From ! {self(), Res},
ok;
{internal_open, Ref, Args} ->
- ?PROFILE(ep:do()),
- case do_open_file(Args, Head#head.parent, Head#head.server,Ref) of
- {ok, H2} ->
- From ! {self(), ok},
- H2;
- Error ->
- From ! {self(), Error},
- exit(normal)
- end;
+ do_internal_open(Head#head.parent, Head#head.server, From,
+ Ref, Args);
may_grow when Head#head.update_mode =/= saved ->
if
Head#head.update_mode =:= dirty ->
%% Won't grow more if the table is full.
{H2, _Res} =
- (Head#head.mod):may_grow(Head, 0, many_times),
+ dets_v9:may_grow(Head, 0, many_times),
{N + 1, H2};
true ->
ok
@@ -1519,21 +1480,10 @@ apply_op(Op, From, Head, N) ->
From ! {self(), Res},
erlang:garbage_collect(),
{0, H2};
- {delete_key, Keys} when Head#head.update_mode =:= dirty ->
- if
- Head#head.version =:= 8 ->
- {H2, Res} = fdelete_key(Head, Keys),
- From ! {self(), Res},
- {N + 1, H2};
- true ->
- stream_op(Op, From, [], Head, N)
- end;
+ {delete_key, _Keys} when Head#head.update_mode =:= dirty ->
+ stream_op(Op, From, [], Head, N);
{delete_object, Objs} when Head#head.update_mode =:= dirty ->
case check_objects(Objs, Head#head.keypos) of
- true when Head#head.version =:= 8 ->
- {H2, Res} = fdelete_object(Head, Objs),
- From ! {self(), Res},
- {N + 1, H2};
true ->
stream_op(Op, From, [], Head, N);
false ->
@@ -1551,10 +1501,6 @@ apply_op(Op, From, Head, N) ->
H2;
{insert, Objs} when Head#head.update_mode =:= dirty ->
case check_objects(Objs, Head#head.keypos) of
- true when Head#head.version =:= 8 ->
- {H2, Res} = finsert(Head, Objs),
- From ! {self(), Res},
- {N + 1, H2};
true ->
stream_op(Op, From, [], Head, N);
false ->
@@ -1565,10 +1511,6 @@ apply_op(Op, From, Head, N) ->
{H2, Res} = finsert_new(Head, Objs),
From ! {self(), Res},
{N + 1, H2};
- {lookup_keys, Keys} when Head#head.version =:= 8 ->
- {H2, Res} = flookup_keys(Head, Keys),
- From ! {self(), Res},
- H2;
{lookup_keys, _Keys} ->
stream_op(Op, From, [], Head, N);
{match_init, State, Safe} ->
@@ -1584,10 +1526,6 @@ apply_op(Op, From, Head, N) ->
{H2, Res} = fmatch(Head, MP, Spec, NObjs, Safe, From),
From ! {self(), Res},
H2;
- {member, Key} when Head#head.version =:= 8 ->
- {H2, Res} = fmember(Head, Key),
- From ! {self(), Res},
- H2;
{member, _Key} = Op ->
stream_op(Op, From, [], Head, N);
{next, Key} ->
@@ -1628,7 +1566,7 @@ apply_op(Op, From, Head, N) ->
apply_op(WriteOp, From, H2, 0);
WriteOp when Head#head.access =:= read_write,
Head#head.update_mode =:= saved ->
- case catch (Head#head.mod):mark_dirty(Head) of
+ case catch dets_v9:mark_dirty(Head) of
ok ->
start_auto_save_timer(Head),
H2 = Head#head{update_mode = dirty},
@@ -1643,6 +1581,40 @@ apply_op(Op, From, Head, N) ->
ok
end.
+bug_found(Name, Op, Bad, From) ->
+ case dets_utils:debug_mode() of
+ true ->
+ %% If stream_op/5 found more requests, this is not
+ %% the last operation.
+ error_logger:format
+ ("** dets: Bug was found when accessing table ~w,~n"
+ "** dets: operation was ~p and reply was ~w.~n"
+ "** dets: Stacktrace: ~w~n",
+ [Name, Op, Bad, erlang:get_stacktrace()]);
+ false ->
+ error_logger:format
+ ("** dets: Bug was found when accessing table ~w~n",
+ [Name])
+ end,
+ if
+ From =/= self() ->
+ From ! {self(), {error, {dets_bug, Name, Op, Bad}}},
+ ok;
+ true -> % auto_save | may_grow | {delayed_write, _}
+ ok
+ end.
+
+do_internal_open(Parent, Server, From, Ref, Args) ->
+ ?PROFILE(ep:do()),
+ case do_open_file(Args, Parent, Server, Ref) of
+ {ok, Head} ->
+ From ! {self(), ok},
+ Head;
+ Error ->
+ From ! {self(), Error},
+ exit(normal)
+ end.
+
start_auto_save_timer(Head) when Head#head.auto_save =:= infinity ->
ok;
start_auto_save_timer(Head) ->
@@ -1650,7 +1622,7 @@ start_auto_save_timer(Head) ->
_Ref = erlang:send_after(Millis, self(), ?DETS_CALL(self(), auto_save)),
ok.
-%% Version 9: Peek the message queue and try to evaluate several
+%% Peek the message queue and try to evaluate several
%% lookup requests in parallel. Evalute delete_object, delete and
%% insert as well.
stream_op(Op, Pid, Pids, Head, N) ->
@@ -1760,7 +1732,7 @@ lookup_reply(P, O) ->
%% Callback functions for system messages handling.
%%-----------------------------------------------------------------
system_continue(_Parent, _, Head) ->
- open_file_loop(Head).
+ open_file_loop(Head, 0).
system_terminate(Reason, _Parent, _, Head) ->
_NewHead = do_stop(Head),
@@ -1793,7 +1765,8 @@ read_file_header(FileName, Access, RamFile) ->
dets_utils:pread_close(Fd, FileName, ?FILE_FORMAT_VERSION_POS, 4),
if
Version =< 8 ->
- dets_v8:read_file_header(Fd, FileName);
+ _ = file:close(Fd),
+ throw({error, {format_8_no_longer_supported, FileName}});
Version =:= 9 ->
dets_v9:read_file_header(Fd, FileName);
true ->
@@ -1820,7 +1793,7 @@ perform_save(Head, DoSync) when Head#head.update_mode =:= dirty;
Head#head.update_mode =:= new_dirty ->
case catch begin
{Head1, []} = write_cache(Head),
- {Head2, ok} = (Head1#head.mod):do_perform_save(Head1),
+ {Head2, ok} = dets_v9:do_perform_save(Head1),
ok = ensure_written(Head2, DoSync),
{Head2#head{update_mode = saved}, ok}
end of
@@ -1853,7 +1826,7 @@ ensure_written(Head, false) when not Head#head.ram_file ->
do_bchunk_init(Head, Tab) ->
case catch write_cache(Head) of
{H2, []} ->
- case (H2#head.mod):table_parameters(H2) of
+ case dets_v9:table_parameters(H2) of
undefined ->
{H2, {error, old_version}};
Parms ->
@@ -1862,9 +1835,9 @@ do_bchunk_init(Head, Tab) ->
L =:= <<>> -> eof;
true -> <<>>
end,
- C0 = #dets_cont{no_objs = default, bin = Bin, alloc = L},
BinParms = term_to_binary(Parms),
- {H2, {C0#dets_cont{tab = Tab, proc = self(),what = bchunk},
+ {H2, {#dets_cont{no_objs = default, bin = Bin, alloc = L,
+ tab = Tab, proc = self(),what = bchunk},
[BinParms]}}
end;
{NewHead, _} = HeadError when is_record(NewHead, head) ->
@@ -1904,16 +1877,8 @@ do_delete_all_objects(Head) ->
max_no_slots = MaxSlots, cache = Cache} = Head,
CacheSz = dets_utils:cache_size(Cache),
ok = dets_utils:truncate(Fd, Fname, bof),
- (Head#head.mod):initiate_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots,
- Ram, CacheSz, Auto, true).
-
-%% -> {NewHead, Reply}, Reply = ok | Error.
-fdelete_key(Head, Keys) ->
- do_delete(Head, Keys, delete_key).
-
-%% -> {NewHead, Reply}, Reply = ok | badarg | Error.
-fdelete_object(Head, Objects) ->
- do_delete(Head, Objects, delete_object).
+ dets_v9:initiate_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots,
+ Ram, CacheSz, Auto, true).
ffirst(H) ->
Ref = make_ref(),
@@ -1930,7 +1895,7 @@ ffirst1(H) ->
ffirst(NH, 0).
ffirst(H, Slot) ->
- case (H#head.mod):slot_objs(H, Slot) of
+ case dets_v9:slot_objs(H, Slot) of
'$end_of_table' -> {H, '$end_of_table'};
[] -> ffirst(H, Slot+1);
[X|_] -> {H, element(H#head.keypos, X)}
@@ -2067,7 +2032,7 @@ finfo(H, auto_save) -> {H, H#head.auto_save};
finfo(H, bchunk_format) ->
case catch write_cache(H) of
{H2, []} ->
- case (H2#head.mod):table_parameters(H2) of
+ case dets_v9:table_parameters(H2) of
undefined = Undef ->
{H2, Undef};
Parms ->
@@ -2100,7 +2065,7 @@ finfo(H, no_keys) ->
{H2, _} = HeadError when is_record(H2, head) ->
HeadError
end;
-finfo(H, no_slots) -> {H, (H#head.mod):no_slots(H)};
+finfo(H, no_slots) -> {H, dets_v9:no_slots(H)};
finfo(H, pid) -> {H, self()};
finfo(H, ram_file) -> {H, H#head.ram_file};
finfo(H, safe_fixed) ->
@@ -2127,7 +2092,7 @@ finfo(H, size) ->
HeadError
end;
finfo(H, type) -> {H, H#head.type};
-finfo(H, version) -> {H, H#head.version};
+finfo(H, version) -> {H, 9};
finfo(H, _) -> {H, undefined}.
file_size(Fd, FileName) ->
@@ -2136,8 +2101,6 @@ file_size(Fd, FileName) ->
test_bchunk_format(_Head, undefined) ->
false;
-test_bchunk_format(Head, _Term) when Head#head.version =:= 8 ->
- false;
test_bchunk_format(Head, Term) ->
dets_v9:try_bchunk_header(Term, Head) =/= not_ok.
@@ -2206,7 +2169,7 @@ do_finit(Head, Init, Format, NoSlots) ->
#head{fptr = Fd, type = Type, keypos = Kp, auto_save = Auto,
cache = Cache, filename = Fname, ram_file = Ram,
min_no_slots = MinSlots0, max_no_slots = MaxSlots,
- name = Tab, update_mode = UpdateMode, mod = HMod} = Head,
+ name = Tab, update_mode = UpdateMode} = Head,
CacheSz = dets_utils:cache_size(Cache),
{How, Head1} =
case Format of
@@ -2219,9 +2182,10 @@ do_finit(Head, Init, Format, NoSlots) ->
{general_init, Head};
true ->
ok = dets_utils:truncate(Fd, Fname, bof),
- {ok, H} = HMod:initiate_file(Fd, Tab, Fname, Type, Kp,
- MinSlots, MaxSlots, Ram,
- CacheSz, Auto, false),
+ {ok, H} =
+ dets_v9:initiate_file(Fd, Tab, Fname, Type, Kp,
+ MinSlots, MaxSlots, Ram,
+ CacheSz, Auto, false),
{general_init, H}
end;
bchunk ->
@@ -2230,7 +2194,7 @@ do_finit(Head, Init, Format, NoSlots) ->
end,
case How of
bchunk_init ->
- case HMod:bchunk_init(Head1, Init) of
+ case dets_v9:bchunk_init(Head1, Init) of
{ok, NewHead} ->
{ok, NewHead#head{update_mode = dirty}};
Error ->
@@ -2238,10 +2202,10 @@ do_finit(Head, Init, Format, NoSlots) ->
end;
general_init ->
Cntrs = ets:new(dets_init, []),
- Input = HMod:bulk_input(Head1, Init, Cntrs),
+ Input = dets_v9:bulk_input(Head1, Init, Cntrs),
SlotNumbers = {Head1#head.min_no_slots, bulk_init, MaxSlots},
{Reply, SizeData} =
- do_sort(Head1, SlotNumbers, Input, Cntrs, Fname, not_used),
+ do_sort(Head1, SlotNumbers, Input, Cntrs, Fname),
Bulk = true,
case Reply of
{ok, NoDups, H1} ->
@@ -2297,7 +2261,8 @@ fmatch(Head, MP, Spec, N, Safe, From) ->
{NewHead, Reply} = flookup_keys(Head, Keys),
case Reply of
Objs when is_list(Objs) ->
- MatchingObjs = ets:match_spec_run(Objs, MP),
+ {match_spec, MS} = MP,
+ MatchingObjs = ets:match_spec_run(Objs, MS),
{NewHead, {done, MatchingObjs}};
Error ->
{NewHead, Error}
@@ -2377,7 +2342,7 @@ fmatch_delete(Head, C) ->
{[], _} ->
{Head, {done, 0}};
{RTs, NC} ->
- MP = C#dets_cont.match_program,
+ {match_spec, MP} = C#dets_cont.match_program,
case catch filter_binary_terms(RTs, MP, []) of
{'EXIT', _} ->
Bad = dets_utils:bad_object(fmatch_delete, RTs),
@@ -2405,7 +2370,7 @@ do_fmatch_delete_var_keys(Head, MP, _Spec, From) ->
C0 = init_scan(NewHead, default),
{NewHead, {cont, C0#dets_cont{match_program = MP}, 0}}.
-do_fmatch_constant_keys(Head, Keys, MP) ->
+do_fmatch_constant_keys(Head, Keys, {match_spec, MP}) ->
case flookup_keys(Head, Keys) of
{NewHead, ReadTerms} when is_list(ReadTerms) ->
Terms = filter_terms(ReadTerms, MP, []),
@@ -2454,18 +2419,8 @@ do_delete(Head, Things, What) ->
HeadError
end.
-fmember(Head, Key) ->
- case catch begin
- {Head2, [{_NoPid,Objs}]} =
- update_cache(Head, [Key], {lookup, nopid}),
- {Head2, Objs =/= []}
- end of
- {NewHead, _} = Reply when is_record(NewHead, head) ->
- Reply
- end.
-
fnext(Head, Key) ->
- Slot = (Head#head.mod):db_hash(Key, Head),
+ Slot = dets_v9:db_hash(Key, Head),
Ref = make_ref(),
case catch {Ref, fnext(Head, Key, Slot)} of
{Ref, {H, R}} ->
@@ -2476,7 +2431,7 @@ fnext(Head, Key) ->
fnext(H, Key, Slot) ->
{NH, []} = write_cache(H),
- case (H#head.mod):slot_objs(NH, Slot) of
+ case dets_v9:slot_objs(NH, Slot) of
'$end_of_table' -> {NH, '$end_of_table'};
L -> fnext_search(NH, Key, Slot, L)
end.
@@ -2490,7 +2445,7 @@ fnext_search(H, K, Slot, L) ->
%% We've got to continue to search for the next key in the next slot
fnext_slot(H, K, Slot) ->
- case (H#head.mod):slot_objs(H, Slot) of
+ case dets_v9:slot_objs(H, Slot) of
'$end_of_table' -> {H, '$end_of_table'};
[] -> fnext_slot(H, K, Slot+1);
L -> {H, element(H#head.keypos, hd(L))}
@@ -2518,11 +2473,10 @@ fopen2(Fname, Tab) ->
Acc = read_write,
Ram = false,
{ok, Fd, FH} = read_file_header(Fname, Acc, Ram),
- Mod = FH#fileheader.mod,
- Do = case Mod:check_file_header(FH, Fd) of
- {ok, Head1, ExtraInfo} ->
+ Do = case dets_v9:check_file_header(FH, Fd) of
+ {ok, Head1} ->
Head2 = Head1#head{filename = Fname},
- try {ok, Mod:init_freelist(Head2, ExtraInfo)}
+ try {ok, dets_v9:init_freelist(Head2)}
catch
throw:_ ->
{repair, " has bad free lists, repairing ..."}
@@ -2536,8 +2490,7 @@ fopen2(Fname, Tab) ->
case Do of
{repair, Mess} ->
io:format(user, "dets: file ~tp~s~n", [Fname, Mess]),
- Version = default,
- case fsck(Fd, Tab, Fname, FH, default, default, Version) of
+ case fsck(Fd, Tab, Fname, FH, default, default) of
ok ->
fopen2(Fname, Tab);
Error ->
@@ -2570,33 +2523,23 @@ fopen_existing_file(Tab, OpenArgs) ->
#open_args{file = Fname, type = Type, keypos = Kp, repair = Rep,
min_no_slots = MinSlots, max_no_slots = MaxSlots,
ram_file = Ram, delayed_write = CacheSz, auto_save =
- Auto, access = Acc, version = Version, debug = Debug} =
+ Auto, access = Acc, debug = Debug} =
OpenArgs,
{ok, Fd, FH} = read_file_header(Fname, Acc, Ram),
- V9 = (Version =:= 9) or (Version =:= default),
MinF = (MinSlots =:= default) or (MinSlots =:= FH#fileheader.min_no_slots),
MaxF = (MaxSlots =:= default) or (MaxSlots =:= FH#fileheader.max_no_slots),
- Mod = (FH#fileheader.mod),
- Wh = case Mod:check_file_header(FH, Fd) of
- {ok, Head, true} when Rep =:= force, Acc =:= read_write,
- FH#fileheader.version =:= 9,
- FH#fileheader.no_colls =/= undefined,
- MinF, MaxF, V9 ->
- {compact, Head, true};
- {ok, _Head, _Extra} when Rep =:= force, Acc =:= read ->
+ Wh = case dets_v9:check_file_header(FH, Fd) of
+ {ok, Head} when Rep =:= force, Acc =:= read_write,
+ FH#fileheader.no_colls =/= undefined,
+ MinF, MaxF ->
+ {compact, Head};
+ {ok, _Head} when Rep =:= force, Acc =:= read ->
throw({error, {access_mode, Fname}});
- {ok, Head, need_compacting} when Acc =:= read ->
- {final, Head, true}; % Version 8 only.
- {ok, _Head, need_compacting} when Rep =:= true ->
- %% The file needs to be compacted due to a very big
- %% and fragmented free_list. Version 8 only.
- M = " is now compacted ...",
- {repair, M};
- {ok, _Head, _Extra} when Rep =:= force ->
+ {ok, _Head} when Rep =:= force ->
M = ", repair forced.",
{repair, M};
- {ok, Head, ExtraInfo} ->
- {final, Head, ExtraInfo};
+ {ok, Head} ->
+ {final, Head};
{error, not_closed} when Rep =:= force, Acc =:= read_write ->
M = ", repair forced.",
{repair, M};
@@ -2605,17 +2548,13 @@ fopen_existing_file(Tab, OpenArgs) ->
{repair, M};
{error, not_closed} when Rep =:= false ->
throw({error, {needs_repair, Fname}});
- {error, version_bump} when Rep =:= true, Acc =:= read_write ->
- %% Version 8 only
- M = " old version, upgrading ...",
- {repair, M};
{error, Reason} ->
throw({error, {Reason, Fname}})
end,
Do = case Wh of
- {Tag, Hd, Extra} when Tag =:= final; Tag =:= compact ->
+ {Tag, Hd} when Tag =:= final; Tag =:= compact ->
Hd1 = Hd#head{filename = Fname},
- try {Tag, Mod:init_freelist(Hd1, Extra)}
+ try {Tag, dets_v9:init_freelist(Hd1)}
catch
throw:_ ->
{repair, " has bad free lists, repairing ..."}
@@ -2643,23 +2582,20 @@ fopen_existing_file(Tab, OpenArgs) ->
"now repairing ...~n", [Fname]),
{ok, Fd2, _FH} = read_file_header(Fname, Acc, Ram),
do_repair(Fd2, Tab, Fname, FH, MinSlots, MaxSlots,
- Version, OpenArgs)
+ OpenArgs)
end;
{repair, Mess} ->
io:format(user, "dets: file ~tp~s~n", [Fname, Mess]),
do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots,
- Version, OpenArgs);
- _ when FH#fileheader.version =/= Version, Version =/= default ->
- throw({error, {version_mismatch, Fname}});
+ OpenArgs);
{final, H} ->
H1 = H#head{auto_save = Auto},
open_final(H1, Fname, Acc, Ram, CacheSz, Tab, Debug)
end.
-do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version, OpenArgs) ->
- case fsck(Fd, Tab, Fname, FH, MinSlots, MaxSlots, Version) of
+do_repair(Fd, Tab, Fname, FH, MinSlots, MaxSlots, OpenArgs) ->
+ case fsck(Fd, Tab, Fname, FH, MinSlots, MaxSlots) of
ok ->
- %% No need to update 'version'.
erlang:garbage_collect(),
fopen3(Tab, OpenArgs#open_args{repair = false});
Error ->
@@ -2673,8 +2609,8 @@ open_final(Head, Fname, Acc, Ram, CacheSz, Tab, Debug) ->
filename = Fname,
name = Tab,
cache = dets_utils:new_cache(CacheSz)},
- init_disk_map(Head1#head.version, Tab, Debug),
- (Head1#head.mod):cache_segps(Head1#head.fptr, Fname, Head1#head.next),
+ init_disk_map(Tab, Debug),
+ dets_v9:cache_segps(Head1#head.fptr, Fname, Head1#head.next),
check_growth(Head1),
{ok, Head1}.
@@ -2683,7 +2619,7 @@ fopen_init_file(Tab, OpenArgs) ->
#open_args{file = Fname, type = Type, keypos = Kp,
min_no_slots = MinSlotsArg, max_no_slots = MaxSlotsArg,
ram_file = Ram, delayed_write = CacheSz, auto_save = Auto,
- version = UseVersion, debug = Debug} = OpenArgs,
+ debug = Debug} = OpenArgs,
MinSlots = choose_no_slots(MinSlotsArg, ?DEFAULT_MIN_NO_SLOTS),
MaxSlots = choose_no_slots(MaxSlotsArg, ?DEFAULT_MAX_NO_SLOTS),
FileSpec = if
@@ -2691,20 +2627,11 @@ fopen_init_file(Tab, OpenArgs) ->
true -> Fname
end,
{ok, Fd} = dets_utils:open(FileSpec, open_args(read_write, Ram)),
- Version = if
- UseVersion =:= default ->
- case os:getenv("DETS_USE_FILE_FORMAT") of
- "8" -> 8;
- _ -> 9
- end;
- true ->
- UseVersion
- end,
- Mod = version2module(Version),
%% No need to truncate an empty file.
- init_disk_map(Version, Tab, Debug),
- case catch Mod:initiate_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots,
- Ram, CacheSz, Auto, true) of
+ init_disk_map(Tab, Debug),
+ case catch dets_v9:initiate_file(Fd, Tab, Fname, Type, Kp,
+ MinSlots, MaxSlots,
+ Ram, CacheSz, Auto, true) of
{error, Reason} when Ram ->
_ = file:close(Fd),
throw({error, Reason});
@@ -2719,15 +2646,13 @@ fopen_init_file(Tab, OpenArgs) ->
end.
%% Debug.
-init_disk_map(9, Name, Debug) ->
+init_disk_map(Name, Debug) ->
case Debug orelse dets_utils:debug_mode() of
true ->
dets_utils:init_disk_map(Name);
false ->
ok
- end;
-init_disk_map(_Version, _Name, _Debug) ->
- ok.
+ end.
open_args(Access, RamFile) ->
A1 = case Access of
@@ -2740,15 +2665,7 @@ open_args(Access, RamFile) ->
end,
A1 ++ A2 ++ [binary, read].
-version2module(V) when V =< 8 -> dets_v8;
-version2module(9) -> dets_v9.
-
-module2version(dets_v8) -> 8;
-module2version(dets_v9) -> 9;
-module2version(not_used) -> 9.
-
%% -> ok | throw(Error)
-%% For version 9 tables only.
compact(SourceHead) ->
#head{name = Tab, filename = Fname, fptr = SFd, type = Type, keypos = Kp,
ram_file = Ram, auto_save = Auto} = SourceHead,
@@ -2759,7 +2676,7 @@ compact(SourceHead) ->
%% It is normally not possible to have two open tables in the same
%% process since the process dictionary is used for caching
%% segment pointers, but here is works anyway--when reading a file
- %% serially the pointers to not need to be used.
+ %% serially the pointers do not need to be used.
Head = case catch dets_v9:prep_table_copy(Fd, Tab, Tmp, Type, Kp, Ram,
CacheSz, Auto, TblParms) of
{ok, H} ->
@@ -2794,7 +2711,7 @@ compact(SourceHead) ->
%% -> ok | Error
%% Closes Fd.
-fsck(Fd, Tab, Fname, FH, MinSlotsArg, MaxSlotsArg, Version) ->
+fsck(Fd, Tab, Fname, FH, MinSlotsArg, MaxSlotsArg) ->
%% MinSlots and MaxSlots are the option values.
#fileheader{min_no_slots = MinSlotsFile,
max_no_slots = MaxSlotsFile} = FH,
@@ -2807,10 +2724,10 @@ fsck(Fd, Tab, Fname, FH, MinSlotsArg, MaxSlotsArg, Version) ->
%% If the number of objects (keys) turns out to be significantly
%% different from NoSlots, we try again with the correct number of
%% objects (keys).
- case fsck_try(Fd, Tab, FH, Fname, SlotNumbers, Version) of
+ case fsck_try(Fd, Tab, FH, Fname, SlotNumbers) of
{try_again, BetterNoSlots} ->
BetterSlotNumbers = {MinSlots, BetterNoSlots, MaxSlots},
- case fsck_try(Fd, Tab, FH, Fname, BetterSlotNumbers, Version) of
+ case fsck_try(Fd, Tab, FH, Fname, BetterSlotNumbers) of
{try_again, _} ->
_ = file:close(Fd),
{error, {cannot_repair, Fname}};
@@ -2829,7 +2746,7 @@ choose_no_slots(NoSlots, _) -> NoSlots.
%% Initiating a table using a fun and repairing (or converting) a
%% file are completely different things, but nevertheless the same
%% method is used in both cases...
-fsck_try(Fd, Tab, FH, Fname, SlotNumbers, Version) ->
+fsck_try(Fd, Tab, FH, Fname, SlotNumbers) ->
Tmp = tempfile(Fname),
#fileheader{type = Type, keypos = KeyPos} = FH,
{_MinSlots, EstNoSlots, MaxSlots} = SlotNumbers,
@@ -2838,7 +2755,7 @@ fsck_try(Fd, Tab, FH, Fname, SlotNumbers, Version) ->
max_no_slots = MaxSlots,
ram_file = false, delayed_write = ?DEFAULT_CACHE,
auto_save = infinity, access = read_write,
- version = Version, debug = false},
+ debug = false},
case catch fopen3(Tab, OpenArgs) of
{ok, Head} ->
case fsck_try_est(Head, Fd, Fname, SlotNumbers, FH) of
@@ -2888,10 +2805,9 @@ assure_no_file(File) ->
%% -> {ok, NewHead} | {try_again, integer()} | Error
fsck_try_est(Head, Fd, Fname, SlotNumbers, FH) ->
%% Mod is the module to use for reading input when repairing.
- Mod = FH#fileheader.mod,
Cntrs = ets:new(dets_repair, []),
- Input = Mod:fsck_input(Head, Fd, Cntrs, FH),
- {Reply, SizeData} = do_sort(Head, SlotNumbers, Input, Cntrs, Fname, Mod),
+ Input = dets_v9:fsck_input(Head, Fd, Cntrs, FH),
+ {Reply, SizeData} = do_sort(Head, SlotNumbers, Input, Cntrs, Fname),
Bulk = false,
case Reply of
{ok, NoDups, H1} ->
@@ -2906,14 +2822,13 @@ fsck_try_est(Head, Fd, Fname, SlotNumbers, FH) ->
Else
end.
-do_sort(Head, SlotNumbers, Input, Cntrs, Fname, Mod) ->
- OldV = module2version(Mod),
+do_sort(Head, SlotNumbers, Input, Cntrs, Fname) ->
%% output_objs/4 replaces {LogSize,NoObjects} in Cntrs by
%% {LogSize,Position,Data,NoObjects | NoCollections}.
%% Data = {FileName,FileDescriptor} | [object()]
- %% For small tables Data may be a list of objects which is more
+ %% For small tables Data can be a list of objects which is more
%% efficient since no temporary files are created.
- Output = (Head#head.mod):output_objs(OldV, Head, SlotNumbers, Cntrs),
+ Output = dets_v9:output_objs(Head, SlotNumbers, Cntrs),
TmpDir = filename:dirname(Fname),
Reply = (catch file_sorter:sort(Input, Output,
[{format, binary},{tmpdir, TmpDir}])),
@@ -2954,13 +2869,6 @@ fsck_copy1([SzData | L], Head, Bulk, NoDups) ->
{ok, Copied} when Copied =:= ExpectedSize;
NoObjects =:= 0 -> % the segments
fsck_copy1(L, Head, Bulk, NoDups);
- {ok, Copied} when Bulk, Head#head.version =:= 8 ->
- NoZeros = ExpectedSize - Copied,
- Dups = NoZeros div Size,
- Addr = Pos+Copied,
- NewHead = free_n_objects(Head, Addr, Size-1, NoDups),
- NewNoDups = NoDups - Dups,
- fsck_copy1(L, NewHead, Bulk, NewNoDups);
{ok, _Copied} -> % should never happen
close_files(Bulk, L, Head),
Reason = if Bulk -> initialization_failed;
@@ -2975,13 +2883,6 @@ fsck_copy1([], Head, _Bulk, NoDups) when NoDups =/= 0 ->
fsck_copy1([], Head, _Bulk, _NoDups) ->
{ok, Head#head{update_mode = dirty}}.
-free_n_objects(Head, _Addr, _Size, 0) ->
- Head;
-free_n_objects(Head, Addr, Size, N) ->
- {NewHead, _} = dets_utils:free(Head, Addr, Size),
- NewAddr = Addr + Size + 1,
- free_n_objects(NewHead, NewAddr, Size, N-1).
-
close_files(false, SizeData, Head) ->
_ = file:close(Head#head.fptr),
close_files(true, SizeData, Head);
@@ -3000,7 +2901,7 @@ close_tmp(Fd) ->
fslot(H, Slot) ->
case catch begin
{NH, []} = write_cache(H),
- Objs = (NH#head.mod):slot_objs(NH, Slot),
+ Objs = dets_v9:slot_objs(NH, Slot),
{NH, Objs}
end of
{NewHead, _Objects} = Reply when is_record(NewHead, head) ->
@@ -3050,7 +2951,7 @@ where_is_object(Head, Object) ->
true ->
case catch write_cache(Head) of
{NewHead, []} ->
- {NewHead, (Head#head.mod):find_object(NewHead, Object)};
+ {NewHead, dets_v9:find_object(NewHead, Object)};
{NewHead, _} = HeadError when is_record(NewHead, head) ->
HeadError
end;
@@ -3063,13 +2964,9 @@ check_objects([T | Ts], Kp) when tuple_size(T) >= Kp ->
check_objects(L, _Kp) ->
L =:= [].
-no_things(Head) when Head#head.no_keys =:= undefined ->
- Head#head.no_objects;
no_things(Head) ->
Head#head.no_keys.
-file_no_things(FH) when FH#fileheader.no_keys =:= undefined ->
- FH#fileheader.no_objects;
file_no_things(FH) ->
FH#fileheader.no_keys.
@@ -3110,7 +3007,7 @@ update_cache(Head, ToAdd) ->
if
Lookup; NewSize >= Cache#cache.tsize ->
%% The cache is considered full, or some lookup.
- {NewHead, LU, PwriteList} = (Head#head.mod):write_cache(Head1),
+ {NewHead, LU, PwriteList} = dets_v9:write_cache(Head1),
{NewHead, Found ++ LU, PwriteList};
NewC =:= [] ->
{Head1, Found, []};
@@ -3195,7 +3092,7 @@ delayed_write(Head, WrTime) ->
%% -> {NewHead, [LookedUpObject]} | throw({NewHead, Error})
write_cache(Head) ->
- {Head1, LU, PwriteList} = (Head#head.mod):write_cache(Head),
+ {Head1, LU, PwriteList} = dets_v9:write_cache(Head),
{NewHead, ok} = dets_utils:pwrite(Head1, PwriteList),
{NewHead, LU}.
@@ -3248,7 +3145,7 @@ scan(Head, C) -> % when is_record(C, dets_cont)
scan(Bin, Head, From, To, L, [], R, {C, Head#head.type}).
scan(Bin, H, From, To, L, Ts, R, {C0, Type} = C) ->
- case (H#head.mod):scan_objs(H, Bin, From, To, L, Ts, R, Type) of
+ case dets_v9:scan_objs(H, Bin, From, To, L, Ts, R, Type) of
{more, NFrom, NTo, NL, NTs, NR, Sz} ->
scan_read(H, NFrom, NTo, Sz, NL, NTs, NR, C);
{stop, <<>>=B, NFrom, NTo, <<>>=NL, NTs} ->
@@ -3305,7 +3202,7 @@ time_now() ->
make_timestamp(MonTime, TimeOffset) ->
ErlangSystemTime = erlang:convert_time_unit(MonTime+TimeOffset,
native,
- micro_seconds),
+ microsecond),
MegaSecs = ErlangSystemTime div 1000000000000,
Secs = ErlangSystemTime div 1000000 - MegaSecs*1000000,
MicroSecs = ErlangSystemTime rem 1000000,
@@ -3317,7 +3214,7 @@ file_info(FileName) ->
case catch read_file_header(FileName, read, false) of
{ok, Fd, FH} ->
_ = file:close(Fd),
- (FH#fileheader.mod):file_info(FH);
+ dets_v9:file_info(FH);
Other ->
Other
end.
@@ -3332,15 +3229,13 @@ get_head_field(Fd, Field) ->
view(FileName) ->
case catch read_file_header(FileName, read, false) of
{ok, Fd, FH} ->
- Mod = FH#fileheader.mod,
- try Mod:check_file_header(FH, Fd) of
- {ok, H0, ExtraInfo} ->
- Mod = FH#fileheader.mod,
- case Mod:check_file_header(FH, Fd) of
- {ok, H0, ExtraInfo} ->
- H = Mod:init_freelist(H0, ExtraInfo),
+ try dets_v9:check_file_header(FH, Fd) of
+ {ok, H0} ->
+ case dets_v9:check_file_header(FH, Fd) of
+ {ok, H0} ->
+ H = dets_v9:init_freelist(H0),
v_free_list(H),
- Mod:v_segments(H),
+ dets_v9:v_segments(H),
ok;
X ->
X
diff --git a/lib/stdlib/src/dets.hrl b/lib/stdlib/src/dets.hrl
index 6ebeb96156..b5e732b08f 100644
--- a/lib/stdlib/src/dets.hrl
+++ b/lib/stdlib/src/dets.hrl
@@ -21,7 +21,7 @@
-define(DEFAULT_MIN_NO_SLOTS, 256).
-define(DEFAULT_MAX_NO_SLOTS, 32*1024*1024).
-define(DEFAULT_AUTOSAVE, 3). % minutes
--define(DEFAULT_CACHE, {3000, 14000}). % {delay,size} in {milliseconds,bytes}
+-define(DEFAULT_CACHE, {3000, 14000}). % cache_parms()
%% Type.
-define(SET, 1).
@@ -46,83 +46,111 @@
-define(DETS_CALL(Pid, Req), {'$dets_call', Pid, Req}).
+-type access() :: 'read' | 'read_write'.
+-type auto_save() :: 'infinity' | non_neg_integer().
+-type hash_bif() :: 'phash' | 'phash2'.
+-type keypos() :: pos_integer().
+-type no_colls() :: [{LogSize :: non_neg_integer(),
+ NoCollections :: non_neg_integer()}].
+-type no_slots() :: 'default' | non_neg_integer().
+-type tab_name() :: term().
+-type type() :: 'bag' | 'duplicate_bag' | 'set'.
+-type update_mode() :: 'dirty'
+ | 'new_dirty'
+ | 'saved'
+ | {'error', Reason :: term()}.
+
%% Record holding the file header and more.
-record(head, {
- m, % size
- m2, % m * 2
- next, % next position for growth (segm mgmt only)
- fptr, % the file descriptor
- no_objects, % number of objects in table,
- no_keys, % number of keys (version 9 only)
- maxobjsize, % 2-log of the size of the biggest object
- % collection (version 9 only)
+ m :: non_neg_integer(), % size
+ m2 :: non_neg_integer(), % m * 2
+ next :: non_neg_integer(), % next position for growth
+ % (segm mgmt only)
+ fptr :: file:fd(), % the file descriptor
+ no_objects :: non_neg_integer() , % number of objects in table,
+ no_keys :: non_neg_integer(), % number of keys
+ maxobjsize :: 'undefined' | non_neg_integer(), % 2-log of
+ % the size of the biggest object collection
n, % split indicator
- type, % set | bag | duplicate_bag
- keypos, % default is 1 as for ets
- freelists, % tuple of free lists of buddies
- % if fixed =/= false, then a pair of freelists
- freelists_p, % cached FreelistsPointer
- no_collections, % [{LogSize,NoCollections}] | undefined; number of
- % object collections per size (version 9(b))
- auto_save, % Integer | infinity
- update_mode, % saved | dirty | new_dirty | {error, Reason}
- fixed = false, % false | {now_time(), [{pid(),Counter}]}
- % time of first fix, and number of fixes per process
- hash_bif, % hash bif used for this file (phash2, phash, hash)
- has_md5, % whether the header has an MD5 sum (version 9(c))
- min_no_slots, % minimum number of slots (default or integer)
- max_no_slots, % maximum number of slots (default or integer)
- cache, % cache(). Write cache.
-
- filename, % name of the file being used
- access = read_write, % read | read_write
- ram_file = false, % true | false
- name, % the name of the table
-
- parent, % The supervisor of Dets processes.
- server, % The creator of Dets processes.
-
- %% Depending on the file format:
- version,
- mod,
- bump,
- base
+ type :: type(),
+ keypos :: keypos(), % default is 1 as for ets
+ freelists :: 'undefined'
+ | tuple(), % tuple of free lists of buddies
+ % if fixed =/= false, then a pair of freelists
+ freelists_p :: 'undefined'
+ | non_neg_integer(), % cached FreelistsPointer
+ no_collections :: 'undefined'
+ | no_colls(), % number of object collections
+ % per size (version 9(b))
+ auto_save :: auto_save(),
+ update_mode :: update_mode(),
+ fixed = false :: 'false'
+ | {{integer(), integer()}, % time of first fix,
+ [{pid(), % and number of fixes per process
+ non_neg_integer()}]},
+ hash_bif :: hash_bif(), % hash bif used for this file
+ has_md5 :: boolean(), % whether the header has
+ % an MD5 sum (version 9(c))
+ min_no_slots :: no_slots(), % minimum number of slots
+ max_no_slots :: no_slots(), % maximum number of slots
+ cache :: 'undefined' | cache(), % Write cache.
+
+ filename :: file:name(), % name of the file being used
+ access = read_write :: access(),
+ ram_file = false :: boolean(),
+ name :: tab_name(), % the name of the table
+
+ parent :: 'undefined' | pid(), % The supervisor of Dets processes.
+ server :: 'undefined' | pid(), % The creator of Dets processes.
+
+ bump :: non_neg_integer(),
+ base :: non_neg_integer()
}).
%% Info extracted from the file header.
-record(fileheader, {
- freelist,
- fl_base,
- cookie,
- closed_properly,
- type,
- version,
- m,
- next,
- keypos,
- no_objects,
- no_keys,
- min_no_slots,
- max_no_slots,
- no_colls,
- hash_method,
- read_md5,
- has_md5,
- md5,
- trailer,
- eof,
- n,
- mod
+ freelist :: non_neg_integer(),
+ fl_base :: non_neg_integer(),
+ cookie :: non_neg_integer(),
+ closed_properly :: non_neg_integer(),
+ type :: 'badtype' | type(),
+ version :: non_neg_integer(),
+ m :: non_neg_integer(),
+ next :: non_neg_integer(),
+ keypos :: keypos(),
+ no_objects :: non_neg_integer(),
+ no_keys :: non_neg_integer(),
+ min_no_slots :: non_neg_integer(),
+ max_no_slots :: non_neg_integer(),
+ no_colls :: 'undefined' | no_colls(),
+ hash_method :: non_neg_integer(),
+ read_md5 :: binary(),
+ has_md5 :: boolean(),
+ md5 :: binary(),
+ trailer :: non_neg_integer(),
+ eof :: non_neg_integer(),
+ n
}).
+-type delay() :: non_neg_integer().
+-type threshold() :: non_neg_integer().
+-type cache_parms() ::
+ {Delay :: delay(), % max time items are kept in RAM only,
+ % in milliseconds
+ Size :: threshold()}. % threshold size of cache, in bytes
+
%% Write Cache.
-record(cache, {
- cache, % [{Key,{Seq,Item}}], write cache, last item first
- csize, % current size of the cached items
- inserts, % upper limit on number of inserted keys
- wrtime, % last write or update time
- tsize, % threshold size of cache, in bytes
- delay % max time items are kept in RAM only, in milliseconds
+ cache :: % write cache, last item first
+ [{Key :: term(),
+ {Seq :: non_neg_integer(), Item :: term()}}],
+ csize :: non_neg_integer(), % current size of the cached items
+ inserts :: % upper limit on number of inserted keys
+ non_neg_integer(),
+ wrtime :: 'undefined' | integer(), % last write or update time
+ tsize :: threshold(), % threshold size of cache
+ delay :: delay() % max time items are kept in RAM only
}).
+-type cache() :: #cache{}.
diff --git a/lib/stdlib/src/dets_utils.erl b/lib/stdlib/src/dets_utils.erl
index 34a8ddddaa..da6ebd18f2 100644
--- a/lib/stdlib/src/dets_utils.erl
+++ b/lib/stdlib/src/dets_utils.erl
@@ -20,13 +20,13 @@
-module(dets_utils).
%% Utility functions common to several dets file formats.
-%% To be used from dets, dets_v8 and dets_v9 only.
+%% To be used from modules dets and dets_v9 only.
-export([cmp/2, msort/1, mkeysort/2, mkeysearch/3, family/1]).
-export([rename/2, pread/2, pread/4, ipread/3, pwrite/2, write/2,
truncate/2, position/2, sync/1, open/2, truncate/3, fwrite/3,
- write_file/2, position/3, position_close/3, pwrite/4,
+ write_file/2, position/3, position_close/3,
pwrite/3, pread_close/4, read_n/2, pread_n/3, read_4/2]).
-export([code_to_type/1, type_to_code/1]).
@@ -44,8 +44,6 @@
all_allocated_as_list/1, find_allocated/4, find_next_allocated/3,
log2/1, make_zeros/1]).
--export([init_slots_from_old_file/2]).
-
-export([list_to_tree/1, tree_to_bin/5]).
-compile({inline, [{sz2pos,1}, {adjust_addr,3}]}).
@@ -308,12 +306,6 @@ position_close(Fd, FileName, Pos) ->
OK -> OK
end.
-pwrite(Fd, FileName, Position, B) ->
- case file:pwrite(Fd, Position, B) of
- ok -> ok;
- Error -> file_error(FileName, {error, Error})
- end.
-
pwrite(Fd, FileName, Bins) ->
case file:pwrite(Fd, Bins) of
ok ->
@@ -478,20 +470,6 @@ new_cache({Delay, Size}) ->
%%% Ullman. I think buddy systems were invented by Knuth, a long
%%% time ago.
-init_slots_from_old_file([{Slot,Addr} | T], Ftab) ->
- init_slot(Slot+1,[{Slot,Addr} | T], Ftab);
-init_slots_from_old_file([], Ftab) ->
- Ftab.
-
-init_slot(_Slot,[], Ftab) ->
- Ftab; % should never happen
-init_slot(_Slot,[{_Addr,0}|T], Ftab) ->
- init_slots_from_old_file(T, Ftab);
-init_slot(Slot,[{_Slot1,Addr}|T], Ftab) ->
- Stree = element(Slot, Ftab),
- %% io:format("init_slot ~p:~p~n",[Slot, Addr]),
- init_slot(Slot,T,setelement(Slot, Ftab, bplus_insert(Stree, Addr))).
-
%%% The free lists are kept in RAM, and written to the end of the file
%%% from time to time. It is possible that a considerable amount of
%%% memory is used for a fragmented file.
diff --git a/lib/stdlib/src/dets_v8.erl b/lib/stdlib/src/dets_v8.erl
deleted file mode 100644
index 1bf53d91b1..0000000000
--- a/lib/stdlib/src/dets_v8.erl
+++ /dev/null
@@ -1,1594 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
-%%
-%% Licensed under the Apache License, Version 2.0 (the "License");
-%% you may not use this file except in compliance with the License.
-%% You may obtain a copy of the License at
-%%
-%% http://www.apache.org/licenses/LICENSE-2.0
-%%
-%% Unless required by applicable law or agreed to in writing, software
-%% distributed under the License is distributed on an "AS IS" BASIS,
-%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-%% See the License for the specific language governing permissions and
-%% limitations under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(dets_v8).
-
-%% Dets files, implementation part. This module handles versions up to
-%% and including 8(c). To be called from dets.erl only.
-
--export([mark_dirty/1, read_file_header/2,
- check_file_header/2, do_perform_save/1, initiate_file/11,
- init_freelist/2, fsck_input/4,
- bulk_input/3, output_objs/4, write_cache/1, may_grow/3,
- find_object/2, re_hash/2, slot_objs/2, scan_objs/8,
- db_hash/2, no_slots/1, table_parameters/1]).
-
--export([file_info/1, v_segments/1]).
-
--export([cache_segps/3]).
-
-%% For backward compatibility.
--export([sz2pos/1]).
-
--dialyzer(no_improper_lists).
-
--compile({inline, [{sz2pos,1},{scan_skip,7}]}).
--compile({inline, [{skip_bytes,5}, {get_segp,1}]}).
--compile({inline, [{wl_lookup,5}]}).
--compile({inline, [{actual_seg_size,0}]}).
-
--include("dets.hrl").
-
-%% The layout of the file is :
-%%
-%% bytes decsription
-%% ---------------------- File header
-%% 4 FreelistsPointer
-%% 4 Cookie
-%% 4 ClosedProperly (pos=8)
-%% 4 Type (pos=12)
-%% 4 Version (pos=16)
-%% 4 M
-%% 4 Next
-%% 4 KeyPos
-%% 4 NoObjects
-%% 4 N
-%% ------------------ end of file header
-%% 4*8192 SegmentArray
-%% ------------------
-%% 4*256 First segment
-%% ----------------------------- This is BASE.
-%% ??? Objects (free and alive)
-%% 4*256 Second segment (2 kB now, due to a bug)
-%% ??? Objects (free and alive)
-%% ... more objects and segments ...
-%% -----------------------------
-%% ??? Free lists
-%% -----------------------------
-%% 4 File size, in bytes.
-
-%% The first slot (0) in the segment array always points to the
-%% pre-allocated first segment.
-%% Before we can find an object we must find the slot where the
-%% object resides. Each slot is a (possibly empty) list (or chain) of
-%% objects that hash to the same slot. If the value stored in the
-%% slot is zero, the slot chain is empty. If the slot value is
-%% non-zero, the value points to a position in the file where the
-%% chain starts. Each object in a chain has the following layout:
-%%
-%% bytes decsription
-%% --------------------
-%% 4 Pointer to the next object of the chain.
-%% 4 Size of the object in bytes (Sz).
-%% 4 Status (FREE or ACTIVE)
-%% Sz Binary representing the object
-%%
-%% The status field is used while repairing a file (but not next or size).
-%%
-%%|---------------|
-%%| head |
-%%| |
-%%| |
-%%|_______________|
-%%| |------|
-%%|___seg ptr1____| |
-%%| | |
-%%|__ seg ptr 2___| |
-%%| | | segment 1
-%%| .... | V _____________
-%% | |
-%% | |
-%% |___slot 0 ____|
-%% | |
-%% |___slot 1 ____|-----|
-%% | | |
-%% | ..... | | 1:st obj in slot 1
-%% V segment 1
-%% |-----------|
-%% | next |
-%% |___________|
-%% | size |
-%% |___________|
-%% | status |
-%% |___________|
-%% | |
-%% | |
-%% | obj |
-%% | |
-
-%%%
-%%% File header
-%%%
-
--define(HEADSZ, 40). % The size of the file header, in bytes.
--define(SEGSZ, 256). % Size of a segment, in words.
--define(SEGSZ_LOG2, 8).
--define(SEGARRSZ, 8192). % Maximal number of segments.
--define(SEGADDR(SegN), (?HEADSZ + (4 * (SegN)))).
--define(BASE, ?SEGADDR((?SEGSZ + ?SEGARRSZ))).
--define(MAXOBJS, (?SEGSZ * ?SEGARRSZ)). % 2 M objects
-
--define(SLOT2SEG(S), ((S) bsr ?SEGSZ_LOG2)).
-
-%% BIG is used for hashing. BIG must be greater than the maximum
-%% number of slots, currently MAXOBJS.
--define(BIG, 16#ffffff).
-
-%% Hard coded positions into the file header:
--define(FREELIST_POS, 0).
--define(CLOSED_PROPERLY_POS, 8).
--define(D_POS, 20).
--define(NO_OBJECTS_POS, (?D_POS + 12)).
-
-%% The version of a dets file is indicated by the ClosedProperly
-%% field. Version 6 was used in the R1A release, and version 7 in the
-%% R1B release up to and including the R3B01 release. Both version 6
-%% and version 7 indicate properly closed files by the value
-%% CLOSED_PROPERLY.
-%%
-%% The current version, 8, has three sub-versions:
-%%
-%% - 8(a), indicated by the value CLOSED_PROPERLY (same as in versions 6
-%% and 7), introduced in R3B02;
-%% - 8(b), indicated by the value CLOSED_PROPERLY2(_NEED_COMPACTING),
-%% introduced in R5A and used up to and including R6A;
-%% - 8(c), indicated by the value CLOSED_PROPERLY_NEW_HASH(_NEED_COMPACTING),
-%% in use since R6B.
-%%
-%% The difference between the 8(a) and the 8(b) versions is the format
-%% used for free lists saved on dets files.
-%% The 8(c) version uses a different hashing algorithm, erlang:phash
-%% (former versions use erlang:hash).
-%% Version 8(b) files are only converted to version 8(c) if repair is
-%% done, so we need compatibility with 8(b) for a _long_ time.
-%%
-%% There are known bugs due to the fact that keys and objects are
-%% sometimes compared (==) and sometimes matched (=:=). The version
-%% used by default (9, see dets_v9.erl) does not have this problem.
-
--define(NOT_PROPERLY_CLOSED,0).
--define(CLOSED_PROPERLY,1).
--define(CLOSED_PROPERLY2,2).
--define(CLOSED_PROPERLY2_NEED_COMPACTING,3).
--define(CLOSED_PROPERLY_NEW_HASH,4).
--define(CLOSED_PROPERLY_NEW_HASH_NEED_COMPACTING,5).
-
--define(FILE_FORMAT_VERSION, 8).
--define(CAN_BUMP_BY_REPAIR, [6, 7]).
--define(CAN_CONVERT_FREELIST, [8]).
-
-%%%
-%%% Object header (next, size, status).
-%%%
-
--define(OHDSZ, 12). % The size of the object header, in bytes.
--define(STATUS_POS, 8). % Position of the status field.
-
-%% The size of each object is a multiple of 16.
-%% BUMP is used when repairing files.
--define(BUMP, 16).
-
--define(ReadAhead, 512).
-
-%%-define(DEBUGF(X,Y), io:format(X, Y)).
--define(DEBUGF(X,Y), void).
-
-%% -> ok | throw({NewHead,Error})
-mark_dirty(Head) ->
- Dirty = [{?CLOSED_PROPERLY_POS, <<?NOT_PROPERLY_CLOSED:32>>}],
- {_NewHead, ok} = dets_utils:pwrite(Head, Dirty),
- ok = dets_utils:sync(Head),
- {ok, _Pos} = dets_utils:position(Head, Head#head.freelists_p),
- ok = dets_utils:truncate(Head, cur).
-
-%% -> {ok, head()} | throw(Error)
-initiate_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots,
- Ram, CacheSz, Auto, _DoInitSegments) ->
- Freelist = 0,
- Cookie = ?MAGIC,
- ClosedProperly = ?NOT_PROPERLY_CLOSED, % immediately overwritten
- Version = ?FILE_FORMAT_VERSION,
- Factor = est_no_segments(MinSlots),
- N = 0,
- M = Next = ?SEGSZ * Factor,
- NoObjects = 0,
- dets_utils:pwrite(Fd, Fname, 0,
- <<Freelist:32,
- Cookie:32,
- ClosedProperly:32,
- (dets_utils:type_to_code(Type)):32,
- Version:32,
- M:32,
- Next:32,
- Kp:32,
- NoObjects:32,
- N:32,
- 0:(?SEGARRSZ*4)/unit:8, % Initialize SegmentArray
- 0:(?SEGSZ*4)/unit:8>>), % Initialize first segment
- %% We must set the first slot of the segment pointer array to
- %% point to the first segment
- Pos = ?SEGADDR(0),
- SegP = (?HEADSZ + (4 * ?SEGARRSZ)),
- dets_utils:pwrite(Fd, Fname, Pos, <<SegP:32>>),
- segp_cache(Pos, SegP),
-
- Ftab = dets_utils:init_alloc(?BASE),
- H0 = #head{freelists=Ftab, fptr = Fd, base = ?BASE},
- {H1, Ws} = init_more_segments(H0, 1, Factor, undefined, []),
-
- %% This is not optimal but simple: always initiate the segments.
- dets_utils:pwrite(Fd, Fname, Ws),
-
- %% Return a new nice head structure
- Head = #head{
- m = M,
- m2 = M * 2,
- next = Next,
- fptr = Fd,
- no_objects = NoObjects,
- n = N,
- type = Type,
- update_mode = dirty,
- freelists = H1#head.freelists,
- auto_save = Auto,
- hash_bif = phash,
- keypos = Kp,
- min_no_slots = Factor * ?SEGSZ,
- max_no_slots = no_segs(MaxSlots) * ?SEGSZ,
-
- ram_file = Ram,
- filename = Fname,
- name = Tab,
- cache = dets_utils:new_cache(CacheSz),
- version = Version,
- bump = ?BUMP,
- base = ?BASE,
- mod = ?MODULE
- },
- {ok, Head}.
-
-est_no_segments(MinSlots) when 1 + ?SLOT2SEG(MinSlots) > ?SEGARRSZ ->
- ?SEGARRSZ;
-est_no_segments(MinSlots) ->
- 1 + ?SLOT2SEG(MinSlots).
-
-init_more_segments(Head, SegNo, Factor, undefined, Ws) when SegNo < Factor ->
- init_more_segments(Head, SegNo, Factor, seg_zero(), Ws);
-init_more_segments(Head, SegNo, Factor, SegZero, Ws) when SegNo < Factor ->
- {NewHead, W} = allocate_segment(Head, SegZero, SegNo),
- init_more_segments(NewHead, SegNo+1, Factor, SegZero, W++Ws);
-init_more_segments(Head, _SegNo, _Factor, _SegZero, Ws) ->
- {Head, Ws}.
-
-allocate_segment(Head, SegZero, SegNo) ->
- %% may throw error:
- {NewHead, Segment, _} = dets_utils:alloc(Head, 4 * ?SEGSZ),
- InitSegment = {Segment, SegZero},
- Pos = ?SEGADDR(SegNo),
- segp_cache(Pos, Segment),
- SegPointer = {Pos, <<Segment:32>>},
- {NewHead, [InitSegment, SegPointer]}.
-
-%% Read free lists (using a Buddy System) from file.
-init_freelist(Head, {convert_freelist,_Version}) ->
- %% This function converts the saved freelist of the form
- %% [{Slot1,Addr1},{Addr1,Addr2},...,{AddrN,0},{Slot2,Addr},...]
- %% i.e each slot is a linked list which ends with a 0.
- %% This is stored in a bplus_tree per Slot.
- %% Each Slot is a position in a tuple.
-
- Ftab = dets_utils:empty_free_lists(),
- Pos = Head#head.freelists_p,
- case catch prterm(Head, Pos, ?OHDSZ) of
- {0, _Sz, Term} ->
- FreeList1 = lists:reverse(Term),
- FreeList = dets_utils:init_slots_from_old_file(FreeList1, Ftab),
- Head#head{freelists = FreeList, base = ?BASE};
- _ ->
- throw({error, {bad_freelists, Head#head.filename}})
- end;
-init_freelist(Head, _) ->
- %% bplus_tree stored as is
- Pos = Head#head.freelists_p,
- case catch prterm(Head, Pos, ?OHDSZ) of
- {0, _Sz, Term} ->
- Head#head{freelists = Term, base = ?BASE};
- _ ->
- throw({error, {bad_freelists, Head#head.filename}})
- end.
-
-%% -> {ok, Fd, fileheader()} | throw(Error)
-read_file_header(Fd, FileName) ->
- {ok, Bin} = dets_utils:pread_close(Fd, FileName, 0, ?HEADSZ),
- [Freelist, Cookie, CP, Type2, Version, M, Next, Kp, NoObjects, N] =
- bin2ints(Bin),
- {ok, EOF} = dets_utils:position_close(Fd, FileName, eof),
- {ok, <<FileSize:32>>} = dets_utils:pread_close(Fd, FileName, EOF-4, 4),
- FH = #fileheader{freelist = Freelist,
- fl_base = ?BASE,
- cookie = Cookie,
- closed_properly = CP,
- type = dets_utils:code_to_type(Type2),
- version = Version,
- m = M,
- next = Next,
- keypos = Kp,
- no_objects = NoObjects,
- min_no_slots = ?DEFAULT_MIN_NO_SLOTS,
- max_no_slots = ?DEFAULT_MAX_NO_SLOTS,
- trailer = FileSize,
- eof = EOF,
- n = N,
- mod = ?MODULE},
- {ok, Fd, FH}.
-
-%% -> {ok, head(), ExtraInfo} | {error, Reason} (Reason lacking file name)
-%% ExtraInfo = {convert_freelist, Version} | true | need_compacting
-check_file_header(FH, Fd) ->
- Test =
- if
- FH#fileheader.cookie =/= ?MAGIC ->
- {error, not_a_dets_file};
- FH#fileheader.type =:= badtype ->
- {error, invalid_type_code};
- FH#fileheader.version =/= ?FILE_FORMAT_VERSION ->
- case lists:member(FH#fileheader.version,
- ?CAN_BUMP_BY_REPAIR) of
- true ->
- {error, version_bump};
- false ->
- {error, bad_version}
- end;
- FH#fileheader.trailer =/= FH#fileheader.eof ->
- {error, not_closed};
- FH#fileheader.closed_properly =:= ?CLOSED_PROPERLY ->
- case lists:member(FH#fileheader.version,
- ?CAN_CONVERT_FREELIST) of
- true ->
- {ok, {convert_freelist, FH#fileheader.version}, hash};
- false ->
- {error, not_closed} % should not happen
- end;
- FH#fileheader.closed_properly =:= ?CLOSED_PROPERLY2 ->
- {ok, true, hash};
- FH#fileheader.closed_properly =:=
- ?CLOSED_PROPERLY2_NEED_COMPACTING ->
- {ok, need_compacting, hash};
- FH#fileheader.closed_properly =:= ?CLOSED_PROPERLY_NEW_HASH ->
- {ok, true, phash};
- FH#fileheader.closed_properly =:=
- ?CLOSED_PROPERLY_NEW_HASH_NEED_COMPACTING ->
- {ok, need_compacting, phash};
- FH#fileheader.closed_properly =:= ?NOT_PROPERLY_CLOSED ->
- {error, not_closed};
- FH#fileheader.closed_properly >
- ?CLOSED_PROPERLY_NEW_HASH_NEED_COMPACTING ->
- {error, not_closed};
- true ->
- {error, not_a_dets_file}
- end,
- case Test of
- {ok, ExtraInfo, HashAlg} ->
- H = #head{
- m = FH#fileheader.m,
- m2 = FH#fileheader.m * 2,
- next = FH#fileheader.next,
- fptr = Fd,
- no_objects= FH#fileheader.no_objects,
- n = FH#fileheader.n,
- type = FH#fileheader.type,
- update_mode = saved,
- auto_save = infinity, % not saved on file
- fixed = false, % not saved on file
- freelists_p = FH#fileheader.freelist,
- hash_bif = HashAlg,
- keypos = FH#fileheader.keypos,
- min_no_slots = FH#fileheader.min_no_slots,
- max_no_slots = FH#fileheader.max_no_slots,
- version = ?FILE_FORMAT_VERSION,
- mod = ?MODULE,
- bump = ?BUMP,
- base = FH#fileheader.fl_base},
- {ok, H, ExtraInfo};
- Error ->
- Error
- end.
-
-cache_segps(Fd, FileName, M) ->
- NSegs = no_segs(M),
- {ok, Bin} = dets_utils:pread_close(Fd, FileName, ?HEADSZ, 4 * NSegs),
- Fun = fun(S, P) -> segp_cache(P, S), P+4 end,
- lists:foldl(Fun, ?HEADSZ, bin2ints(Bin)).
-
-no_segs(NoSlots) ->
- ?SLOT2SEG(NoSlots - 1) + 1.
-
-bin2ints(<<Int:32, B/binary>>) ->
- [Int | bin2ints(B)];
-bin2ints(<<>>) ->
- [].
-
-%%%
-%%% Repair, conversion and initialization of a dets file.
-%%%
-
-bulk_input(Head, InitFun, Cntrs) ->
- bulk_input(Head, InitFun, Cntrs, make_ref()).
-
-bulk_input(Head, InitFun, Cntrs, Ref) ->
- fun(close) ->
- ok;
- (read) ->
- case catch {Ref, InitFun(read)} of
- {Ref, end_of_input} ->
- end_of_input;
- {Ref, {L0, NewInitFun}} when is_list(L0),
- is_function(NewInitFun) ->
- Kp = Head#head.keypos,
- case catch bulk_objects(L0, Head, Cntrs, Kp, []) of
- {'EXIT', _Error} ->
- _ = (catch NewInitFun(close)),
- {error, invalid_objects_list};
- L ->
- {L, bulk_input(Head, NewInitFun, Cntrs, Ref)}
- end;
- {Ref, Value} ->
- {error, {init_fun, Value}};
- Error ->
- throw({thrown, Error})
- end
- end.
-
-bulk_objects([T | Ts], Head, Cntrs, Kp, L) ->
- BT = term_to_binary(T),
- Sz = byte_size(BT),
- LogSz = sz2pos(Sz+?OHDSZ),
- count_object(Cntrs, LogSz),
- Key = element(Kp, T),
- bulk_objects(Ts, Head, Cntrs, Kp, [make_object(Head, Key, LogSz, BT) | L]);
-bulk_objects([], _Head, _Cntrs, _Kp, L) ->
- L.
-
--define(FSCK_SEGMENT, 10000).
-
--define(DCT(D, CT), [D | CT]).
-
--define(VNEW(N, E), erlang:make_tuple(N, E)).
--define(VSET(I, V, E), setelement(I, V, E)).
--define(VGET(I, V), element(I, V)).
-
-%% OldVersion not used, assuming later versions have been converted already.
-output_objs(OldVersion, Head, SlotNumbers, Cntrs) ->
- fun(close) ->
- {ok, 0, Head};
- ([]) ->
- output_objs(OldVersion, Head, SlotNumbers, Cntrs);
- (L) ->
- %% Descending sizes.
- Count = lists:sort(ets:tab2list(Cntrs)),
- RCount = lists:reverse(Count),
- NoObjects = lists:foldl(fun({_Sz,No}, A) -> A + No end, 0, Count),
- {_, MinSlots, _} = SlotNumbers,
- if
- %% Using number of objects for bags and duplicate bags
- %% is not ideal; number of (unique) keys should be
- %% used instead. The effect is that there will be more
- %% segments than "necessary".
- MinSlots =/= bulk_init,
- abs(?SLOT2SEG(NoObjects) - ?SLOT2SEG(MinSlots)) > 5,
- (NoObjects < ?MAXOBJS) ->
- {try_again, NoObjects};
- true ->
- Head1 = Head#head{no_objects = NoObjects},
- SegSz = actual_seg_size(),
- {_, End, _} = dets_utils:alloc(Head, SegSz-1),
- %% Now {LogSize,NoObjects} in Cntrs is replaced by
- %% {LogSize,Position,{FileName,FileDescriptor},NoObjects}.
- {Head2, CT} = allocate_all_objects(Head1, RCount, Cntrs),
- [E | Es] = bin2term(L, []),
- {NE, Acc, DCT1} =
- output_slots(E, Es, [E], Head2, ?DCT(0, CT)),
- NDCT = write_all_sizes(DCT1, Cntrs),
- Max = ets:info(Cntrs, size),
- output_objs2(NE, Acc, Head2, Cntrs, NDCT, End, Max,Max)
- end
- end.
-
-output_objs2(E, Acc, Head, Cntrs, DCT, End, 0, MaxNoChunks) ->
- NDCT = write_all_sizes(DCT, Cntrs),
- output_objs2(E, Acc, Head, Cntrs, NDCT, End, MaxNoChunks, MaxNoChunks);
-output_objs2(E, Acc, Head, Cntrs, DCT, End, ChunkI, MaxNoChunks) ->
- fun(close) ->
- DCT1 = output_slot(Acc, Head, DCT),
- NDCT = write_all_sizes(DCT1, Cntrs),
- ?DCT(NoDups, CT) = NDCT,
- [SegAddr | []] = ?VGET(tuple_size(CT), CT),
- FinalZ = End - SegAddr,
- [{?FSCK_SEGMENT, _, {FileName, Fd}, _}] =
- ets:lookup(Cntrs, ?FSCK_SEGMENT),
- ok = dets_utils:fwrite(Fd, FileName,
- dets_utils:make_zeros(FinalZ)),
- NewHead = Head#head{no_objects = Head#head.no_objects - NoDups},
- {ok, NoDups, NewHead};
- (L) ->
- Es = bin2term(L, []),
- {NE, NAcc, NDCT} = output_slots(E, Es, Acc, Head, DCT),
- output_objs2(NE, NAcc, Head, Cntrs, NDCT, End,
- ChunkI-1, MaxNoChunks)
- end.
-
-%% By allocating bigger objects before smaller ones, holes in the
-%% buddy system memory map are avoided. Unfortunately, the segments
-%% are always allocated first, so if there are objects bigger than a
-%% segment, there is a hole to handle. (Haven't considered placing the
-%% segments among other objects of the same size.)
-allocate_all_objects(Head, Count, Cntrs) ->
- SegSize = actual_seg_size(),
- {Head1, HSz, HN, HA} = alloc_hole(Count, Head, SegSize),
- {Max, _} = hd(Count),
- CT = ?VNEW(Max+1, not_used),
- {Head2, NCT} = allocate_all(Head1, Count, Cntrs, CT),
- Head3 = free_hole(Head2, HSz, HN, HA),
- {Head3, NCT}.
-
-alloc_hole([{LSize,_} | _], Head, SegSz) when ?POW(LSize-1) > SegSz ->
- {_, SegAddr, _} = dets_utils:alloc(Head, SegSz-1),
- Size = ?POW(LSize-1)-1,
- {_, Addr, _} = dets_utils:alloc(Head, Size),
- N = (Addr - SegAddr) div SegSz,
- Head1 = dets_utils:alloc_many(Head, SegSz, N, SegAddr),
- {Head1, SegSz-1, N, SegAddr};
-alloc_hole(_Count, Head, _SegSz) ->
- {Head, 0, 0, 0}.
-
-free_hole(Head, _Size, 0, _Addr) ->
- Head;
-free_hole(Head, Size, N, Addr) ->
- {Head1, _} = dets_utils:free(Head, Addr, Size),
- free_hole(Head1, Size, N-1, Addr+Size+1).
-
-%% One (temporary) file for each buddy size, write all objects of that
-%% size to the file.
-allocate_all(Head, [{LSize,NoObjects} | Count], Cntrs, CT) ->
- Size = ?POW(LSize-1)-1,
- {_Head, Addr, _} = dets_utils:alloc(Head, Size),
- NewHead = dets_utils:alloc_many(Head, Size+1, NoObjects, Addr),
- {FileName, Fd} = temp_file(Head, LSize),
- true = ets:insert(Cntrs, {LSize, Addr, {FileName, Fd}, NoObjects}),
- NCT = ?VSET(LSize, CT, [Addr | []]),
- allocate_all(NewHead, Count, Cntrs, NCT);
-allocate_all(Head, [], Cntrs, CT) ->
- %% Note that space for the segments has been allocated already.
- %% And one file for the segments...
- {FileName, Fd} = temp_file(Head, ?FSCK_SEGMENT),
- Addr = ?SEGADDR(?SEGARRSZ),
- true = ets:insert(Cntrs, {?FSCK_SEGMENT, Addr, {FileName, Fd}, 0}),
- NCT = ?VSET(tuple_size(CT), CT, [Addr | []]),
- {Head, NCT}.
-
-temp_file(Head, N) ->
- TmpName = lists:concat([Head#head.filename, '.', N]),
- {ok, Fd} = dets_utils:open(TmpName, [raw, binary, write]),
- {TmpName, Fd}.
-
-bin2term([<<Slot:32, LogSize:8, BinTerm/binary>> | BTs], L) ->
- bin2term(BTs, [{Slot, LogSize, BinTerm} | L]);
-bin2term([], L) ->
- lists:reverse(L).
-
-write_all_sizes(?DCT(D, CT), Cntrs) ->
- ?DCT(D, write_sizes(1, tuple_size(CT), CT, Cntrs)).
-
-write_sizes(Sz, Sz, CT, Cntrs) ->
- write_size(Sz, ?FSCK_SEGMENT, CT, Cntrs);
-write_sizes(Sz, MaxSz, CT, Cntrs) ->
- NCT = write_size(Sz, Sz, CT, Cntrs),
- write_sizes(Sz+1, MaxSz, NCT, Cntrs).
-
-write_size(Sz, I, CT, Cntrs) ->
- case ?VGET(Sz, CT) of
- not_used ->
- CT;
- [Addr | L] ->
- {FileName, Fd} = ets:lookup_element(Cntrs, I, 3),
- case file:write(Fd, lists:reverse(L)) of
- ok ->
- ?VSET(Sz, CT, [Addr | []]);
- Error ->
- dets_utils:file_error(FileName, Error)
- end
- end.
-
-output_slots(E, [E1 | Es], Acc, Head, DCT)
- when element(1, E) =:= element(1, E1) ->
- output_slots(E1, Es, [E1 | Acc], Head, DCT);
-output_slots(_E, [E | L], Acc, Head, DCT) ->
- NDCT = output_slot(Acc, Head, DCT),
- output_slots(E, L, [E], Head, NDCT);
-output_slots(E, [], Acc, _Head, DCT) ->
- {E, Acc, DCT}.
-
-output_slot([E], _Head, ?DCT(D, CT)) ->
- ?DCT(D, output_slot([{foo, E}], 0, foo, CT));
-output_slot(Es0, Head, ?DCT(D, CT)) ->
- Kp = Head#head.keypos,
- Fun = fun({_Slot, _LSize, BinTerm} = E) ->
- Key = element(Kp, binary_to_term(BinTerm)),
- {Key, E}
- end,
- Es = lists:map(Fun, Es0),
- NEs = case Head#head.type of
- set ->
- [{Key0,_} = E | L0] = lists:sort(Es),
- choose_one(lists:sort(L0), Key0, [E]);
- bag ->
- lists:usort(Es);
- duplicate_bag ->
- lists:sort(Es)
- end,
- Dups = D + length(Es) - length(NEs),
- ?DCT(Dups, output_slot(NEs, 0, foo, CT)).
-
-choose_one([{Key,_} | Es], Key, L) ->
- choose_one(Es, Key, L);
-choose_one([{Key,_} = E | Es], _Key, L) ->
- choose_one(Es, Key, [E | L]);
-choose_one([], _Key, L) ->
- L.
-
-output_slot([E | Es], Next, _Slot, CT) ->
- {_Key, {Slot, LSize, BinTerm}} = E,
- Size = byte_size(BinTerm),
- Size2 = ?POW(LSize-1),
- Pad = <<0:(Size2-Size-?OHDSZ)/unit:8>>,
- BinObject = [<<Next:32, Size:32, ?ACTIVE:32>>, BinTerm | Pad],
- [Addr | L] = ?VGET(LSize, CT),
- NCT = ?VSET(LSize, CT, [Addr+Size2 | [BinObject | L]]),
- output_slot(Es, Addr, Slot, NCT);
-output_slot([], Next, Slot, CT) ->
- I = tuple_size(CT),
- [Addr | L] = ?VGET(I, CT),
- {Pos, _} = slot_position(Slot),
- NoZeros = Pos - Addr,
- BinObject = if
- NoZeros > 100 ->
- [dets_utils:make_zeros(NoZeros) | <<Next:32>>];
- true ->
- <<0:NoZeros/unit:8,Next:32>>
- end,
- Size = NoZeros+4,
- ?VSET(I, CT, [Addr+Size | [BinObject | L]]).
-
-%% Does not close Fd.
-fsck_input(Head, Fd, Cntrs, _FileHeader) ->
- %% The file is not compressed, so the object size cannot exceed
- %% the filesize, for all objects.
- MaxSz = case file:position(Fd, eof) of
- {ok, Pos} ->
- Pos;
- _ ->
- (1 bsl 32) - 1
- end,
- State0 = fsck_read(?BASE, Fd, []),
- fsck_input1(Head, State0, Fd, MaxSz, Cntrs).
-
-fsck_input1(Head, State, Fd, MaxSz, Cntrs) ->
- fun(close) ->
- ok;
- (read) ->
- case State of
- done ->
- end_of_input;
- {done, L} ->
- R = count_input(Cntrs, L, []),
- {R, fsck_input1(Head, done, Fd, MaxSz, Cntrs)};
- {cont, L, Bin, Pos} ->
- R = count_input(Cntrs, L, []),
- FR = fsck_objs(Bin, Head#head.keypos, Head, []),
- NewState = fsck_read(FR, Pos, Fd, MaxSz, Head),
- {R, fsck_input1(Head, NewState, Fd, MaxSz, Cntrs)}
- end
- end.
-
-%% The ets table Cntrs is used for counting objects per size.
-count_input(Cntrs, [[LogSz | B] | Ts], L) ->
- count_object(Cntrs, LogSz),
- count_input(Cntrs, Ts, [B | L]);
-count_input(_Cntrs, [], L) ->
- L.
-
-count_object(Cntrs, LogSz) ->
- case catch ets:update_counter(Cntrs, LogSz, 1) of
- N when is_integer(N) -> ok;
- _Badarg -> true = ets:insert(Cntrs, {LogSz, 1})
- end.
-
-fsck_read(Pos, F, L) ->
- case file:position(F, Pos) of
- {ok, _} ->
- read_more_bytes(<<>>, 0, Pos, F, L);
- _Error ->
- {done, L}
- end.
-
-fsck_read({more, Bin, Sz, L}, Pos, F, MaxSz, Head) when Sz > MaxSz ->
- FR = skip_bytes(Bin, ?BUMP, Head#head.keypos, Head, L),
- fsck_read(FR, Pos, F, MaxSz, Head);
-fsck_read({more, Bin, Sz, L}, Pos, F, _MaxSz, _Head) ->
- read_more_bytes(Bin, Sz, Pos, F, L);
-fsck_read({new, Skip, L}, Pos, F, _MaxSz, _Head) ->
- NewPos = Pos + Skip,
- fsck_read(NewPos, F, L).
-
-read_more_bytes(B, Min, Pos, F, L) ->
- Max = if
- Min < ?CHUNK_SIZE -> ?CHUNK_SIZE;
- true -> Min
- end,
- case dets_utils:read_n(F, Max) of
- eof ->
- {done, L};
- Bin ->
- NewPos = Pos + byte_size(Bin),
- {cont, L, list_to_binary([B, Bin]), NewPos}
- end.
-
-fsck_objs(Bin = <<_N:32, Sz:32, Status:32, Tail/binary>>, Kp, Head, L) ->
- if
- Status =:= ?ACTIVE ->
- case Tail of
- <<BinTerm:Sz/binary, Tail2/binary>> ->
- case catch element(Kp, binary_to_term(BinTerm)) of
- {'EXIT', _} ->
- skip_bytes(Bin, ?BUMP, Kp, Head, L);
- Key ->
- LogSz = sz2pos(Sz+?OHDSZ),
- Obj = make_object(Head, Key, LogSz, BinTerm),
- NL = [[LogSz | Obj] | L],
- Skip = ?POW(LogSz-1) - Sz - ?OHDSZ,
- skip_bytes(Tail2, Skip, Kp, Head, NL)
- end;
- _ ->
- {more, Bin, Sz, L}
- end;
- true ->
- skip_bytes(Bin, ?BUMP, Kp, Head, L)
- end;
-fsck_objs(Bin, _Kp, _Head, L) ->
- {more, Bin, 0, L}.
-
-%% Version 8 has to know about version 9.
-make_object(Head, Key, _LogSz, BT) when Head#head.version =:= 9 ->
- Slot = dets_v9:db_hash(Key, Head),
- <<Slot:32, BT/binary>>;
-make_object(Head, Key, LogSz, BT) ->
- Slot = db_hash(Key, Head),
- <<Slot:32, LogSz:8, BT/binary>>.
-
-%% Inlined.
-skip_bytes(Bin, Skip, Kp, Head, L) ->
- case Bin of
- <<_:Skip/binary, Tail/binary>> ->
- fsck_objs(Tail, Kp, Head, L);
- _ ->
- {new, Skip - byte_size(Bin), L}
- end.
-
-%% -> {NewHead, ok} | throw({Head, Error})
-do_perform_save(H) ->
- FL = dets_utils:get_freelists(H),
- B = term_to_binary(FL),
- Size = byte_size(B),
- ?DEBUGF("size of freelist = ~p~n", [Size]),
- ?DEBUGF("head.m = ~p~n", [H#head.m]),
- ?DEBUGF("head.no_objects = ~p~n", [H#head.no_objects]),
-
- {ok, Pos} = dets_utils:position(H, eof),
- H1 = H#head{freelists_p = Pos},
- W1 = {?FREELIST_POS, <<Pos:32>>},
- W2 = {Pos, [<<0:32, Size:32, ?FREE:32>>, B]},
-
- W3 = {?D_POS, <<(H1#head.m):32,
- (H1#head.next):32,
- (H1#head.keypos):32,
- (H1#head.no_objects):32,
- (H1#head.n):32>>},
- {ClosedProperly, ClosedProperlyNeedCompacitng} =
- case H1#head.hash_bif of
- hash ->
- {?CLOSED_PROPERLY2, ?CLOSED_PROPERLY2_NEED_COMPACTING};
- phash ->
- {?CLOSED_PROPERLY_NEW_HASH,
- ?CLOSED_PROPERLY_NEW_HASH_NEED_COMPACTING}
- end,
- W4 =
- if
- Size > 1000, Size > H1#head.no_objects ->
- {?CLOSED_PROPERLY_POS,
- <<ClosedProperlyNeedCompacitng:32>>};
- true ->
- {?CLOSED_PROPERLY_POS, <<ClosedProperly:32>>}
- end,
- W5 = {?FILE_FORMAT_VERSION_POS, <<?FILE_FORMAT_VERSION:32>>},
- {H2, ok} = dets_utils:pwrite(H1, [W1,W2,W3,W4,W5]),
- {ok, Pos2} = dets_utils:position(H2, eof),
- ?DEBUGF("Writing file size ~p, eof at ~p~n", [Pos2+4, Pos2]),
- dets_utils:pwrite(H2, [{Pos2, <<(Pos2 + 4):32>>}]).
-
-%% -> [term()] | throw({Head, Error})
-slot_objs(H, Slot) when Slot >= H#head.next ->
- '$end_of_table';
-slot_objs(H, Slot) ->
- {_Pos, Chain} = chain(H, Slot),
- collect_chain(H, Chain).
-
-collect_chain(_H, 0) -> [];
-collect_chain(H, Pos) ->
- {Next, _Sz, Term} = prterm(H, Pos, ?ReadAhead),
- [Term | collect_chain(H, Next)].
-
-db_hash(Key, Head) ->
- H = h(Key, Head#head.hash_bif),
- Hash = H rem Head#head.m,
- if
- Hash < Head#head.n ->
- H rem (Head#head.m2); % H rem (2 * m)
- true ->
- Hash
- end.
-
-h(I, phash) -> erlang:phash(I, ?BIG) - 1;
-h(I, HF) -> erlang:HF(I, ?BIG) - 1. %% stupid BIF has 1 counts.
-
-no_slots(_Head) ->
- undefined.
-
-table_parameters(_Head) ->
- undefined.
-
-%% Re-hashing a segment, starting with SlotStart.
-%%
-%% On the average, half of the objects of the chain are put into a new
-%% chain. If the slot of the old chain is i, then the slot of the new
-%% chain is i+m.
-%% Note that the insertion of objects into the new chain is simplified
-%% by the fact that the chains are not sorted on key, which means that
-%% each moved object can be inserted first in the new chain.
-%% (It is also a fact that the objects with the same key are not sorted.)
-%%
-%% -> {ok, Writes} | throw({Head, Error})
-re_hash(Head, SlotStart) ->
- {SlotPos, _4} = slot_position(SlotStart),
- {ok, Bin} = dets_utils:pread(Head, SlotPos, 4*?SEGSZ, 0),
- {Read, Cs} = split_bin(SlotPos, Bin, [], []),
- re_hash_read(Head, [], Read, Cs).
-
-split_bin(Pos, <<P:32, B/binary>>, R, Cs) ->
- if
- P =:= 0 ->
- split_bin(Pos+4, B, R, Cs);
- true ->
- split_bin(Pos+4, B, [{P,?ReadAhead} | R], [[Pos] | Cs])
- end;
-split_bin(_Pos, <<>>, R, Cs) ->
- {R, Cs}.
-
-re_hash_read(Head, Cs, R, RCs) ->
- {ok, Bins} = dets_utils:pread(R, Head),
- re_hash_read(Head, R, RCs, Bins, Cs, [], []).
-
-re_hash_read(Head, [{Pos, Size} | Ps], [C | Cs],
- [<<Next:32, Sz:32, _Status:32, Bin0/binary>> | Bins],
- DoneCs, R, RCs) ->
- case byte_size(Bin0) of
- BinSz when BinSz >= Sz ->
- case catch binary_to_term(Bin0) of
- {'EXIT', _Error} ->
- throw(dets_utils:corrupt_reason(Head, bad_object));
- Term ->
- Key = element(Head#head.keypos, Term),
- New = h(Key, Head#head.hash_bif) rem Head#head.m2,
- NC = case New >= Head#head.m of
- true -> [{Pos,New} | C];
- false -> [Pos | C]
- end,
- if
- Next =:= 0 ->
- NDoneCs = [NC | DoneCs],
- re_hash_read(Head, Ps, Cs, Bins, NDoneCs, R, RCs);
- true ->
- NR = [{Next,?ReadAhead} | R],
- NRCs = [NC | RCs],
- re_hash_read(Head, Ps, Cs, Bins, DoneCs, NR, NRCs)
- end
- end;
- BinSz when Size =:= BinSz+?OHDSZ ->
- NR = [{Pos, Sz+?OHDSZ} | R],
- re_hash_read(Head, Ps, Cs, Bins, DoneCs, NR, [C | RCs]);
- _BinSz ->
- throw({Head, {error, {premature_eof, Head#head.filename}}})
- end;
-re_hash_read(Head, [], [], [], Cs, [], []) ->
- re_hash_traverse_chains(Cs, Head, [], [], []);
-re_hash_read(Head, [], [], [], Cs, R, RCs) ->
- re_hash_read(Head, Cs, R, RCs).
-
-re_hash_traverse_chains([C | Cs], Head, Rs, Ns, Ws) ->
- case re_hash_find_new(C, Rs, start, start) of
- false ->
- re_hash_traverse_chains(Cs, Head, Rs, Ns, Ws);
- {NRs, FirstNew, LastNew} ->
- LastInNew = case C of
- [{_,_} | _] -> true;
- _ -> false
- end,
- N = {FirstNew, LastNew, LastInNew},
- NWs = re_hash_link(C, start, start, start, Ws),
- re_hash_traverse_chains(Cs, Head, NRs, [N | Ns], NWs)
- end;
-re_hash_traverse_chains([], Head, Rs, Ns, Ws) ->
- {ok, Bins} = dets_utils:pread(Rs, Head),
- {ok, insert_new(Rs, Bins, Ns, Ws)}.
-
-re_hash_find_new([{Pos,NewSlot} | C], R, start, start) ->
- {SPos, _4} = slot_position(NewSlot),
- re_hash_find_new(C, [{SPos,4} | R], Pos, Pos);
-re_hash_find_new([{Pos,_SPos} | C], R, _FirstNew, LastNew) ->
- re_hash_find_new(C, R, Pos, LastNew);
-re_hash_find_new([_Pos | C], R, FirstNew, LastNew) ->
- re_hash_find_new(C, R, FirstNew, LastNew);
-re_hash_find_new([], _R, start, start) ->
- false;
-re_hash_find_new([], R, FirstNew, LastNew) ->
- {R, FirstNew, LastNew}.
-
-re_hash_link([{Pos,_SPos} | C], LastOld, start, _LastInNew, Ws) ->
- re_hash_link(C, LastOld, Pos, true, Ws);
-re_hash_link([{Pos,_SPos} | C], LastOld, LastNew, false, Ws) ->
- re_hash_link(C, LastOld, Pos, true, [{Pos,<<LastNew:32>>} | Ws]);
-re_hash_link([{Pos,_SPos} | C], LastOld, _LastNew, LastInNew, Ws) ->
- re_hash_link(C, LastOld, Pos, LastInNew, Ws);
-re_hash_link([Pos | C], start, LastNew, true, Ws) ->
- re_hash_link(C, Pos, LastNew, false, [{Pos,<<0:32>>} | Ws]);
-re_hash_link([Pos | C], LastOld, LastNew, true, Ws) ->
- re_hash_link(C, Pos, LastNew, false, [{Pos,<<LastOld:32>>} | Ws]);
-re_hash_link([Pos | C], _LastOld, LastNew, LastInNew, Ws) ->
- re_hash_link(C, Pos, LastNew, LastInNew, Ws);
-re_hash_link([], _LastOld, _LastNew, _LastInNew, Ws) ->
- Ws.
-
-insert_new([{NewSlotPos,_4} | Rs], [<<P:32>> = PB | Bins], [N | Ns], Ws) ->
- {FirstNew, LastNew, LastInNew} = N,
- Ws1 = case P of
- 0 when LastInNew ->
- Ws;
- 0 ->
- [{LastNew, <<0:32>>} | Ws];
- _ ->
- [{LastNew, PB} | Ws]
- end,
- NWs = [{NewSlotPos, <<FirstNew:32>>} | Ws1],
- insert_new(Rs, Bins, Ns, NWs);
-insert_new([], [], [], Ws) ->
- Ws.
-
-%% When writing the cache, a 'work list' is first created:
-%% WorkList = [{Key, {Delete,Lookup,[Inserted]}}]
-%% Delete = keep | delete
-%% Lookup = skip | lookup
-%% Inserted = {object(), No}
-%% No = integer()
-%% If No =< 0 then there will be -No instances of object() on the file
-%% when the cache has been written. If No > 0 then No instances of
-%% object() will be added to the file.
-%% If Delete has the value 'delete', then all objects with the key Key
-%% have been deleted. (This could be viewed as a shorthand for {Object,0}
-%% for each object Object on the file not mentioned in some Inserted.)
-%% If Lookup has the value 'lookup', all objects with the key Key will
-%% be returned.
-%%
-
-%% -> {NewHead, [LookedUpObject], pwrite_list()} | throw({NewHead, Error})
-write_cache(Head) ->
- #head{cache = C, type = Type} = Head,
- case dets_utils:is_empty_cache(C) of
- true -> {Head, [], []};
- false ->
- {NewC, _MaxInserts, PerKey} = dets_utils:reset_cache(C),
- %% NoInsertedKeys is an upper limit on the number of new keys.
- {WL, NoInsertedKeys} = make_wl(PerKey, Type),
- Head1 = Head#head{cache = NewC},
- case may_grow(Head1, NoInsertedKeys, once) of
- {Head2, ok} ->
- eval_work_list(Head2, WL);
- HeadError ->
- throw(HeadError)
- end
- end.
-
-make_wl(PerKey, Type) ->
- make_wl(PerKey, Type, [], 0).
-
-make_wl([{Key,L} | PerKey], Type, WL, Ins) ->
- [Cs | I] = wl(L, Type),
- make_wl(PerKey, Type, [{Key,Cs} | WL], Ins+I);
-make_wl([], _Type, WL, Ins) ->
- {WL, Ins}.
-
-wl(L, Type) ->
- wl(L, Type, keep, skip, 0, []).
-
-wl([{_Seq, delete_key} | Cs], Type, _Del, Lookup, _I, _Objs) ->
- wl(Cs, Type, delete, Lookup, 0, []);
-wl([{_Seq, {delete_object, Object}} | Cs], Type, Del, Lookup, I, Objs) ->
- NObjs = lists:keydelete(Object, 1, Objs),
- wl(Cs, Type, Del, Lookup, I, [{Object,0} | NObjs]);
-wl([{_Seq, {insert, Object}} | Cs], Type, _Del, Lookup, _I, _Objs)
- when Type =:= set ->
- wl(Cs, Type, delete, Lookup, 1, [{Object,-1}]);
-wl([{_Seq, {insert, Object}} | Cs], Type, Del, Lookup, _I, Objs) ->
- NObjs =
- case lists:keyfind(Object, 1, Objs) of
- {_, 0} ->
- lists:keyreplace(Object, 1, Objs, {Object,-1});
- {_, _C} when Type =:= bag -> % C =:= 1; C =:= -1
- Objs;
- {_, C} when C < 0 -> % when Type =:= duplicate_bag
- lists:keyreplace(Object, 1, Objs, {Object,C-1});
- {_, C} -> % when C > 0, Type =:= duplicate_bag
- lists:keyreplace(Object, 1, Objs, {Object,C+1});
- false when Del =:= delete ->
- [{Object, -1} | Objs];
- false ->
- [{Object, 1} | Objs]
- end,
- wl(Cs, Type, Del, Lookup, 1, NObjs);
-wl([{_Seq, {lookup,_Pid}=Lookup} | Cs], Type, Del, _Lookup, I, Objs) ->
- wl(Cs, Type, Del, Lookup, I, Objs);
-wl([], _Type, Del, Lookup, I, Objs) ->
- [{Del, Lookup, Objs} | I].
-
-%% -> {NewHead, ok} | {NewHead, Error}
-may_grow(Head, 0, once) ->
- {Head, ok};
-may_grow(Head, _N, _How) when Head#head.fixed =/= false ->
- {Head, ok};
-may_grow(#head{access = read}=Head, _N, _How) ->
- {Head, ok};
-may_grow(Head, _N, _How) when Head#head.next >= ?MAXOBJS ->
- {Head, ok};
-may_grow(Head, N, How) ->
- Extra = erlang:min(2*?SEGSZ, Head#head.no_objects + N - Head#head.next),
- case catch may_grow1(Head, Extra, How) of
- {error, Reason} -> % alloc may throw error
- {Head, {error, Reason}};
- Reply ->
- Reply
- end.
-
-may_grow1(Head, Extra, many_times) when Extra > ?SEGSZ ->
- Reply = grow(Head, 1, undefined),
- self() ! ?DETS_CALL(self(), may_grow),
- Reply;
-may_grow1(Head, Extra, _How) ->
- grow(Head, Extra, undefined).
-
-%% -> {Head, ok} | throw({Head, Error})
-grow(Head, Extra, _SegZero) when Extra =< 0 ->
- {Head, ok};
-grow(Head, Extra, undefined) ->
- grow(Head, Extra, seg_zero());
-grow(Head, Extra, SegZero) ->
- #head{n = N, next = Next, m = M} = Head,
- SegNum = ?SLOT2SEG(Next),
- {Head0, Ws1} = allocate_segment(Head, SegZero, SegNum),
- {Head1, ok} = dets_utils:pwrite(Head0, Ws1),
- %% If re_hash fails, segp_cache has been called, but it does not matter.
- {ok, Ws2} = re_hash(Head1, N),
- {Head2, ok} = dets_utils:pwrite(Head1, Ws2),
- NewHead =
- if
- N + ?SEGSZ =:= M ->
- Head2#head{n = 0, next = Next + ?SEGSZ, m = 2 * M, m2 = 4 * M};
- true ->
- Head2#head{n = N + ?SEGSZ, next = Next + ?SEGSZ}
- end,
- grow(NewHead, Extra - ?SEGSZ, SegZero).
-
-seg_zero() ->
- <<0:(4*?SEGSZ)/unit:8>>.
-
-find_object(Head, Object) ->
- Key = element(Head#head.keypos, Object),
- Slot = db_hash(Key, Head),
- find_object(Head, Object, Slot).
-
-find_object(H, _Obj, Slot) when Slot >= H#head.next ->
- false;
-find_object(H, Obj, Slot) ->
- {_Pos, Chain} = chain(H, Slot),
- case catch find_obj(H, Obj, Chain) of
- {ok, Pos} ->
- {ok, Pos};
- _Else ->
- false
- end.
-
-find_obj(H, Obj, Pos) when Pos > 0 ->
- {Next, _Sz, Term} = prterm(H, Pos, ?ReadAhead),
- if
- Term == Obj ->
- {ok, Pos};
- true ->
- find_obj(H, Obj, Next)
- end.
-
-%% Given, a slot, return the {Pos, Chain} in the file where the
-%% objects hashed to this slot reside. Pos is the position in the
-%% file where the chain pointer is written and Chain is the position
-%% in the file where the first object resides.
-chain(Head, Slot) ->
- Pos = ?SEGADDR(?SLOT2SEG(Slot)),
- Segment = get_segp(Pos),
- FinalPos = Segment + (4 * ?REM2(Slot, ?SEGSZ)),
- {ok, <<Chain:32>>} = dets_utils:pread(Head, FinalPos, 4, 0),
- {FinalPos, Chain}.
-
-%%%
-%%% Cache routines depending on the dets file format.
-%%%
-
-%% -> {Head, [LookedUpObject], pwrite_list()} | throw({Head, Error})
-eval_work_list(Head, WorkLists) ->
- SWLs = tag_with_slot(WorkLists, Head, []),
- P1 = dets_utils:family(SWLs),
- {PerSlot, SlotPositions} = remove_slot_tag(P1, [], []),
- {ok, Bins} = dets_utils:pread(SlotPositions, Head),
- first_object(PerSlot, SlotPositions, Bins, Head, [], [], [], []).
-
-tag_with_slot([{K,_} = WL | WLs], Head, L) ->
- tag_with_slot(WLs, Head, [{db_hash(K, Head), WL} | L]);
-tag_with_slot([], _Head, L) ->
- L.
-
-remove_slot_tag([{S,SWLs} | SSWLs], Ls, SPs) ->
- remove_slot_tag(SSWLs, [SWLs | Ls], [slot_position(S) | SPs]);
-remove_slot_tag([], Ls, SPs) ->
- {Ls, SPs}.
-
-%% The initial chain pointers and the first object in each chain are
-%% read "in parallel", that is, with one call to file:pread/2 (two
-%% calls altogether). The following chain objects are read one by
-%% one. This is a compromise: if the chains are long and threads are
-%% active, it would be faster to keep a state for each chain and read
-%% the objects of the chains in parallel, but the overhead would be
-%% quite substantial.
-
-first_object([WorkLists | SPs], [{P1,_4} | Ss], [<<P2:32>> | Bs], Head,
- ObjsToRead, ToRead, Ls, LU) when P2 =:= 0 ->
- L0 = [{old,P1}],
- {L, NLU} = eval_slot(Head, ?ReadAhead, P2, WorkLists, L0, LU),
- first_object(SPs, Ss, Bs, Head, ObjsToRead, ToRead, [L | Ls], NLU);
-first_object([WorkLists | SPs], [{P1,_4} | Ss], [<<P2:32>> | Bs], Head,
- ObjsToRead, ToRead, Ls, LU) ->
- E = {P1,P2,WorkLists},
- first_object(SPs, Ss, Bs, Head,
- [E | ObjsToRead], [{P2, ?ReadAhead} | ToRead], Ls, LU);
-first_object([], [], [], Head, ObjsToRead, ToRead, Ls, LU) ->
- {ok, Bins} = dets_utils:pread(ToRead, Head),
- case catch eval_first(Bins, ObjsToRead, Head, Ls, LU) of
- {ok, NLs, NLU} ->
- case create_writes(NLs, Head, [], 0) of
- {Head1, [], 0} ->
- {Head1, NLU, []};
- {Head1, Ws, No} ->
- {NewHead, Ws2} = update_no_objects(Head1, Ws, No),
- {NewHead, NLU, Ws2}
- end;
- _Error ->
- throw(dets_utils:corrupt_reason(Head, bad_object))
- end.
-
-%% Update no_objects on the file too, if the number of segments that
-%% dets:fsck/6 use for estimate has changed.
-update_no_objects(Head, Ws, 0) -> {Head, Ws};
-update_no_objects(Head, Ws, Delta) ->
- No = Head#head.no_objects,
- NewNo = No + Delta,
- NWs =
- if
- NewNo > ?MAXOBJS ->
- Ws;
- ?SLOT2SEG(No) =:= ?SLOT2SEG(NewNo) ->
- Ws;
- true ->
- [{?NO_OBJECTS_POS, <<NewNo:32>>} | Ws]
- end,
- {Head#head{no_objects = NewNo}, NWs}.
-
-eval_first([<<Next:32, Sz:32, _Status:32, Bin/binary>> | Bins],
- [SP | SPs], Head, Ls, LU) ->
- {P1, P2, WLs} = SP,
- L0 = [{old,P1}],
- case byte_size(Bin) of
- BinSz when BinSz >= Sz ->
- Term = binary_to_term(Bin),
- Key = element(Head#head.keypos, Term),
- {L, NLU} = find_key(Head, P2, Next, Sz, Term, Key, WLs, L0, LU),
- eval_first(Bins, SPs, Head, [L | Ls], NLU);
- _BinSz ->
- {L, NLU} = eval_slot(Head, Sz+?OHDSZ, P2, WLs, L0, LU),
- eval_first(Bins, SPs, Head, [L | Ls], NLU)
- end;
-eval_first([], [], _Head, Ls, LU) ->
- {ok, Ls, LU}.
-
-eval_slot(_Head, _TrySize, _Pos=0, [], L, LU) ->
- {L, LU};
-eval_slot(Head, _TrySize, Pos=0, [WL | WLs], L, LU) ->
- {_Key, {_Delete, LookUp, Objects}} = WL,
- {NL, NLU} = end_of_key(Objects, LookUp, L, []),
- eval_slot(Head, ?ReadAhead, Pos, WLs, NL, NLU++LU);
-eval_slot(Head, TrySize, Pos, WLs, L, LU) ->
- {NextPos, Size, Term} = prterm(Head, Pos, TrySize),
- Key = element(Head#head.keypos, Term),
- find_key(Head, Pos, NextPos, Size, Term, Key, WLs, L, LU).
-
-find_key(Head, Pos, NextPos, Size, Term, Key, WLs, L, LU) ->
- case lists:keyfind(Key, 1, WLs) of
- {_, {Delete, LookUp, Objects}} = WL ->
- NWLs = lists:delete(WL, WLs),
- {NewObjects, NL, LUK} = eval_object(Size, Term, Delete, LookUp,
- Objects, Head, Pos, L, []),
- eval_key(Key, Delete, LookUp, NewObjects, Head, NextPos,
- NWLs, NL, LU, LUK);
- false ->
- L0 = [{old,Pos} | L],
- eval_slot(Head, ?ReadAhead, NextPos, WLs, L0, LU)
- end.
-
-eval_key(_Key, _Delete, Lookup, _Objects, Head, Pos, WLs, L, LU, LUK)
- when Head#head.type =:= set ->
- NLU = case Lookup of
- {lookup, Pid} -> [{Pid,LUK} | LU];
- skip -> LU
- end,
- eval_slot(Head, ?ReadAhead, Pos, WLs, L, NLU);
-eval_key(_Key, _Delete, LookUp, Objects, Head, Pos, WLs, L, LU, LUK)
- when Pos =:= 0 ->
- {NL, NLU} = end_of_key(Objects, LookUp, L, LUK),
- eval_slot(Head, ?ReadAhead, Pos, WLs, NL, NLU++LU);
-eval_key(Key, Delete, LookUp, Objects, Head, Pos, WLs, L, LU, LUK) ->
- {NextPos, Size, Term} = prterm(Head, Pos, ?ReadAhead),
- case element(Head#head.keypos, Term) of
- Key ->
- {NewObjects, NL, LUK1} =
- eval_object(Size, Term, Delete, LookUp,Objects,Head,Pos,L,LUK),
- eval_key(Key, Delete, LookUp, NewObjects, Head, NextPos, WLs,
- NL, LU, LUK1);
- Key2 ->
- {L1, NLU} = end_of_key(Objects, LookUp, L, LUK),
- find_key(Head, Pos, NextPos, Size, Term, Key2, WLs, L1, NLU++LU)
- end.
-
-%% All objects in Objects have the key Key.
-eval_object(Size, Term, Delete, LookUp, Objects, Head, Pos, L, LU) ->
- Type = Head#head.type,
- case lists:keyfind(Term, 1, Objects) of
- {_Object, N} when N =:= 0 ->
- L1 = [{delete,Pos,Size} | L],
- {Objects, L1, LU};
- {_Object, N} when N < 0, Type =:= set ->
- L1 = [{old,Pos} | L],
- wl_lookup(LookUp, Objects, Term, L1, LU);
- {Object, _N} when Type =:= bag -> % when N =:= 1; N =:= -1
- L1 = [{old,Pos} | L],
- Objects1 = lists:keydelete(Object, 1, Objects),
- wl_lookup(LookUp, Objects1, Term, L1, LU);
- {Object, N} when N < 0, Type =:= duplicate_bag ->
- L1 = [{old,Pos} | L],
- Objects1 = lists:keyreplace(Object, 1, Objects, {Object,N+1}),
- wl_lookup(LookUp, Objects1, Term, L1, LU);
- {_Object, N} when N > 0, Type =:= duplicate_bag ->
- L1 = [{old,Pos} | L],
- wl_lookup(LookUp, Objects, Term, L1, LU);
- false when Type =:= set, Delete =:= delete ->
- case lists:keyfind(-1, 2, Objects) of
- false -> % no inserted object, perhaps deleted objects
- L1 = [{delete,Pos,Size} | L],
- {[], L1, LU};
- {Term2, -1} ->
- Bin2 = term_to_binary(Term2),
- NSize = byte_size(Bin2),
- Overwrite =
- if
- NSize =:= Size ->
- true;
- true ->
- SizePos = sz2pos(Size+?OHDSZ),
- NSizePos = sz2pos(NSize+?OHDSZ),
- SizePos =:= NSizePos
- end,
- E = if
- Overwrite ->
- {overwrite,Bin2,Pos};
- true ->
- {replace,Bin2,Pos,Size}
- end,
- wl_lookup(LookUp, [], Term2, [E | L], LU)
- end;
- false when Delete =:= delete ->
- L1 = [{delete,Pos,Size} | L],
- {Objects, L1, LU};
- false ->
- L1 = [{old,Pos} | L],
- wl_lookup(LookUp, Objects, Term, L1, LU)
- end.
-
-%% Inlined.
-wl_lookup({lookup,_}, Objects, Term, L, LU) ->
- {Objects, L, [Term | LU]};
-wl_lookup(skip, Objects, _Term, L, LU) ->
- {Objects, L, LU}.
-
-end_of_key([{Object,N0} | Objs], LookUp, L, LU) when N0 =/= 0 ->
- N = abs(N0),
- NL = [{insert,N,term_to_binary(Object)} | L],
- NLU = case LookUp of
- {lookup, _} ->
- lists:duplicate(N, Object) ++ LU;
- skip ->
- LU
- end,
- end_of_key(Objs, LookUp, NL, NLU);
-end_of_key([_ | Objects], LookUp, L, LU) ->
- end_of_key(Objects, LookUp, L, LU);
-end_of_key([], {lookup,Pid}, L, LU) ->
- {L, [{Pid,LU}]};
-end_of_key([], skip, L, LU) ->
- {L, LU}.
-
-create_writes([L | Ls], H, Ws, No) ->
- {NH, NWs, NNo} = create_writes(L, H, Ws, No, 0, true),
- create_writes(Ls, NH, NWs, NNo);
-create_writes([], H, Ws, No) ->
- {H, lists:reverse(Ws), No}.
-
-create_writes([{old,Pos} | L], H, Ws, No, _Next, true) ->
- create_writes(L, H, Ws, No, Pos, true);
-create_writes([{old,Pos} | L], H, Ws, No, Next, false) ->
- W = {Pos, <<Next:32>>},
- create_writes(L, H, [W | Ws], No, Pos, true);
-create_writes([{insert,N,Bin} | L], H, Ws, No, Next, _NextIsOld) ->
- {NH, NWs, Pos} = create_inserts(N, H, Ws, Next, byte_size(Bin), Bin),
- create_writes(L, NH, NWs, No+N, Pos, false);
-create_writes([{overwrite,Bin,Pos} | L], H, Ws, No, Next, _) ->
- Size = byte_size(Bin),
- W = {Pos, [<<Next:32, Size:32, ?ACTIVE:32>>, Bin]},
- create_writes(L, H, [W | Ws], No, Pos, true);
-create_writes([{replace,Bin,Pos,OSize} | L], H, Ws, No, Next, _) ->
- Size = byte_size(Bin),
- {H1, _} = dets_utils:free(H, Pos, OSize+?OHDSZ),
- {NH, NewPos, _} = dets_utils:alloc(H1, ?OHDSZ + Size),
- W1 = {NewPos, [<<Next:32, Size:32, ?ACTIVE:32>>, Bin]},
- NWs = if
- Pos =:= NewPos ->
- [W1 | Ws];
- true ->
- W2 = {Pos+?STATUS_POS, <<?FREE:32>>},
- [W1,W2 | Ws]
- end,
- create_writes(L, NH, NWs, No, NewPos, false);
-create_writes([{delete,Pos,Size} | L], H, Ws, No, Next, _) ->
- {NH, _} = dets_utils:free(H, Pos, Size+?OHDSZ),
- NWs = [{Pos+?STATUS_POS,<<?FREE:32>>} | Ws],
- create_writes(L, NH, NWs, No-1, Next, false);
-create_writes([], H, Ws, No, _Next, _NextIsOld) ->
- {H, Ws, No}.
-
-create_inserts(0, H, Ws, Next, _Size, _Bin) ->
- {H, Ws, Next};
-create_inserts(N, H, Ws, Next, Size, Bin) ->
- {NH, Pos, _} = dets_utils:alloc(H, ?OHDSZ + Size),
- W = {Pos, [<<Next:32, Size:32, ?ACTIVE:32>>, Bin]},
- create_inserts(N-1, NH, [W | Ws], Pos, Size, Bin).
-
-slot_position(S) ->
- Pos = ?SEGADDR(?SLOT2SEG(S)),
- Segment = get_segp(Pos),
- FinalPos = Segment + (4 * ?REM2(S, ?SEGSZ)),
- {FinalPos, 4}.
-
-%% Twice the size of a segment due to the bug in sz2pos/1. Inlined.
-actual_seg_size() ->
- ?POW(sz2pos(?SEGSZ*4)-1).
-
-segp_cache(Pos, Segment) ->
- put(Pos, Segment).
-
-%% Inlined.
-get_segp(Pos) ->
- get(Pos).
-
-%% Bug: If Sz0 is equal to 2**k for some k, then 2**(k+1) bytes are
-%% allocated (wasting 2**k bytes).
-sz2pos(N) ->
- 1 + dets_utils:log2(N+1).
-
-scan_objs(_Head, Bin, From, To, L, Ts, R, _Type) ->
- scan_objs(Bin, From, To, L, Ts, R).
-
-scan_objs(Bin, From, To, L, Ts, -1) ->
- {stop, Bin, From, To, L, Ts};
-scan_objs(B = <<_N:32, Sz:32, St:32, T/binary>>, From, To, L, Ts, R) ->
- if
- St =:= ?ACTIVE;
- St =:= ?FREE -> % deleted after scanning started
- case T of
- <<BinTerm:Sz/binary, T2/binary>> ->
- NTs = [BinTerm | Ts],
- OSz = Sz + ?OHDSZ,
- Skip = ?POW(sz2pos(OSz)-1) - OSz,
- F2 = From + OSz,
- NR = if
- R < 0 ->
- R + 1;
- true ->
- R + OSz + Skip
- end,
- scan_skip(T2, F2, To, Skip, L, NTs, NR);
- _ ->
- {more, From, To, L, Ts, R, Sz+?OHDSZ}
- end;
- true -> % a segment
- scan_skip(B, From, To, actual_seg_size(), L, Ts, R)
- end;
-scan_objs(_B, From, To, L, Ts, R) ->
- {more, From, To, L, Ts, R, 0}.
-
-scan_skip(Bin, From, To, Skip, L, Ts, R) when From + Skip < To ->
- SkipPos = From + Skip,
- case Bin of
- <<_:Skip/binary, Tail/binary>> ->
- scan_objs(Tail, SkipPos, To, L, Ts, R);
- _ ->
- {more, SkipPos, To, L, Ts, R, 0}
- end;
-scan_skip(Bin, From, To, Skip, L, Ts, R) when From + Skip =:= To ->
- scan_next_allocated(Bin, From, To, L, Ts, R);
-scan_skip(_Bin, From, _To, Skip, L, Ts, R) -> % when From + Skip > _To
- From1 = From + Skip,
- {more, From1, From1, L, Ts, R, 0}.
-
-scan_next_allocated(_Bin, _From, To, <<>>=L, Ts, R) ->
- {more, To, To, L, Ts, R, 0};
-scan_next_allocated(Bin, From0, _To, <<From:32, To:32, L/binary>>, Ts, R) ->
- Skip = From - From0,
- scan_skip(Bin, From0, To, Skip, L, Ts, R).
-
-%% Read term from file at position Pos
-prterm(Head, Pos, ReadAhead) ->
- Res = dets_utils:pread(Head, Pos, ?OHDSZ, ReadAhead),
- ?DEBUGF("file:pread(~tp, ~p, ?) -> ~p~n", [Head#head.filename, Pos, Res]),
- {ok, <<Next:32, Sz:32, _Status:32, Bin0/binary>>} = Res,
- ?DEBUGF("{Next, Sz} = ~p~n", [{Next, Sz}]),
- Bin = case byte_size(Bin0) of
- Actual when Actual >= Sz ->
- Bin0;
- _ ->
- {ok, Bin1} = dets_utils:pread(Head, Pos + ?OHDSZ, Sz, 0),
- Bin1
- end,
- Term = binary_to_term(Bin),
- {Next, Sz, Term}.
-
-%%%%%%%%%%%%%%%%% DEBUG functions %%%%%%%%%%%%%%%%
-
-file_info(FH) ->
- #fileheader{closed_properly = CP, keypos = Kp,
- m = M, next = Next, n = N, version = Version,
- type = Type, no_objects = NoObjects}
- = FH,
- if
- CP =:= 0 ->
- {error, not_closed};
- FH#fileheader.cookie =/= ?MAGIC ->
- {error, not_a_dets_file};
- FH#fileheader.version =/= ?FILE_FORMAT_VERSION ->
- {error, bad_version};
- true ->
- {ok, [{closed_properly,CP},{keypos,Kp},{m, M},
- {n,N},{next,Next},{no_objects,NoObjects},
- {type,Type},{version,Version}]}
- end.
-
-v_segments(H) ->
- v_segments(H, 0).
-
-v_segments(_H, ?SEGARRSZ) ->
- done;
-v_segments(H, SegNo) ->
- Seg = dets_utils:read_4(H#head.fptr, ?SEGADDR(SegNo)),
- if
- Seg =:= 0 ->
- done;
- true ->
- io:format("SEGMENT ~w ", [SegNo]),
- io:format("At position ~w~n", [Seg]),
- v_segment(H, SegNo, Seg, 0),
- v_segments(H, SegNo+1)
- end.
-
-v_segment(_H, _, _SegPos, ?SEGSZ) ->
- done;
-v_segment(H, SegNo, SegPos, SegSlot) ->
- Slot = SegSlot + (SegNo * ?SEGSZ),
- Chain = dets_utils:read_4(H#head.fptr, SegPos + (4 * SegSlot)),
- if
- Chain =:= 0 -> %% don't print empty chains
- true;
- true ->
- io:format(" <~p>~p: [",[SegPos + (4 * SegSlot), Slot]),
- print_chain(H, Chain)
- end,
- v_segment(H, SegNo, SegPos, SegSlot+1).
-
-print_chain(_H, 0) ->
- io:format("] \n", []);
-print_chain(H, Pos) ->
- {ok, _} = file:position(H#head.fptr, Pos),
- case rterm(H#head.fptr) of
- {ok, 0, _Sz, Term} ->
- io:format("<~p>~p] \n",[Pos, Term]);
- {ok, Next, _Sz, Term} ->
- io:format("<~p>~p, ", [Pos, Term]),
- print_chain(H, Next);
- Other ->
- io:format("~nERROR ~p~n", [Other])
- end.
-
-%% Can't be used at the bucket level!!!!
-%% Only when we go down a chain
-rterm(F) ->
- case catch rterm2(F) of
- {'EXIT', Reason} -> %% truncated DAT file
- dets_utils:vformat("** dets: Corrupt or truncated dets file~n",
- []),
- {error, Reason};
- Other ->
- Other
- end.
-
-rterm2(F) ->
- {ok, <<Next:32, Sz:32, _:32>>} = file:read(F, ?OHDSZ),
- {ok, Bin} = file:read(F, Sz),
- Term = binary_to_term(Bin),
- {ok, Next, Sz, Term}.
-
-
diff --git a/lib/stdlib/src/dets_v9.erl b/lib/stdlib/src/dets_v9.erl
index 6c406fc03a..3ab8f87ebf 100644
--- a/lib/stdlib/src/dets_v9.erl
+++ b/lib/stdlib/src/dets_v9.erl
@@ -24,8 +24,8 @@
-export([mark_dirty/1, read_file_header/2,
check_file_header/2, do_perform_save/1, initiate_file/11,
- prep_table_copy/9, init_freelist/2, fsck_input/4,
- bulk_input/3, output_objs/4, bchunk_init/2,
+ prep_table_copy/9, init_freelist/1, fsck_input/4,
+ bulk_input/3, output_objs/3, bchunk_init/2,
try_bchunk_header/2, compact_init/3, read_bchunks/2,
write_cache/1, may_grow/3, find_object/2, slot_objs/2,
scan_objs/8, db_hash/2, no_slots/1, table_parameters/1]).
@@ -228,8 +228,8 @@
-define(CLOSED_PROPERLY_POS, 8).
-define(D_POS, 20).
-%%% Dets file versions up to 8 are handled in dets_v8. This module
-%%% handles version 9, introduced in R8.
+%%% This module handles Dets file format version 9, introduced in
+%%% Erlang/OTP R8.
%%%
%%% Version 9(a) tables have 256 reserved bytes in the file header,
%%% all initialized to zero.
@@ -249,32 +249,32 @@
-define(OHDSZ, 8). % The size of the object header, in bytes.
-define(STATUS_POS, 4). % Position of the status field.
--define(OHDSZ_v8, 12). % The size of the version 8 object header.
-
%% The size of each object is a multiple of 16.
%% BUMP is used when repairing files.
-define(BUMP, 16).
-%%% '$hash' is the value of HASH_PARMS in R8, '$hash2' is the value in R9.
+%%% '$hash' is the value of HASH_PARMS in Erlang/OTP R8, '$hash2' is
+%%% the value in Erlang/OTP R9.
%%%
%%% The fields of the ?HASH_PARMS records are the same, but having
-%%% different tags makes bchunk_init on R8 nodes reject data from R9
-%%% nodes, and vice versa. This is overkill, and due to an oversight.
-%%% What should have been done in R8 was to check the hash method, not
-%%% only the type of the table and the key position. R8 nodes cannot
-%%% handle the phash2 method.
+%%% different tags makes bchunk_init on Erlang/OTP R8 nodes reject
+%%% data from Erlang/OTP R9 nodes, and vice versa. This is overkill,
+%%% and due to an oversight. What should have been done in Erlang/OTP
+%%% R8 was to check the hash method, not only the type of the table
+%%% and the key position. Erlang/OTP R8 nodes cannot handle the phash2
+%%% method.
-define(HASH_PARMS, '$hash2').
-define(BCHUNK_FORMAT_VERSION, 1).
-record(?HASH_PARMS, {
- file_format_version,
+ file_format_version,
bchunk_format_version,
file, type, keypos, hash_method,
n,m,next,
min,max,
no_objects,no_keys,
- no_colls % [{LogSz,NoColls}], NoColls >= 0
+ no_colls :: no_colls()
}).
-define(ACTUAL_SEG_SIZE, (?SEGSZ*4)).
@@ -364,10 +364,8 @@ init_file(Fd, Tab, Fname, Type, Kp, MinSlots, MaxSlots, Ram, CacheSz,
filename = Fname,
name = Tab,
cache = dets_utils:new_cache(CacheSz),
- version = ?FILE_FORMAT_VERSION,
bump = ?BUMP,
- base = ?BASE, % to be overwritten
- mod = ?MODULE
+ base = ?BASE % to be overwritten
},
FreeListsPointer = 0,
@@ -457,7 +455,7 @@ alloc_seg(Head, SegZero, SegNo, Part) ->
{NewHead, InitSegment, [SegPointer]}.
%% Read free lists (using a Buddy System) from file.
-init_freelist(Head, true) ->
+init_freelist(Head) ->
Pos = Head#head.freelists_p,
free_lists_from_file(Head, Pos).
@@ -510,12 +508,10 @@ read_file_header(Fd, FileName) ->
md5 = erlang:md5(MD5DigestedPart),
trailer = FileSize + FlBase,
eof = EOF,
- n = N,
- mod = ?MODULE},
+ n = N},
{ok, Fd, FH}.
-%% -> {ok, head(), ExtraInfo} | {error, Reason} (Reason lacking file name)
-%% ExtraInfo = true
+%% -> {ok, head()} | {error, Reason} (Reason lacking file name)
check_file_header(FH, Fd) ->
HashBif = code_to_hash_method(FH#fileheader.hash_method),
Test =
@@ -534,14 +530,14 @@ check_file_header(FH, Fd) ->
HashBif =:= undefined ->
{error, bad_hash_bif};
FH#fileheader.closed_properly =:= ?CLOSED_PROPERLY ->
- {ok, true};
+ ok;
FH#fileheader.closed_properly =:= ?NOT_PROPERLY_CLOSED ->
{error, not_closed};
true ->
{error, not_a_dets_file}
end,
case Test of
- {ok, ExtraInfo} ->
+ ok ->
MaxObjSize = max_objsize(FH#fileheader.no_colls),
H = #head{
m = FH#fileheader.m,
@@ -563,11 +559,9 @@ check_file_header(FH, Fd) ->
min_no_slots = FH#fileheader.min_no_slots,
max_no_slots = FH#fileheader.max_no_slots,
no_collections = FH#fileheader.no_colls,
- version = ?FILE_FORMAT_VERSION,
- mod = ?MODULE,
bump = ?BUMP,
base = FH#fileheader.fl_base},
- {ok, H, ExtraInfo};
+ {ok, H};
Error ->
Error
end.
@@ -621,7 +615,7 @@ no_segs(NoSlots) ->
%%%
%%% bulk_input/3. Initialization, the general case (any stream of objects).
-%%% output_objs/4. Initialization (general case) and repair.
+%%% output_objs/3. Initialization (general case) and repair.
%%% bchunk_init/2. Initialization using bchunk.
bulk_input(Head, InitFun, _Cntrs) ->
@@ -678,7 +672,7 @@ bulk_objects([], _Head, Kp, Seq, L) when is_integer(Kp), is_integer(Seq) ->
-define(OBJ_COUNTER, 2).
-define(KEY_COUNTER, 3).
-output_objs(OldV, Head, SlotNums, Cntrs) when OldV =< 9 ->
+output_objs(Head, SlotNums, Cntrs) ->
fun(close) ->
%% Make sure that the segments are initialized in case
%% init_table has been called.
@@ -686,31 +680,31 @@ output_objs(OldV, Head, SlotNums, Cntrs) when OldV =< 9 ->
Acc = [], % This is the only way Acc can be empty.
true = ets:insert(Cntrs, {?FSCK_SEGMENT,0,[],0}),
true = ets:insert(Cntrs, {?COUNTERS, 0, 0}),
- Fun = output_objs2(foo, Acc, OldV, Head, Cache, Cntrs,
+ Fun = output_objs2(foo, Acc, Head, Cache, Cntrs,
SlotNums, bar),
Fun(close);
([]) ->
- output_objs(OldV, Head, SlotNums, Cntrs);
+ output_objs(Head, SlotNums, Cntrs);
(L) ->
%% Information about number of objects per size is not
%% relevant for version 9. It is the number of collections
%% that matters.
true = ets:delete_all_objects(Cntrs),
true = ets:insert(Cntrs, {?COUNTERS, 0, 0}),
- Es = bin2term(L, OldV, Head#head.keypos),
+ Es = bin2term(L, Head#head.keypos),
%% The cache is a tuple indexed by the (log) size. An element
%% is [BinaryObject].
Cache = ?VEMPTY,
{NE, NAcc, NCache} = output_slots(Es, Head, Cache, Cntrs, 0, 0),
- output_objs2(NE, NAcc, OldV, Head, NCache, Cntrs, SlotNums, 1)
+ output_objs2(NE, NAcc, Head, NCache, Cntrs, SlotNums, 1)
end.
-output_objs2(E, Acc, OldV, Head, Cache, SizeT, SlotNums, 0) ->
+output_objs2(E, Acc, Head, Cache, SizeT, SlotNums, 0) ->
NCache = write_all_sizes(Cache, SizeT, Head, more),
%% Number of handled file_sorter chunks before writing:
Max = erlang:max(1, erlang:min(tuple_size(NCache), 10)),
- output_objs2(E, Acc, OldV, Head, NCache, SizeT, SlotNums, Max);
-output_objs2(E, Acc, OldV, Head, Cache, SizeT, SlotNums, ChunkI) ->
+ output_objs2(E, Acc, Head, NCache, SizeT, SlotNums, Max);
+output_objs2(E, Acc, Head, Cache, SizeT, SlotNums, ChunkI) ->
fun(close) ->
{_, [], Cache1} =
if
@@ -747,11 +741,10 @@ output_objs2(E, Acc, OldV, Head, Cache, SizeT, SlotNums, ChunkI) ->
end
end;
(L) ->
- Es = bin2term(L, OldV, Head#head.keypos),
+ Es = bin2term(L, Head#head.keypos),
{NE, NAcc, NCache} =
output_slots(E, Es, Acc, Head, Cache, SizeT, 0, 0),
- output_objs2(NE, NAcc, OldV, Head, NCache, SizeT, SlotNums,
- ChunkI-1)
+ output_objs2(NE, NAcc, Head, NCache, SizeT, SlotNums, ChunkI-1)
end.
%%% Compaction.
@@ -1245,10 +1238,8 @@ allocate_all(Head, [{LSize,_,Data,NoCollections} | DTL], L) ->
E = {LSize,Addr,Data,NoCollections},
allocate_all(NewHead, DTL, [E | L]).
-bin2term(Bin, 9, Kp) ->
- bin2term1(Bin, Kp, []);
-bin2term(Bin, 8, Kp) ->
- bin2term_v8(Bin, Kp, []).
+bin2term(Bin, Kp) ->
+ bin2term1(Bin, Kp, []).
bin2term1([<<Slot:32, Seq:32, BinTerm/binary>> | BTs], Kp, L) ->
Term = binary_to_term(BinTerm),
@@ -1257,13 +1248,6 @@ bin2term1([<<Slot:32, Seq:32, BinTerm/binary>> | BTs], Kp, L) ->
bin2term1([], _Kp, L) ->
lists:reverse(L).
-bin2term_v8([<<Slot:32, BinTerm/binary>> | BTs], Kp, L) ->
- Term = binary_to_term(BinTerm),
- Key = element(Kp, Term),
- bin2term_v8(BTs, Kp, [{Slot, Key, foo, Term, BinTerm} | L]);
-bin2term_v8([], _Kp, L) ->
- lists:reverse(L).
-
write_all_sizes({}=Cache, _SizeT, _Head, _More) ->
Cache;
write_all_sizes(Cache, SizeT, Head, More) ->
@@ -1461,7 +1445,7 @@ temp_file(Head, SizeT, N) ->
%% Does not close Fd.
fsck_input(Head, Fd, Cntrs, FileHeader) ->
MaxSz0 = case FileHeader#fileheader.has_md5 of
- true when is_integer(FileHeader#fileheader.no_colls) ->
+ true when is_list(FileHeader#fileheader.no_colls) ->
?POW(max_objsize(FileHeader#fileheader.no_colls));
_ ->
%% The file is not compressed, so the bucket size
@@ -1485,10 +1469,10 @@ fsck_input(Head, State, Fd, MaxSz, Cntrs) ->
done ->
end_of_input;
{done, L, _Seq} ->
- R = count_input(Head, Cntrs, L),
+ R = count_input(L),
{R, fsck_input(Head, done, Fd, MaxSz, Cntrs)};
{cont, L, Bin, Pos, Seq} ->
- R = count_input(Head, Cntrs, L),
+ R = count_input(L),
FR = fsck_objs(Bin, Head#head.keypos, Head, [], Seq),
NewState = fsck_read(FR, Pos, Fd, MaxSz, Head),
{R, fsck_input(Head, NewState, Fd, MaxSz, Cntrs)}
@@ -1496,20 +1480,9 @@ fsck_input(Head, State, Fd, MaxSz, Cntrs) ->
end.
%% The ets table Cntrs is used for counting objects per size.
-count_input(Head, Cntrs, L) when Head#head.version =:= 8 ->
- count_input1(Cntrs, L, []);
-count_input(_Head, _Cntrs, L) ->
+count_input(L) ->
lists:reverse(L).
-count_input1(Cntrs, [[LogSz | B] | Ts], L) ->
- case catch ets:update_counter(Cntrs, LogSz, 1) of
- N when is_integer(N) -> ok;
- _Badarg -> true = ets:insert(Cntrs, {LogSz, 1})
- end,
- count_input1(Cntrs, Ts, [B | L]);
-count_input1(_Cntrs, [], L) ->
- L.
-
fsck_read(Pos, F, L, Seq) ->
case file:position(F, Pos) of
{ok, _} ->
@@ -1564,11 +1537,6 @@ fsck_objs(Bin = <<Sz:32, Status:32, Tail/binary>>, Kp, Head, L, Seq) ->
fsck_objs(Bin, _Kp, _Head, L, Seq) ->
{more, Bin, 0, L, Seq}.
-make_objects([{K,BT}|Os], Seq, Kp, Head, L) when Head#head.version =:= 8 ->
- LogSz = dets_v8:sz2pos(byte_size(BT)+?OHDSZ_v8),
- Slot = dets_v8:db_hash(K, Head),
- Obj = [LogSz | <<Slot:32, LogSz:8, BT/binary>>],
- make_objects(Os, Seq, Kp, Head, [Obj | L]);
make_objects([{K,BT} | Os], Seq, Kp, Head, L) ->
Obj = make_object(Head, K, Seq, BT),
make_objects(Os, Seq+1, Kp, Head, [Obj | L]);
@@ -1607,7 +1575,7 @@ do_perform_save(H) ->
FileHeader = file_header(H1, FreeListsPointer, ?CLOSED_PROPERLY),
case dets_utils:debug_mode() of
true ->
- TmpHead0 = init_freelist(H1#head{fixed = false}, true),
+ TmpHead0 = init_freelist(H1#head{fixed = false}),
TmpHead = TmpHead0#head{base = H1#head.base},
case
catch dets_utils:all_allocated_as_list(TmpHead)
@@ -1794,7 +1762,7 @@ table_parameters(Head) ->
(E, A) -> [E | A]
end, [], CL),
NoColls = lists:reverse(NoColls0),
- #?HASH_PARMS{file_format_version = Head#head.version,
+ #?HASH_PARMS{file_format_version = ?FILE_FORMAT_VERSION,
bchunk_format_version = ?BCHUNK_FORMAT_VERSION,
file = filename:basename(Head#head.filename),
type = Head#head.type,
diff --git a/lib/stdlib/src/dict.erl b/lib/stdlib/src/dict.erl
index f921e28ef6..9449ba3dc2 100644
--- a/lib/stdlib/src/dict.erl
+++ b/lib/stdlib/src/dict.erl
@@ -38,7 +38,7 @@
%% Standard interface.
-export([new/0,is_key/2,to_list/1,from_list/1,size/1,is_empty/1]).
--export([fetch/2,find/2,fetch_keys/1,erase/2]).
+-export([fetch/2,find/2,fetch_keys/1,erase/2,take/2]).
-export([store/3,append/3,append_list/3,update/3,update/4,update_counter/3]).
-export([fold/3,map/2,filter/2,merge/3]).
@@ -172,6 +172,27 @@ erase_key(Key, [E|Bkt0]) ->
{[E|Bkt1],Dc};
erase_key(_, []) -> {[],0}.
+-spec take(Key, Dict) -> {Value, Dict1} | error when
+ Dict :: dict(Key, Value),
+ Dict1 :: dict(Key, Value),
+ Key :: term(),
+ Value :: term().
+
+take(Key, D0) ->
+ Slot = get_slot(D0, Key),
+ case on_bucket(fun (B0) -> take_key(Key, B0) end, D0, Slot) of
+ {D1,{Value,Dc}} ->
+ {Value, maybe_contract(D1, Dc)};
+ {_,error} -> error
+ end.
+
+take_key(Key, [?kv(Key,Val)|Bkt]) ->
+ {Bkt,{Val,1}};
+take_key(Key, [E|Bkt0]) ->
+ {Bkt1,Res} = take_key(Key, Bkt0),
+ {[E|Bkt1],Res};
+take_key(_, []) -> {[],error}.
+
-spec store(Key, Value, Dict1) -> Dict2 when
Dict1 :: dict(Key, Value),
Dict2 :: dict(Key, Value).
diff --git a/lib/stdlib/src/epp.erl b/lib/stdlib/src/epp.erl
index 40eba4ad67..61d755ba55 100644
--- a/lib/stdlib/src/epp.erl
+++ b/lib/stdlib/src/epp.erl
@@ -286,7 +286,7 @@ parse_file(Epp) ->
{warning,W} ->
[{warning,W}|parse_file(Epp)];
{eof,Location} ->
- [{eof,erl_anno:new(Location)}]
+ [{eof,Location}]
end.
-spec default_encoding() -> source_encoding().
diff --git a/lib/stdlib/src/erl_anno.erl b/lib/stdlib/src/erl_anno.erl
index d32c34dabd..d0310f52e2 100644
--- a/lib/stdlib/src/erl_anno.erl
+++ b/lib/stdlib/src/erl_anno.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2015. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -42,7 +42,7 @@
%% Debug: define DEBUG to make sure that annotations are handled as an
%% opaque type. Note that all abstract code need to be compiled with
-%% DEBUG=true. See also ./erl_pp.erl.
+%% DEBUG=true. See also ./erl_pp.erl and ./erl_parse.yrl.
%-define(DEBUG, true).
@@ -52,7 +52,11 @@
| {'record', record()}
| {'text', string()}.
+-ifdef(DEBUG).
+-opaque anno() :: [annotation(), ...].
+-else.
-opaque anno() :: location() | [annotation(), ...].
+-endif.
-type anno_term() :: term().
-type column() :: pos_integer().
diff --git a/lib/stdlib/src/erl_compile.erl b/lib/stdlib/src/erl_compile.erl
index a6ae398d03..76db2eeacd 100644
--- a/lib/stdlib/src/erl_compile.erl
+++ b/lib/stdlib/src/erl_compile.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -337,7 +337,7 @@ file_or_directory(Name) ->
make_term(Str) ->
case erl_scan:string(Str) of
{ok, Tokens, _} ->
- case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of
+ case erl_parse:parse_term(Tokens ++ [{dot, erl_anno:new(1)}]) of
{ok, Term} -> Term;
{error, {_,_,Reason}} ->
io:format(?STDERR, "~ts: ~ts~n", [Reason, Str]),
diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl
index ebcbc54ab1..16220bceb4 100644
--- a/lib/stdlib/src/erl_expand_records.erl
+++ b/lib/stdlib/src/erl_expand_records.erl
@@ -17,7 +17,8 @@
%%
%% %CopyrightEnd%
%%
-%% Purpose : Expand records into tuples.
+%% Purpose: Expand records into tuples. Also add explicit module
+%% names to calls to imported functions and BIFs.
%% N.B. Although structs (tagged tuples) are not yet allowed in the
%% language there is code included in pattern/2 and expr/3 (commented out)
@@ -29,13 +30,13 @@
-import(lists, [map/2,foldl/3,foldr/3,sort/1,reverse/1,duplicate/2]).
--record(exprec, {compile=[], % Compile flags
- vcount=0, % Variable counter
- imports=[], % Imports
- records=dict:new(), % Record definitions
- strict_ra=[], % strict record accesses
- checked_ra=[] % successfully accessed records
- }).
+-record(exprec, {compile=[], % Compile flags
+ vcount=0, % Variable counter
+ calltype=#{}, % Call types
+ records=#{}, % Record definitions
+ strict_ra=[], % strict record accesses
+ checked_ra=[] % successfully accessed records
+ }).
-spec(module(AbsForms, CompileOptions) -> AbsForms2 when
AbsForms :: [erl_parse:abstract_form()],
@@ -46,22 +47,34 @@
%% erl_lint without errors.
module(Fs0, Opts0) ->
Opts = compiler_options(Fs0) ++ Opts0,
- St0 = #exprec{compile = Opts},
+ Calltype = init_calltype(Fs0),
+ St0 = #exprec{compile = Opts, calltype = Calltype},
{Fs,_St} = forms(Fs0, St0),
Fs.
compiler_options(Forms) ->
lists:flatten([C || {attribute,_,compile,C} <- Forms]).
+init_calltype(Forms) ->
+ Locals = [{{Name,Arity},local} || {function,_,Name,Arity,_} <- Forms],
+ Ctype = maps:from_list(Locals),
+ init_calltype_imports(Forms, Ctype).
+
+init_calltype_imports([{attribute,_,import,{Mod,Fs}}|T], Ctype0) ->
+ true = is_atom(Mod),
+ Ctype = foldl(fun(FA, Acc) ->
+ Acc#{FA=>{imported,Mod}}
+ end, Ctype0, Fs),
+ init_calltype_imports(T, Ctype);
+init_calltype_imports([_|T], Ctype) ->
+ init_calltype_imports(T, Ctype);
+init_calltype_imports([], Ctype) -> Ctype.
+
forms([{attribute,_,record,{Name,Defs}}=Attr | Fs], St0) ->
NDefs = normalise_fields(Defs),
- St = St0#exprec{records=dict:store(Name, NDefs, St0#exprec.records)},
+ St = St0#exprec{records=maps:put(Name, NDefs, St0#exprec.records)},
{Fs1, St1} = forms(Fs, St),
{[Attr | Fs1], St1};
-forms([{attribute,L,import,Is} | Fs0], St0) ->
- St1 = import(Is, St0),
- {Fs,St2} = forms(Fs0, St1),
- {[{attribute,L,import,Is} | Fs], St2};
forms([{function,L,N,A,Cs0} | Fs0], St0) ->
{Cs,St1} = clauses(Cs0, St0),
{Fs,St2} = forms(Fs0, St1),
@@ -334,8 +347,16 @@ expr({'receive',Line,Cs0,To0,ToEs0}, St0) ->
{ToEs,St2} = exprs(ToEs0, St1),
{Cs,St3} = clauses(Cs0, St2),
{{'receive',Line,Cs,To,ToEs},St3};
-expr({'fun',_,{function,_F,_A}}=Fun, St) ->
- {Fun,St};
+expr({'fun',Lf,{function,F,A}}=Fun0, St0) ->
+ case erl_internal:bif(F, A) of
+ true ->
+ {As,St1} = new_vars(A, Lf, St0),
+ Cs = [{clause,Lf,As,[],[{call,Lf,{atom,Lf,F},As}]}],
+ Fun = {'fun',Lf,{clauses,Cs}},
+ expr(Fun, St1);
+ false ->
+ {Fun0,St0}
+ end;
expr({'fun',_,{function,_M,_F,_A}}=Fun, St) ->
{Fun,St};
expr({'fun',Line,{clauses,Cs0}}, St0) ->
@@ -352,14 +373,30 @@ expr({call,Line,{remote,_,{atom,_,erlang},{atom,_,is_record}},
expr({call,Line,{tuple,_,[{atom,_,erlang},{atom,_,is_record}]},
[A,{atom,_,Name}]}, St) ->
record_test(Line, A, Name, St);
+expr({call,Line,{atom,_La,record_info},[_,_]=As0}, St0) ->
+ {As,St1} = expr_list(As0, St0),
+ record_info_call(Line, As, St1);
expr({call,Line,{atom,_La,N}=Atom,As0}, St0) ->
{As,St1} = expr_list(As0, St0),
Ar = length(As),
- case {N,Ar} =:= {record_info,2} andalso not imported(N, Ar, St1) of
- true ->
- record_info_call(Line, As, St1);
- false ->
- {{call,Line,Atom,As},St1}
+ NA = {N,Ar},
+ case St0#exprec.calltype of
+ #{NA := local} ->
+ {{call,Line,Atom,As},St1};
+ #{NA := {imported,Module}} ->
+ ModAtom = {atom,Line,Module},
+ {{call,Line,{remote,Line,ModAtom,Atom},As},St1};
+ _ ->
+ case erl_internal:bif(N, Ar) of
+ true ->
+ ModAtom = {atom,Line,erlang},
+ {{call,Line,{remote,Line,ModAtom,Atom},As},St1};
+ false ->
+ %% Call to a module_info/0,1 or one of the
+ %% pseudo-functions in the shell. Leave it as
+ %% a local call.
+ {{call,Line,Atom,As},St1}
+ end
end;
expr({call,Line,{remote,Lr,M,F},As0}, St0) ->
{[M1,F1 | As1],St1} = expr_list([M,F | As0], St0),
@@ -470,9 +507,16 @@ lc_tq(Line, [{b_generate,Lg,P0,G0} | Qs0], St0) ->
{P1,St2} = pattern(P0, St1),
{Qs1,St3} = lc_tq(Line, Qs0, St2),
{[{b_generate,Lg,P1,G1} | Qs1],St3};
-lc_tq(Line, [F0 | Qs0], St0) ->
+lc_tq(Line, [F0 | Qs0], #exprec{calltype=Calltype}=St0) ->
%% Allow record/2 and expand out as guard test.
- case erl_lint:is_guard_test(F0) of
+ IsOverriden = fun(FA) ->
+ case Calltype of
+ #{FA := local} -> true;
+ #{FA := {imported,_}} -> true;
+ _ -> false
+ end
+ end,
+ case erl_lint:is_guard_test(F0, [], IsOverriden) of
true ->
{F1,St1} = guard_test(F0, St0),
{Qs1,St2} = lc_tq(Line, Qs0, St1),
@@ -502,7 +546,7 @@ normalise_fields(Fs) ->
%% record_fields(RecordName, State)
%% find_field(FieldName, Fields)
-record_fields(R, St) -> dict:fetch(R, St#exprec.records).
+record_fields(R, St) -> maps:get(R, St#exprec.records).
find_field(F, [{record_field,_,{atom,_,F},Val} | _]) -> {ok,Val};
find_field(F, [_ | Fs]) -> find_field(F, Fs);
@@ -769,6 +813,13 @@ bin_element({bin_element,Line,Expr,Size,Type}, {Es,St0}) ->
end,
{[{bin_element,Line,Expr1,Size1,Type} | Es],St2}.
+new_vars(N, L, St) -> new_vars(N, L, St, []).
+
+new_vars(N, L, St0, Vs) when N > 0 ->
+ {V,St1} = new_var(L, St0),
+ new_vars(N-1, L, St1, [V|Vs]);
+new_vars(0, _L, St, Vs) -> {Vs,St}.
+
new_var(L, St0) ->
{New,St1} = new_var_name(St0),
{{var,L,New},St1}.
@@ -783,18 +834,6 @@ make_list(Ts, Line) ->
call_error(L, R) ->
{call,L,{remote,L,{atom,L,erlang},{atom,L,error}},[R]}.
-import({Mod,Fs}, St) ->
- St#exprec{imports=add_imports(Mod, Fs, St#exprec.imports)};
-import(_Mod0, St) ->
- St.
-
-add_imports(Mod, [F | Fs], Is) ->
- add_imports(Mod, Fs, orddict:store(F, Mod, Is));
-add_imports(_, [], Is) -> Is.
-
-imported(F, A, St) ->
- orddict:is_key({F,A}, St#exprec.imports).
-
%%%
%%% Replace is_record/3 in guards with matching if possible.
%%%
diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl
index c08328b4b7..006e7946af 100644
--- a/lib/stdlib/src/erl_internal.erl
+++ b/lib/stdlib/src/erl_internal.erl
@@ -54,6 +54,8 @@
-export([is_type/2]).
+-export([add_predefined_functions/1]).
+
%%---------------------------------------------------------------------------
%% Erlang builtin functions allowed in guards.
@@ -61,42 +63,28 @@
Name :: atom(),
Arity :: arity().
+%% Please keep the alphabetical order.
guard_bif(abs, 1) -> true;
-guard_bif(float, 1) -> true;
-guard_bif(trunc, 1) -> true;
-guard_bif(round, 1) -> true;
-guard_bif(length, 1) -> true;
-guard_bif(hd, 1) -> true;
-guard_bif(tl, 1) -> true;
-guard_bif(size, 1) -> true;
+guard_bif(binary_part, 2) -> true;
+guard_bif(binary_part, 3) -> true;
guard_bif(bit_size, 1) -> true;
guard_bif(byte_size, 1) -> true;
+guard_bif(ceil, 1) -> true;
guard_bif(element, 2) -> true;
-guard_bif(self, 0) -> true;
+guard_bif(float, 1) -> true;
+guard_bif(floor, 1) -> true;
+guard_bif(hd, 1) -> true;
+guard_bif(length, 1) -> true;
guard_bif(map_size, 1) -> true;
guard_bif(node, 0) -> true;
guard_bif(node, 1) -> true;
+guard_bif(round, 1) -> true;
+guard_bif(self, 0) -> true;
+guard_bif(size, 1) -> true;
+guard_bif(tl, 1) -> true;
+guard_bif(trunc, 1) -> true;
guard_bif(tuple_size, 1) -> true;
-guard_bif(is_atom, 1) -> true;
-guard_bif(is_binary, 1) -> true;
-guard_bif(is_bitstring, 1) -> true;
-guard_bif(is_boolean, 1) -> true;
-guard_bif(is_float, 1) -> true;
-guard_bif(is_function, 1) -> true;
-guard_bif(is_function, 2) -> true;
-guard_bif(is_integer, 1) -> true;
-guard_bif(is_list, 1) -> true;
-guard_bif(is_map, 1) -> true;
-guard_bif(is_number, 1) -> true;
-guard_bif(is_pid, 1) -> true;
-guard_bif(is_port, 1) -> true;
-guard_bif(is_reference, 1) -> true;
-guard_bif(is_tuple, 1) -> true;
-guard_bif(is_record, 2) -> true;
-guard_bif(is_record, 3) -> true;
-guard_bif(binary_part, 2) -> true;
-guard_bif(binary_part, 3) -> true;
-guard_bif(Name, A) when is_atom(Name), is_integer(A) -> false.
+guard_bif(Name, A) -> new_type_test(Name, A).
%% Erlang type tests.
-spec type_test(Name, Arity) -> boolean() when
@@ -109,10 +97,11 @@ type_test(Name, Arity) ->
%% Erlang new-style type tests.
-spec new_type_test(Name::atom(), Arity::arity()) -> boolean().
+%% Please keep the alphabetical order.
new_type_test(is_atom, 1) -> true;
-new_type_test(is_boolean, 1) -> true;
new_type_test(is_binary, 1) -> true;
new_type_test(is_bitstring, 1) -> true;
+new_type_test(is_boolean, 1) -> true;
new_type_test(is_float, 1) -> true;
new_type_test(is_function, 1) -> true;
new_type_test(is_function, 2) -> true;
@@ -122,10 +111,10 @@ new_type_test(is_map, 1) -> true;
new_type_test(is_number, 1) -> true;
new_type_test(is_pid, 1) -> true;
new_type_test(is_port, 1) -> true;
-new_type_test(is_reference, 1) -> true;
-new_type_test(is_tuple, 1) -> true;
new_type_test(is_record, 2) -> true;
new_type_test(is_record, 3) -> true;
+new_type_test(is_reference, 1) -> true;
+new_type_test(is_tuple, 1) -> true;
new_type_test(Name, A) when is_atom(Name), is_integer(A) -> false.
%% Erlang old-style type tests.
@@ -271,6 +260,7 @@ bif(bitsize, 1) -> true;
bif(bit_size, 1) -> true;
bif(bitstring_to_list, 1) -> true;
bif(byte_size, 1) -> true;
+bif(ceil, 1) -> true;
bif(check_old_code, 1) -> true;
bif(check_process_code, 2) -> true;
bif(check_process_code, 3) -> true;
@@ -291,6 +281,7 @@ bif(float_to_list, 1) -> true;
bif(float_to_list, 2) -> true;
bif(float_to_binary, 1) -> true;
bif(float_to_binary, 2) -> true;
+bif(floor, 1) -> true;
bif(garbage_collect, 0) -> true;
bif(garbage_collect, 1) -> true;
bif(garbage_collect, 2) -> true;
@@ -584,3 +575,68 @@ is_type(term, 0) -> true;
is_type(timeout, 0) -> true;
is_type(tuple, 0) -> true;
is_type(_, _) -> false.
+
+%%%
+%%% Add and export the pre-defined functions:
+%%%
+%%% module_info/0
+%%% module_info/1
+%%% behaviour_info/1 (optional)
+%%%
+
+-spec add_predefined_functions(Forms) -> UpdatedForms when
+ Forms :: [erl_parse:abstract_form() | erl_parse:form_info()],
+ UpdatedForms :: [erl_parse:abstract_form() | erl_parse:form_info()].
+
+add_predefined_functions(Forms) ->
+ Forms ++ predefined_functions(Forms).
+
+predefined_functions(Forms) ->
+ Attrs = [{Name,Val} || {attribute,_,Name,Val} <- Forms],
+ {module,Mod} = lists:keyfind(module, 1, Attrs),
+ Callbacks = [Callback || {callback,Callback} <- Attrs],
+ OptionalCallbacks = get_optional_callbacks(Attrs),
+ Mpf1 = module_predef_func_beh_info(Callbacks, OptionalCallbacks),
+ Mpf2 = module_predef_funcs_mod_info(Mod),
+ Mpf = [erl_parse:new_anno(F) || F <- Mpf1++Mpf2],
+ Exp = [{F,A} || {function,_,F,A,_} <- Mpf],
+ [{attribute,0,export,Exp}|Mpf].
+
+get_optional_callbacks(Attrs) ->
+ L = [O || {optional_callbacks,O} <- Attrs, is_fa_list(O)],
+ lists:append(L).
+
+is_fa_list([{FuncName, Arity}|L])
+ when is_atom(FuncName), is_integer(Arity), Arity >= 0 ->
+ is_fa_list(L);
+is_fa_list([]) -> true;
+is_fa_list(_) -> false.
+
+module_predef_func_beh_info([], _) ->
+ [];
+module_predef_func_beh_info(Callbacks0, OptionalCallbacks) ->
+ Callbacks = [FA || {{_,_}=FA,_} <- Callbacks0],
+ List = make_list(Callbacks),
+ OptionalList = make_list(OptionalCallbacks),
+ [{function,0,behaviour_info,1,
+ [{clause,0,[{atom,0,callbacks}],[],[List]},
+ {clause,0,[{atom,0,optional_callbacks}],[],[OptionalList]}]}].
+
+make_list([]) -> {nil,0};
+make_list([{Name,Arity}|Rest]) ->
+ {cons,0,
+ {tuple,0,
+ [{atom,0,Name},
+ {integer,0,Arity}]},
+ make_list(Rest)}.
+
+module_predef_funcs_mod_info(Mod) ->
+ ModAtom = {atom,0,Mod},
+ [{function,0,module_info,0,
+ [{clause,0,[],[],
+ [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
+ [ModAtom]}]}]},
+ {function,0,module_info,1,
+ [{clause,0,[{var,0,'X'}],[],
+ [{call,0,{remote,0,{atom,0,erlang},{atom,0,get_module_info}},
+ [ModAtom,{var,0,'X'}]}]}]}].
diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl
index e9332ce069..0789f5dfb7 100644
--- a/lib/stdlib/src/erl_lint.erl
+++ b/lib/stdlib/src/erl_lint.erl
@@ -2,7 +2,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -27,7 +27,7 @@
-export([module/1,module/2,module/3,format_error/1]).
-export([exprs/2,exprs_opt/3,used_vars/2]). % Used from erl_eval.erl.
--export([is_pattern_expr/1,is_guard_test/1,is_guard_test/2]).
+-export([is_pattern_expr/1,is_guard_test/1,is_guard_test/2,is_guard_test/3]).
-export([is_guard_expr/1]).
-export([bool_option/4,value_option/3,value_option/7]).
@@ -156,6 +156,8 @@ format_error(pmod_unsupported) ->
"parameterized modules are no longer supported";
%% format_error({redefine_mod_import, M, P}) ->
%% io_lib:format("module '~s' already imported from package '~s'", [M, P]);
+format_error(non_latin1_module_unsupported) ->
+ "module names with non-latin1 characters are not supported";
format_error(invalid_call) ->
"invalid function call";
@@ -238,7 +240,11 @@ format_error({removed_type, MNA, ReplacementMNA, Rel}) ->
io_lib:format("the type ~s was removed in ~s; use ~s instead",
[format_mna(MNA), Rel, format_mna(ReplacementMNA)]);
format_error({obsolete_guard, {F, A}}) ->
- io_lib:format("~p/~p obsolete", [F, A]);
+ io_lib:format("~p/~p obsolete (use is_~p/~p)", [F, A, F, A]);
+format_error({obsolete_guard_overridden,Test}) ->
+ io_lib:format("obsolete ~s/1 (meaning is_~s/1) is illegal when "
+ "there is a local/imported function named is_~p/1 ",
+ [Test,Test,Test]);
format_error({too_many_arguments,Arity}) ->
io_lib:format("too many arguments (~w) - "
"maximum allowed is ~w", [Arity,?MAX_ARGUMENTS]);
@@ -522,7 +528,7 @@ start(File, Opts) ->
true, Opts)},
{export_all,
bool_option(warn_export_all, nowarn_export_all,
- false, Opts)},
+ true, Opts)},
{export_vars,
bool_option(warn_export_vars, nowarn_export_vars,
false, Opts)},
@@ -729,13 +735,27 @@ form(Form, #lint{state=State}=St) ->
start_state({attribute,Line,module,{_,_}}=Form, St0) ->
St1 = add_error(Line, pmod_unsupported, St0),
attribute_state(Form, St1#lint{state=attribute});
-start_state({attribute,_,module,M}, St0) ->
+start_state({attribute,Line,module,M}, St0) ->
St1 = St0#lint{module=M},
- St1#lint{state=attribute};
+ St2 = St1#lint{state=attribute},
+ case is_non_latin1_name(M) of
+ true ->
+ add_error(Line, non_latin1_module_unsupported, St2);
+ false ->
+ St2
+ end;
start_state(Form, St) ->
- St1 = add_error(element(2, Form), undefined_module, St),
+ Anno = case Form of
+ {eof, L} -> erl_anno:new(L);
+ %% {warning, Warning} and {error, Error} not possible here.
+ _ -> element(2, Form)
+ end,
+ St1 = add_error(Anno, undefined_module, St),
attribute_state(Form, St1#lint{state=attribute}).
+is_non_latin1_name(Name) ->
+ lists:any(fun(C) -> C > 255 end, atom_to_list(Name)).
+
%% attribute_state(Form, State) ->
%% State'
@@ -1765,7 +1785,8 @@ bit_size({atom,_Line,all}, _Vt, St, _Check) -> {all,[],St};
bit_size(Size, Vt, St, Check) ->
%% Try to safely evaluate Size if constant to get size,
%% otherwise just treat it as an expression.
- case is_gexpr(Size, St#lint.records) of
+ Info = is_guard_test2_info(St),
+ case is_gexpr(Size, Info) of
true ->
case erl_eval:partial_eval(Size) of
{integer,_ILn,I} -> {I,[],St};
@@ -2000,77 +2021,104 @@ gexpr_list(Es, Vt, St) ->
%% is_guard_test(Expression) -> boolean().
%% Test if a general expression is a guard test.
+%%
+%% Note: Only use this function in contexts where there can be
+%% no definition of a local function that may override a guard BIF
+%% (for example, in the shell).
-spec is_guard_test(Expr) -> boolean() when
Expr :: erl_parse:abstract_expr().
is_guard_test(E) ->
- is_guard_test2(E, dict:new()).
+ is_guard_test2(E, {dict:new(),fun(_) -> false end}).
%% is_guard_test(Expression, Forms) -> boolean().
is_guard_test(Expression, Forms) ->
+ is_guard_test(Expression, Forms, fun(_) -> false end).
+
+
+%% is_guard_test(Expression, Forms, IsOverridden) -> boolean().
+%% Test if a general expression is a guard test.
+%%
+%% IsOverridden({Name,Arity}) should return 'true' if Name/Arity is
+%% a local or imported function in the module. If the abstract code has
+%% passed through erl_expand_records, any call without an explicit
+%% module is to a local function, so IsOverridden can be defined as:
+%%
+%% fun(_) -> true end
+%%
+-spec is_guard_test(Expr, Forms, IsOverridden) -> boolean() when
+ Expr :: erl_parse:abstract_expr(),
+ Forms :: [erl_parse:abstract_form() | erl_parse:form_info()],
+ IsOverridden :: fun((fa()) -> boolean()).
+
+is_guard_test(Expression, Forms, IsOverridden) ->
RecordAttributes = [A || A = {attribute, _, record, _D} <- Forms],
St0 = foldl(fun(Attr0, St1) ->
Attr = set_file(Attr0, "none"),
attribute_state(Attr, St1)
end, start(), RecordAttributes),
- is_guard_test2(set_file(Expression, "nofile"), St0#lint.records).
+ is_guard_test2(set_file(Expression, "nofile"),
+ {St0#lint.records,IsOverridden}).
%% is_guard_test2(Expression, RecordDefs :: dict:dict()) -> boolean().
-is_guard_test2({call,Line,{atom,Lr,record},[E,A]}, RDs) ->
- is_gexpr({call,Line,{atom,Lr,is_record},[E,A]}, RDs);
-is_guard_test2({call,_Line,{atom,_La,Test},As}=Call, RDs) ->
- case erl_internal:type_test(Test, length(As)) of
- true -> is_gexpr_list(As, RDs);
- false -> is_gexpr(Call, RDs)
- end;
-is_guard_test2(G, RDs) ->
+is_guard_test2({call,Line,{atom,Lr,record},[E,A]}, Info) ->
+ is_gexpr({call,Line,{atom,Lr,is_record},[E,A]}, Info);
+is_guard_test2({call,_Line,{atom,_La,Test},As}=Call, {_,IsOverridden}=Info) ->
+ A = length(As),
+ not IsOverridden({Test,A}) andalso
+ case erl_internal:type_test(Test, A) of
+ true -> is_gexpr_list(As, Info);
+ false -> is_gexpr(Call, Info)
+ end;
+is_guard_test2(G, Info) ->
%%Everything else is a guard expression.
- is_gexpr(G, RDs).
+ is_gexpr(G, Info).
%% is_guard_expr(Expression) -> boolean().
%% Test if an expression is a guard expression.
is_guard_expr(E) -> is_gexpr(E, []).
-is_gexpr({var,_L,_V}, _RDs) -> true;
-is_gexpr({char,_L,_C}, _RDs) -> true;
-is_gexpr({integer,_L,_I}, _RDs) -> true;
-is_gexpr({float,_L,_F}, _RDs) -> true;
-is_gexpr({atom,_L,_A}, _RDs) -> true;
-is_gexpr({string,_L,_S}, _RDs) -> true;
-is_gexpr({nil,_L}, _RDs) -> true;
-is_gexpr({cons,_L,H,T}, RDs) -> is_gexpr_list([H,T], RDs);
-is_gexpr({tuple,_L,Es}, RDs) -> is_gexpr_list(Es, RDs);
-%%is_gexpr({struct,_L,_Tag,Es}, RDs) ->
-%% is_gexpr_list(Es, RDs);
-is_gexpr({record_index,_L,_Name,Field}, RDs) ->
- is_gexpr(Field, RDs);
-is_gexpr({record_field,_L,Rec,_Name,Field}, RDs) ->
- is_gexpr_list([Rec,Field], RDs);
-is_gexpr({record,L,Name,Inits}, RDs) ->
- is_gexpr_fields(Inits, L, Name, RDs);
-is_gexpr({bin,_L,Fs}, RDs) ->
+is_gexpr({var,_L,_V}, _Info) -> true;
+is_gexpr({char,_L,_C}, _Info) -> true;
+is_gexpr({integer,_L,_I}, _Info) -> true;
+is_gexpr({float,_L,_F}, _Info) -> true;
+is_gexpr({atom,_L,_A}, _Info) -> true;
+is_gexpr({string,_L,_S}, _Info) -> true;
+is_gexpr({nil,_L}, _Info) -> true;
+is_gexpr({cons,_L,H,T}, Info) -> is_gexpr_list([H,T], Info);
+is_gexpr({tuple,_L,Es}, Info) -> is_gexpr_list(Es, Info);
+%%is_gexpr({struct,_L,_Tag,Es}, Info) ->
+%% is_gexpr_list(Es, Info);
+is_gexpr({record_index,_L,_Name,Field}, Info) ->
+ is_gexpr(Field, Info);
+is_gexpr({record_field,_L,Rec,_Name,Field}, Info) ->
+ is_gexpr_list([Rec,Field], Info);
+is_gexpr({record,L,Name,Inits}, Info) ->
+ is_gexpr_fields(Inits, L, Name, Info);
+is_gexpr({bin,_L,Fs}, Info) ->
all(fun ({bin_element,_Line,E,Sz,_Ts}) ->
- is_gexpr(E, RDs) and (Sz =:= default orelse is_gexpr(Sz, RDs))
+ is_gexpr(E, Info) and (Sz =:= default orelse is_gexpr(Sz, Info))
end, Fs);
-is_gexpr({call,_L,{atom,_Lf,F},As}, RDs) ->
+is_gexpr({call,_L,{atom,_Lf,F},As}, {_,IsOverridden}=Info) ->
A = length(As),
- erl_internal:guard_bif(F, A) andalso is_gexpr_list(As, RDs);
-is_gexpr({call,_L,{remote,_Lr,{atom,_Lm,erlang},{atom,_Lf,F}},As}, RDs) ->
+ not IsOverridden({F,A}) andalso erl_internal:guard_bif(F, A)
+ andalso is_gexpr_list(As, Info);
+is_gexpr({call,_L,{remote,_Lr,{atom,_Lm,erlang},{atom,_Lf,F}},As}, Info) ->
A = length(As),
(erl_internal:guard_bif(F, A) orelse is_gexpr_op(F, A))
- andalso is_gexpr_list(As, RDs);
-is_gexpr({call,L,{tuple,Lt,[{atom,Lm,erlang},{atom,Lf,F}]},As}, RDs) ->
- is_gexpr({call,L,{remote,Lt,{atom,Lm,erlang},{atom,Lf,F}},As}, RDs);
-is_gexpr({op,_L,Op,A}, RDs) ->
- is_gexpr_op(Op, 1) andalso is_gexpr(A, RDs);
-is_gexpr({op,_L,'andalso',A1,A2}, RDs) ->
- is_gexpr_list([A1,A2], RDs);
-is_gexpr({op,_L,'orelse',A1,A2}, RDs) ->
- is_gexpr_list([A1,A2], RDs);
-is_gexpr({op,_L,Op,A1,A2}, RDs) ->
- is_gexpr_op(Op, 2) andalso is_gexpr_list([A1,A2], RDs);
-is_gexpr(_Other, _RDs) -> false.
+ andalso is_gexpr_list(As, Info);
+is_gexpr({call,L,{tuple,Lt,[{atom,Lm,erlang},{atom,Lf,F}]},As}, Info) ->
+ is_gexpr({call,L,{remote,Lt,{atom,Lm,erlang},{atom,Lf,F}},As}, Info);
+is_gexpr({op,_L,Op,A}, Info) ->
+ is_gexpr_op(Op, 1) andalso is_gexpr(A, Info);
+is_gexpr({op,_L,'andalso',A1,A2}, Info) ->
+ is_gexpr_list([A1,A2], Info);
+is_gexpr({op,_L,'orelse',A1,A2}, Info) ->
+ is_gexpr_list([A1,A2], Info);
+is_gexpr({op,_L,Op,A1,A2}, Info) ->
+ is_gexpr_op(Op, 2) andalso is_gexpr_list([A1,A2], Info);
+is_gexpr(_Other, _Info) -> false.
is_gexpr_op(Op, A) ->
try erl_internal:op_type(Op, A) of
@@ -2082,14 +2130,14 @@ is_gexpr_op(Op, A) ->
catch _:_ -> false
end.
-is_gexpr_list(Es, RDs) -> all(fun (E) -> is_gexpr(E, RDs) end, Es).
+is_gexpr_list(Es, Info) -> all(fun (E) -> is_gexpr(E, Info) end, Es).
-is_gexpr_fields(Fs, L, Name, RDs) ->
+is_gexpr_fields(Fs, L, Name, {RDs,_}=Info) ->
IFs = case dict:find(Name, RDs) of
{ok,{_Line,Fields}} -> Fs ++ init_fields(Fs, L, Fields);
error -> Fs
end,
- all(fun ({record_field,_Lf,_Name,V}) -> is_gexpr(V, RDs);
+ all(fun ({record_field,_Lf,_Name,V}) -> is_gexpr(V, Info);
(_Other) -> false end, IFs).
%% exprs(Sequence, VarTable, State) ->
@@ -3193,7 +3241,8 @@ lc_quals([{b_generate,_Line,P,E} | Qs], Vt0, Uvt0, St0) ->
{Vt,Uvt,St} = handle_generator(P,E,Vt0,Uvt0,St1),
lc_quals(Qs, Vt, Uvt, St);
lc_quals([F|Qs], Vt, Uvt, St0) ->
- {Fvt,St1} = case is_guard_test2(F, St0#lint.records) of
+ Info = is_guard_test2_info(St0),
+ {Fvt,St1} = case is_guard_test2(F, Info) of
true -> guard_test(F, Vt, St0);
false -> expr(F, Vt, St0)
end,
@@ -3201,6 +3250,12 @@ lc_quals([F|Qs], Vt, Uvt, St0) ->
lc_quals([], Vt, Uvt, St) ->
{Vt, Uvt, St}.
+is_guard_test2_info(#lint{records=RDs,locals=Locals,imports=Imports}) ->
+ {RDs,fun(FA) ->
+ is_local_function(Locals, FA) orelse
+ is_imported_function(Imports, FA)
+ end}.
+
handle_generator(P,E,Vt,Uvt,St0) ->
{Evt,St1} = expr(E, Vt, St0),
%% Forget variables local to E immediately.
@@ -3618,16 +3673,26 @@ obsolete_guard({call,Line,{atom,Lr,F},As}, St0) ->
false ->
deprecated_function(Line, erlang, F, As, St0);
true ->
- case is_warn_enabled(obsolete_guard, St0) of
- true ->
- add_warning(Lr,{obsolete_guard, {F, Arity}}, St0);
- false ->
- St0
- end
+ St = case is_warn_enabled(obsolete_guard, St0) of
+ true ->
+ add_warning(Lr, {obsolete_guard, {F, Arity}}, St0);
+ false ->
+ St0
+ end,
+ test_overriden_by_local(Lr, F, Arity, St)
end;
obsolete_guard(_G, St) ->
St.
+test_overriden_by_local(Line, OldTest, Arity, St) ->
+ ModernTest = list_to_atom("is_"++atom_to_list(OldTest)),
+ case is_local_function(St#lint.locals, {ModernTest, Arity}) of
+ true ->
+ add_error(Line, {obsolete_guard_overridden,OldTest}, St);
+ false ->
+ St
+ end.
+
%% keyword_warning(Line, Atom, State) -> State.
%% Add warning for atoms that will be reserved keywords in the future.
%% (Currently, no such keywords to warn for.)
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index d2dd2848b5..2dcddeb8c2 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -33,7 +33,6 @@ list tail
list_comprehension lc_expr lc_exprs
binary_comprehension
tuple
-%struct
record_expr record_tuple record_field record_fields
map_expr map_tuple map_field map_field_assoc map_field_exact map_fields map_key
if_expr if_clause if_clauses case_expr cr_clause cr_clauses receive_expr
@@ -108,9 +107,8 @@ type_sig -> fun_type 'when' type_guards : {type, ?anno('$1'), bounded_fun,
type_guards -> type_guard : ['$1'].
type_guards -> type_guard ',' type_guards : ['$1'|'$3'].
-type_guard -> atom '(' top_types ')' : {type, ?anno('$1'), constraint,
- ['$1', '$3']}.
-type_guard -> var '::' top_type : build_def('$1', '$3').
+type_guard -> atom '(' top_types ')' : build_compat_constraint('$1', '$3').
+type_guard -> var '::' top_type : build_constraint('$1', '$3').
top_types -> top_type : ['$1'].
top_types -> top_type ',' top_types : ['$1'|'$3'].
@@ -269,7 +267,6 @@ expr_max -> binary : '$1'.
expr_max -> list_comprehension : '$1'.
expr_max -> binary_comprehension : '$1'.
expr_max -> tuple : '$1'.
-%%expr_max -> struct : '$1'.
expr_max -> '(' expr ')' : '$2'.
expr_max -> 'begin' exprs 'end' : {block,?anno('$1'),'$2'}.
expr_max -> if_expr : '$1'.
@@ -328,10 +325,6 @@ lc_expr -> binary '<=' expr : {b_generate,?anno('$2'),'$1','$3'}.
tuple -> '{' '}' : {tuple,?anno('$1'),[]}.
tuple -> '{' exprs '}' : {tuple,?anno('$1'),'$2'}.
-
-%%struct -> atom tuple :
-%% {struct,?anno('$1'),element(3, '$1'),element(3, '$2')}.
-
map_expr -> '#' map_tuple :
{map, ?anno('$1'),'$2'}.
map_expr -> expr_max '#' map_tuple :
@@ -517,6 +510,22 @@ comp_op -> '>' : '$1'.
comp_op -> '=:=' : '$1'.
comp_op -> '=/=' : '$1'.
+Header
+"%% This file was automatically generated from the file \"erl_parse.yrl\"."
+"%%"
+"%% Copyright Ericsson AB 1996-2015. All Rights Reserved."
+"%%"
+"%% Licensed under the Apache License, Version 2.0 (the \"License\"); you may"
+"%% not use this file except in compliance with the License. You may obtain"
+"%% a copy of the License at <http://www.apache.org/licenses/LICENSE-2.0>"
+"%%"
+"%% Unless required by applicable law or agreed to in writing, software"
+"%% distributed under the License is distributed on an \"AS IS\" BASIS,"
+"%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied."
+"%% See the License for the specific language governing permissions and"
+"%% limitations under the License."
+"".
+
Erlang code.
-export([parse_form/1,parse_exprs/1,parse_term/1]).
@@ -972,6 +981,16 @@ Erlang code.
%% keep track of annotation info in tokens
-define(anno(Tup), element(2, Tup)).
+%-define(DEBUG, true).
+
+-ifdef(DEBUG).
+%% Assumes that erl_anno has been compiled with DEBUG=true.
+-define(ANNO_CHECK(Tokens),
+ [] = [T || T <- Tokens, not is_list(element(2, T))]).
+-else.
+-define(ANNO_CHECK(Tokens), ok).
+-endif.
+
%% Entry points compatible to old erl_parse.
%% These really suck and are only here until Calle gets multiple
%% entry points working.
@@ -981,10 +1000,15 @@ Erlang code.
AbsForm :: abstract_form(),
ErrorInfo :: error_info().
parse_form([{'-',A1},{atom,A2,spec}|Tokens]) ->
- parse([{'-',A1},{'spec',A2}|Tokens]);
+ NewTokens = [{'-',A1},{'spec',A2}|Tokens],
+ ?ANNO_CHECK(NewTokens),
+ parse(NewTokens);
parse_form([{'-',A1},{atom,A2,callback}|Tokens]) ->
- parse([{'-',A1},{'callback',A2}|Tokens]);
+ NewTokens = [{'-',A1},{'callback',A2}|Tokens],
+ ?ANNO_CHECK(NewTokens),
+ parse(NewTokens);
parse_form(Tokens) ->
+ ?ANNO_CHECK(Tokens),
parse(Tokens).
-spec parse_exprs(Tokens) -> {ok, ExprList} | {error, ErrorInfo} when
@@ -992,6 +1016,7 @@ parse_form(Tokens) ->
ExprList :: [abstract_expr()],
ErrorInfo :: error_info().
parse_exprs(Tokens) ->
+ ?ANNO_CHECK(Tokens),
A = erl_anno:new(0),
case parse([{atom,A,f},{'(',A},{')',A},{'->',A}|Tokens]) of
{ok,{function,_Lf,f,0,[{clause,_Lc,[],[],Exprs}]}} ->
@@ -1004,6 +1029,7 @@ parse_exprs(Tokens) ->
Term :: term(),
ErrorInfo :: error_info().
parse_term(Tokens) ->
+ ?ANNO_CHECK(Tokens),
A = erl_anno:new(0),
case parse([{atom,A,f},{'(',A},{')',A},{'->',A}|Tokens]) of
{ok,{function,_Af,f,0,[{clause,_Ac,[],[],[Expr]}]}} ->
@@ -1041,13 +1067,13 @@ build_typed_attribute({atom,Aa,Attr},_) ->
end.
build_type_spec({Kind,Aa}, {SpecFun, TypeSpecs})
- when (Kind =:= spec) or (Kind =:= callback) ->
+ when Kind =:= spec ; Kind =:= callback ->
NewSpecFun =
case SpecFun of
{atom, _, Fun} ->
{Fun, find_arity_from_specs(TypeSpecs)};
- {{atom,_, Mod}, {atom,_, Fun}} ->
- {Mod,Fun,find_arity_from_specs(TypeSpecs)}
+ {{atom, _, Mod}, {atom, _, Fun}} ->
+ {Mod, Fun, find_arity_from_specs(TypeSpecs)}
end,
{attribute,Aa,Kind,{NewSpecFun, TypeSpecs}}.
@@ -1061,11 +1087,24 @@ find_arity_from_specs([Spec|_]) ->
{type, _, 'fun', [{type, _, product, Args},_]} = Fun,
length(Args).
-build_def({var, A, '_'}, _Types) ->
+%% The 'is_subtype(V, T)' syntax is not supported as of Erlang/OTP
+%% 19.0, but is kept for backward compatibility.
+build_compat_constraint({atom, _, is_subtype}, [{var, _, _}=LHS, Type]) ->
+ build_constraint(LHS, Type);
+build_compat_constraint({atom, _, is_subtype}, [LHS, _Type]) ->
+ ret_err(?anno(LHS), "bad type variable");
+build_compat_constraint({atom, A, Atom}, _Types) ->
+ ret_err(A, io_lib:format("unsupported constraint ~w", [Atom])).
+
+build_constraint({atom, _, is_subtype}, [{var, _, _}=LHS, Type]) ->
+ build_constraint(LHS, Type);
+build_constraint({atom, A, Atom}, _Foo) ->
+ ret_err(A, io_lib:format("unsupported constraint ~w", [Atom]));
+build_constraint({var, A, '_'}, _Types) ->
ret_err(A, "bad type variable");
-build_def(LHS, Types) ->
+build_constraint(LHS, Type) ->
IsSubType = {atom, ?anno(LHS), is_subtype},
- {type, ?anno(LHS), constraint, [IsSubType, [LHS, Types]]}.
+ {type, ?anno(LHS), constraint, [IsSubType, [LHS, Type]]}.
lift_unions(T1, {type, _Aa, union, List}) ->
{type, ?anno(T1), union, [T1|List]};
@@ -1509,8 +1548,8 @@ type_preop_prec('#') -> {700,800}.
Fun :: fun((Anno) -> NewAnno),
Anno :: erl_anno:anno(),
NewAnno :: erl_anno:anno(),
- Abstr :: erl_parse_tree(),
- NewAbstr :: erl_parse_tree().
+ Abstr :: erl_parse_tree() | form_info(),
+ NewAbstr :: erl_parse_tree() | form_info().
map_anno(F0, Abstr) ->
F = fun(A, Acc) -> {F0(A), Acc} end,
@@ -1524,7 +1563,7 @@ map_anno(F0, Abstr) ->
Acc1 :: term(),
AccIn :: term(),
AccOut :: term(),
- Abstr :: erl_parse_tree().
+ Abstr :: erl_parse_tree() | form_info().
fold_anno(F0, Acc0, Abstr) ->
F = fun(A, Acc) -> {A, F0(A, Acc)} end,
@@ -1539,15 +1578,15 @@ fold_anno(F0, Acc0, Abstr) ->
Acc1 :: term(),
AccIn :: term(),
AccOut :: term(),
- Abstr :: erl_parse_tree(),
- NewAbstr :: erl_parse_tree().
+ Abstr :: erl_parse_tree() | form_info(),
+ NewAbstr :: erl_parse_tree() | form_info().
mapfold_anno(F, Acc0, Abstr) ->
modify_anno1(Abstr, Acc0, F).
-spec new_anno(Term) -> Abstr when
Term :: term(),
- Abstr :: erl_parse_tree().
+ Abstr :: erl_parse_tree() | form_info().
new_anno(Term) ->
F = fun(L, Acc) -> {erl_anno:new(L), Acc} end,
@@ -1555,14 +1594,14 @@ new_anno(Term) ->
NewAbstr.
-spec anno_to_term(Abstr) -> term() when
- Abstr :: erl_parse_tree().
+ Abstr :: erl_parse_tree() | form_info().
anno_to_term(Abstract) ->
F = fun(Anno, Acc) -> {erl_anno:to_term(Anno), Acc} end,
{NewAbstract, []} = modify_anno1(Abstract, [], F),
NewAbstract.
--spec anno_from_term(Term) -> erl_parse_tree() when
+-spec anno_from_term(Term) -> erl_parse_tree() | form_info() when
Term :: term().
anno_from_term(Term) ->
@@ -1571,19 +1610,6 @@ anno_from_term(Term) ->
NewTerm.
%% Forms.
-%% Recognize what sys_pre_expand does:
-modify_anno1({'fun',A,F,{_,_,_}=Id}, Ac, Mf) ->
- {A1,Ac1} = Mf(A, Ac),
- {F1,Ac2} = modify_anno1(F, Ac1, Mf),
- {{'fun',A1,F1,Id},Ac2};
-modify_anno1({named_fun,A,N,F,{_,_,_}=Id}, Ac, Mf) ->
- {A1,Ac1} = Mf(A, Ac),
- {F1,Ac2} = modify_anno1(F, Ac1, Mf),
- {{named_fun,A1,N,F1,Id},Ac2};
-modify_anno1({attribute,A,N,[V]}, Ac, Mf) ->
- {{attribute,A1,N1,V1},Ac1} = modify_anno1({attribute,A,N,V}, Ac, Mf),
- {{attribute,A1,N1,[V1]},Ac1};
-%% End of sys_pre_expand special forms.
modify_anno1({function,F,A}, Ac, _Mf) ->
{{function,F,A},Ac};
modify_anno1({function,M,F,A}, Ac, Mf) ->
@@ -1620,6 +1646,8 @@ modify_anno1({warning,W}, Ac, _Mf) ->
{{warning,W},Ac};
modify_anno1({error,W}, Ac, _Mf) ->
{{error,W},Ac};
+modify_anno1({eof,L}, Ac, _Mf) ->
+ {{eof,L},Ac};
%% Expressions.
modify_anno1({clauses,Cs}, Ac, Mf) ->
{Cs1,Ac1} = modify_anno1(Cs, Ac, Mf),
diff --git a/lib/stdlib/src/erl_pp.erl b/lib/stdlib/src/erl_pp.erl
index d30cd508c1..ee5e7a11bf 100644
--- a/lib/stdlib/src/erl_pp.erl
+++ b/lib/stdlib/src/erl_pp.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -44,13 +44,22 @@
| {encoding, latin1 | unicode | utf8}).
-type(options() :: hook_function() | [option()]).
--record(pp, {string_fun, char_fun}).
+-record(pp, {value_fun, string_fun, char_fun}).
-record(options, {hook, encoding, opts}).
%-define(DEBUG, true).
-ifdef(DEBUG).
+-define(FORM_TEST(T),
+ _ = case T of
+ {eof, _Line} -> ok;
+ {warning, _W} -> ok;
+ {error, _E} -> ok;
+ _ -> ?TEST(T)
+ end).
+-define(EXPRS_TEST(L),
+ [?TEST(E) || E <- L]).
-define(TEST(T),
%% Assumes that erl_anno has been compiled with DEBUG=true.
%% erl_pp does not use the annoations, but test it anyway.
@@ -62,6 +71,8 @@
erlang:error(badarg, [T])
end).
-else.
+-define(FORM_TEST(T), ok).
+-define(EXPRS_TEST(T), ok).
-define(TEST(T), ok).
-endif.
@@ -80,7 +91,7 @@ form(Thing) ->
Options :: options()).
form(Thing, Options) ->
- ?TEST(Thing),
+ ?FORM_TEST(Thing),
State = state(Options),
frmt(lform(Thing, options(Options)), State).
@@ -124,7 +135,7 @@ guard(Gs) ->
Options :: options()).
guard(Gs, Options) ->
- ?TEST(Gs),
+ ?EXPRS_TEST(Gs),
frmt(lguard(Gs, options(Options)), state(Options)).
-spec(exprs(Expressions) -> io_lib:chars() when
@@ -146,7 +157,7 @@ exprs(Es, Options) ->
Options :: options()).
exprs(Es, I, Options) ->
- ?TEST(Es),
+ ?EXPRS_TEST(Es),
frmt({seq,[],[],[$,],lexprs(Es, options(Options))}, I, state(Options)).
-spec(expr(Expression) -> io_lib:chars() when
@@ -203,11 +214,15 @@ state(_Hook) ->
state().
state() ->
- #pp{string_fun = fun io_lib:write_string_as_latin1/1,
+ Options = [{encoding,latin1}],
+ #pp{value_fun = fun(V) -> io_lib_pretty:print(V, Options) end,
+ string_fun = fun io_lib:write_string_as_latin1/1,
char_fun = fun io_lib:write_char_as_latin1/1}.
unicode_state() ->
- #pp{string_fun = fun io_lib:write_string/1,
+ Options = [{encoding,unicode}],
+ #pp{value_fun = fun(V) -> io_lib_pretty:print(V, Options) end,
+ string_fun = fun io_lib:write_string/1,
char_fun = fun io_lib:write_char/1}.
encoding(Options) ->
@@ -242,31 +257,30 @@ lattribute({attribute,_Line,Name,Arg}, Opts) ->
lattribute(module, {M,Vs}, _Opts) ->
A = a0(),
- attr("module",[{var,A,pname(M)},
- foldr(fun(V, C) -> {cons,A,{var,A,V},C}
- end, {nil,A}, Vs)]);
+ attr(module,[{var,A,pname(M)},
+ foldr(fun(V, C) -> {cons,A,{var,A,V},C}
+ end, {nil,A}, Vs)]);
lattribute(module, M, _Opts) ->
- attr("module", [{var,a0(),pname(M)}]);
+ attr(module, [{var,a0(),pname(M)}]);
lattribute(export, Falist, _Opts) ->
- call({var,a0(),"-export"}, [falist(Falist)], 0, options(none));
+ attrib(export, falist(Falist));
lattribute(import, Name, _Opts) when is_list(Name) ->
- attr("import", [{var,a0(),pname(Name)}]);
+ attr(import, [{var,a0(),pname(Name)}]);
lattribute(import, {From,Falist}, _Opts) ->
- attr("import",[{var,a0(),pname(From)},falist(Falist)]);
+ attrib(import, [leaf(pname(From)),falist(Falist)]);
lattribute(export_type, Talist, _Opts) ->
- call({var,a0(),"-export_type"}, [falist(Talist)], 0, options(none));
+ attrib(export_type, falist(Talist));
lattribute(optional_callbacks, Falist, Opts) ->
- ArgL = try falist(Falist)
- catch _:_ -> abstract(Falist, Opts)
- end,
- call({var,a0(),"-optional_callbacks"}, [ArgL], 0, options(none));
+ try attrib(optional_callbacks, falist(Falist))
+ catch _:_ -> attr(optional_callbacks, [abstract(Falist, Opts)])
+ end;
lattribute(file, {Name,Line}, _Opts) ->
- attr("file", [{string,a0(),Name},{integer,a0(),Line}]);
+ attr(file, [{string,a0(),Name},{integer,a0(),Line}]);
lattribute(record, {Name,Is}, Opts) ->
- Nl = leaf(format("-record(~w,", [Name])),
+ Nl = [leaf("-record("),{atom,Name},$,],
[{first,Nl,record_fields(Is, Opts)},$)];
lattribute(Name, Arg, Options) ->
- attr(write(Name), [abstract(Arg, Options)]).
+ attr(Name, [abstract(Arg, Options)]).
abstract(Arg, #options{encoding = Encoding}) ->
erl_parse:abstract(Arg, [{encoding,Encoding}]).
@@ -329,7 +343,7 @@ ltype({user_type,Line,T,Ts}, _) ->
ltype({remote_type,Line,[M,F,Ts]}, _) ->
simple_type({remote,Line,M,F}, Ts);
ltype({atom,_,T}, _) ->
- leaf(write(T));
+ {atom,T};
ltype(E, P) ->
lexpr(E, P, options(none)).
@@ -371,12 +385,12 @@ tuple_type(Ts, F) ->
specattr(SpecKind, {FuncSpec,TypeSpecs}) ->
Func = case FuncSpec of
{F,_A} ->
- format("~w", [F]);
+ {atom,F};
{M,F,_A} ->
- format("~w:~w", [M, F])
+ [{atom,M},$:,{atom,F}]
end,
{first,leaf(lists:concat(["-", SpecKind, " "])),
- {list,[{first,leaf(Func),spec_clauses(TypeSpecs)}]}}.
+ {list,[{first,Func,spec_clauses(TypeSpecs)}]}}.
spec_clauses(TypeSpecs) ->
{prefer_nl,[$;],[sig_type(T) || T <- TypeSpecs]}.
@@ -418,7 +432,10 @@ ltypes(Ts, F, Prec) ->
[F(T, Prec) || T <- Ts].
attr(Name, Args) ->
- call({var,a0(),format("-~s", [Name])}, Args, 0, options(none)).
+ {first,[$-,{atom,Name}],args(Args, options(none))}.
+
+attrib(Name, Args) ->
+ {first,[$-,{atom,Name}],[{seq,$(,$),[$,],Args}]}.
pname(['' | As]) ->
[$. | pname(As)];
@@ -430,10 +447,13 @@ pname(A) when is_atom(A) ->
write(A).
falist([]) ->
- {nil,a0()};
-falist([{Name,Arity}|Falist]) ->
- A = a0(),
- {cons,A,{var,A,format("~w/~w", [Name,Arity])},falist(Falist)}.
+ [leaf("[]")];
+falist(Falist) ->
+ L = [begin
+ {Name,Arity} = Fa,
+ [{atom,Name},leaf(format("/~w", [Arity]))]
+ end || Fa <- Falist],
+ [{seq,$[,$],$,,L}].
lfunction({function,_Line,Name,_Arity,Cs}, Opts) ->
Cll = nl_clauses(fun (C, H) -> func_clause(Name, C, H) end, $;, Opts, Cs),
@@ -478,7 +498,7 @@ lexpr({var,_,V}, _, _) -> leaf(format("~ts", [V]));
lexpr({char,_,C}, _, _) -> {char,C};
lexpr({integer,_,N}, _, _) -> leaf(write(N));
lexpr({float,_,F}, _, _) -> leaf(write(F));
-lexpr({atom,_,A}, _, _) -> leaf(write(A));
+lexpr({atom,_,A}, _, _) -> {atom,A};
lexpr({string,_,S}, _, _) -> {string,S};
lexpr({nil,_}, _, _) -> '[]';
lexpr({cons,_,H,T}, _, Opts) ->
@@ -508,7 +528,7 @@ lexpr({record, _, Name, Fs}, Prec, Opts) ->
lexpr({record_field, _, Rec, Name, F}, Prec, Opts) ->
{L,P,R} = inop_prec('#'),
Rl = lexpr(Rec, L, Opts),
- Nl = leaf(format("#~w.", [Name])),
+ Nl = [$#,{atom,Name},$.],
El = [Rl,Nl,lexpr(F, R, Opts)],
maybe_paren(P, Prec, El);
lexpr({record, _, Rec, Name, Fs}, Prec, Opts) ->
@@ -527,12 +547,12 @@ lexpr({record_field, _, Rec, F}, Prec, Opts) ->
maybe_paren(P, Prec, El);
lexpr({map, _, Fs}, Prec, Opts) ->
{P,_R} = preop_prec('#'),
- El = {first,leaf("#"),map_fields(Fs, Opts)},
+ El = {first,$#,map_fields(Fs, Opts)},
maybe_paren(P, Prec, El);
lexpr({map, _, Map, Fs}, Prec, Opts) ->
{L,P,_R} = inop_prec('#'),
Rl = lexpr(Map, L, Opts),
- El = {first,[Rl,leaf("#")],map_fields(Fs, Opts)},
+ El = {first,[Rl,$#],map_fields(Fs, Opts)},
maybe_paren(P, Prec, El);
lexpr({block,_,Es}, _, Opts) ->
{list,[{step,'begin',body(Es, Opts)},'end']};
@@ -552,13 +572,16 @@ lexpr({'receive',_,Cs,To,ToOpt}, _, Opts) ->
{step,'after',Al},
'end']};
lexpr({'fun',_,{function,F,A}}, _Prec, _Opts) ->
- leaf(format("fun ~w/~w", [F,A]));
-lexpr({'fun',_,{function,F,A},Extra}, _Prec, _Opts) ->
- {force_nl,fun_info(Extra),leaf(format("fun ~w/~w", [F,A]))};
-lexpr({'fun',_,{function,M,F,A}}, _Prec, _Opts)
+ [leaf("fun "),{atom,F},leaf(format("/~w", [A]))];
+lexpr({'fun',L,{function,_,_}=Func,Extra}, Prec, Opts) ->
+ {force_nl,fun_info(Extra),lexpr({'fun',L,Func}, Prec, Opts)};
+lexpr({'fun',L,{function,M,F,A}}, Prec, Opts)
when is_atom(M), is_atom(F), is_integer(A) ->
%% For backward compatibility with pre-R15 abstract format.
- leaf(format("fun ~w:~w/~w", [M,F,A]));
+ Mod = erl_parse:abstract(M),
+ Fun = erl_parse:abstract(F),
+ Arity = erl_parse:abstract(A),
+ lexpr({'fun',L,{function,Mod,Fun,Arity}}, Prec, Opts);
lexpr({'fun',_,{function,M,F,A}}, _Prec, Opts) ->
%% New format in R15.
NameItem = lexpr(M, Opts),
@@ -649,7 +672,7 @@ lexpr({bin,_,Fs}, _, Opts) ->
bit_grp(Fs, Opts);
%% Special case for straight values.
lexpr({value,_,Val}, _,_) ->
- leaf(write(Val));
+ {value,Val};
%% Now do the hook.
lexpr(Other, _Precedence, #options{hook = none}) ->
leaf(format("INVALID-FORM:~w:",[Other]));
@@ -665,7 +688,7 @@ call(Name, Args, Prec, Opts) ->
maybe_paren(P, Prec, Item).
fun_info(Extra) ->
- leaf(format("% fun-info: ~w", [Extra])).
+ [leaf("% fun-info: "),{value,Extra}].
%% BITS:
@@ -706,7 +729,7 @@ bit_elem_type(T) ->
%% end of BITS
record_name(Name) ->
- leaf(format("#~w", [Name])).
+ [$#,{atom,Name}].
record_fields(Fs, Opts) ->
tuple(Fs, fun record_field/2, Opts).
@@ -908,8 +931,10 @@ frmt(Item, I, PP) ->
%%% - {force_nl,ExtraInfo,I}: fun-info (a comment) forces linebreak before I.
%%% - {prefer_nl,Sep,IPs}: forces linebreak between Is unlesss negative
%%% indentation.
+%%% - {atom,A}: an atom
%%% - {char,C}: a character
%%% - {string,S}: a string.
+%%% - {value,T}: a term.
%%% - {hook,...}, {ehook,...}: hook expressions.
%%%
%%% list, first, seq, force_nl, and prefer_nl all accept IPs, where each
@@ -970,6 +995,10 @@ f({prefer_nl,Sep,LItems}, I0, ST, WT, PP) ->
true ->
{insert_newlines(CharsSize2L, I0, ST),nsz(lists:last(Sizes), I0)}
end;
+f({value,V}, I, ST, WT, PP) ->
+ f(write_a_value(V, PP), I, ST, WT, PP);
+f({atom,A}, I, ST, WT, PP) ->
+ f(write_an_atom(A, PP), I, ST, WT, PP);
f({char,C}, I, ST, WT, PP) ->
f(write_a_char(C, PP), I, ST, WT, PP);
f({string,S}, I, ST, WT, PP) ->
@@ -1108,6 +1137,12 @@ has_nl([C|Cs]) ->
has_nl([]) ->
false.
+write_a_value(V, PP) ->
+ flat_leaf(write_value(V, PP)).
+
+write_an_atom(A, PP) ->
+ flat_leaf(write_atom(A, PP)).
+
write_a_char(C, PP) ->
flat_leaf(write_char(C, PP)).
@@ -1124,7 +1159,7 @@ write_a_string([], _N, _Len, _PP) ->
write_a_string(S, N, Len, PP) ->
SS = string:sub_string(S, 1, N),
Sl = write_string(SS, PP),
- case (length(Sl) > Len) and (N > ?MIN_SUBSTRING) of
+ case (chars_size(Sl) > Len) and (N > ?MIN_SUBSTRING) of
true ->
write_a_string(S, N-1, Len, PP);
false ->
@@ -1136,11 +1171,17 @@ flat_leaf(S) ->
L = lists:flatten(S),
{leaf,length(L),L}.
+write_value(V, PP) ->
+ (PP#pp.value_fun)(V).
+
+write_atom(A, PP) ->
+ (PP#pp.value_fun)(A).
+
write_string(S, PP) ->
- lists:flatten((PP#pp.string_fun)(S)).
+ (PP#pp.string_fun)(S).
write_char(C, PP) ->
- lists:flatten((PP#pp.char_fun)(C)).
+ (PP#pp.char_fun)(C).
%%
%% Utilities
diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl
index a383a0fc67..a54df939bf 100644
--- a/lib/stdlib/src/erl_tar.erl
+++ b/lib/stdlib/src/erl_tar.erl
@@ -1,8 +1,8 @@
%%
%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
-%%
+%%
+%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
+%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -14,191 +14,245 @@
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
-%%
+%%
%% %CopyrightEnd%
%%
+%% This module implements extraction/creation of tar archives.
+%% It supports reading most common tar formats, namely V7, STAR,
+%% USTAR, GNU, BSD/libarchive, and PAX. It produces archives in USTAR
+%% format, unless it must use PAX headers, in which case it produces PAX
+%% format.
+%%
+%% The following references where used:
+%% http://www.freebsd.org/cgi/man.cgi?query=tar&sektion=5
+%% http://www.gnu.org/software/tar/manual/html_node/Standard.html
+%% http://pubs.opengroup.org/onlinepubs/9699919799/utilities/pax.html
-module(erl_tar).
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Purpose: Unix tar (tape archive) utility.
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
--export([init/3, create/2, create/3, extract/1, extract/2, table/1, table/2,
- open/2, close/1, add/3, add/4,
- t/1, tt/1, format_error/1]).
+-export([init/3,
+ create/2, create/3,
+ extract/1, extract/2,
+ table/1, table/2, t/1, tt/1,
+ open/2, close/1,
+ add/3, add/4,
+ format_error/1]).
-include_lib("kernel/include/file.hrl").
+-include_lib("erl_tar.hrl").
--record(add_opts,
- {read_info, % Fun to use for read file/link info.
- chunk_size = 0, % For file reading when sending to sftp. 0=do not chunk
- verbose = false :: boolean()}). % Verbose on/off.
-
-%% Opens a tar archive.
-
-init(UsrHandle, AccessMode, Fun) when is_function(Fun,2) ->
- {ok, {AccessMode,{tar_descriptor,UsrHandle,Fun}}}.
-
-%%%================================================================
-%%% The open function with friends is to keep the file and binary api of this module
-open(Name, Mode) ->
- case open_mode(Mode) of
- {ok, Access, Raw, Opts} ->
- open1(Name, Access, Raw, Opts);
- {error, Reason} ->
- {error, {Name, Reason}}
- end.
-
-open1({binary,Bin}, read, _Raw, Opts) ->
- case file:open(Bin, [ram,binary,read]) of
- {ok,File} ->
- _ = [ram_file:uncompress(File) || Opts =:= [compressed]],
- init(File,read,file_fun());
- Error ->
- Error
- end;
-open1({file, Fd}, read, _Raw, _Opts) ->
- init(Fd, read, file_fun());
-open1(Name, Access, Raw, Opts) ->
- case file:open(Name, Raw ++ [binary, Access|Opts]) of
- {ok, File} ->
- init(File, Access, file_fun());
- {error, Reason} ->
- {error, {Name, Reason}}
- end.
-
-file_fun() ->
- fun(write, {Fd,Data}) -> file:write(Fd, Data);
- (position, {Fd,Pos}) -> file:position(Fd, Pos);
- (read2, {Fd,Size}) -> file:read(Fd,Size);
- (close, Fd) -> file:close(Fd)
- end.
-
-%%% End of file and binary api (except for open_mode/1 downwards
-%%%================================================================
-
-%% Closes a tar archive.
-
-close({read, File}) ->
- ok = do_close(File);
-close({write, File}) ->
- PadResult = pad_file(File),
- ok = do_close(File),
- PadResult;
-close(_) ->
- {error, einval}.
-
-%% Adds a file to a tape archive.
-
-add(File, Name, Options) ->
- add(File, Name, Name, Options).
-add({write, File}, Name, NameInArchive, Options) ->
- Opts = #add_opts{read_info=fun(F) -> file:read_link_info(F) end},
- add1(File, Name, NameInArchive, add_opts(Options, Opts));
-add({read, _File}, _, _, _) ->
- {error, eacces};
-add(_, _, _, _) ->
- {error, einval}.
-
-add_opts([dereference|T], Opts) ->
- add_opts(T, Opts#add_opts{read_info=fun(F) -> file:read_file_info(F) end});
-add_opts([verbose|T], Opts) ->
- add_opts(T, Opts#add_opts{verbose=true});
-add_opts([{chunks,N}|T], Opts) ->
- add_opts(T, Opts#add_opts{chunk_size=N});
-add_opts([_|T], Opts) ->
- add_opts(T, Opts);
-add_opts([], Opts) ->
- Opts.
-
-%% Creates a tar file Name containing the given files.
-
-create(Name, Filenames) ->
- create(Name, Filenames, []).
-
-%% Creates a tar archive Name containing the given files.
-%% Accepted options: verbose, compressed, cooked
+%% Converts the short error reason to a descriptive string.
+-spec format_error(term()) -> string().
+format_error(invalid_tar_checksum) ->
+ "Checksum failed";
+format_error(bad_header) ->
+ "Unrecognized tar header format";
+format_error({bad_header, Reason}) ->
+ lists:flatten(io_lib:format("Unrecognized tar header format: ~p", [Reason]));
+format_error({invalid_header, negative_size}) ->
+ "Invalid header: negative size";
+format_error(invalid_sparse_header_size) ->
+ "Invalid sparse header: negative size";
+format_error(invalid_sparse_map_entry) ->
+ "Invalid sparse map entry";
+format_error({invalid_sparse_map_entry, Reason}) ->
+ lists:flatten(io_lib:format("Invalid sparse map entry: ~p", [Reason]));
+format_error(invalid_end_of_archive) ->
+ "Invalid end of archive";
+format_error(eof) ->
+ "Unexpected end of file";
+format_error(integer_overflow) ->
+ "Failed to parse numeric: integer overflow";
+format_error({misaligned_read, Pos}) ->
+ lists:flatten(io_lib:format("Read a block which was misaligned: block_size=~p pos=~p",
+ [?BLOCK_SIZE, Pos]));
+format_error(invalid_gnu_1_0_sparsemap) ->
+ "Invalid GNU sparse map (version 1.0)";
+format_error({invalid_gnu_0_1_sparsemap, Format}) ->
+ lists:flatten(io_lib:format("Invalid GNU sparse map (version ~s)", [Format]));
+format_error({Name,Reason}) ->
+ lists:flatten(io_lib:format("~ts: ~ts", [Name,format_error(Reason)]));
+format_error(Atom) when is_atom(Atom) ->
+ file:format_error(Atom);
+format_error(Term) ->
+ lists:flatten(io_lib:format("~tp", [Term])).
-create(Name, FileList, Options) ->
- Mode = lists:filter(fun(X) -> (X=:=compressed) or (X=:=cooked)
- end, Options),
- case open(Name, [write|Mode]) of
- {ok, TarFile} ->
- Add = fun({NmInA, NmOrBin}) ->
- add(TarFile, NmOrBin, NmInA, Options);
- (Nm) ->
- add(TarFile, Nm, Nm, Options)
- end,
- Result = foreach_while_ok(Add, FileList),
- case {Result, close(TarFile)} of
- {ok, Res} -> Res;
- {Res, _} -> Res
- end;
- Reason ->
- Reason
- end.
+%% Initializes a new reader given a custom file handle and I/O wrappers
+-spec init(handle(), write | read, file_op()) -> {ok, reader()} | {error, badarg}.
+init(Handle, AccessMode, Fun) when is_function(Fun, 2) ->
+ Reader = #reader{handle=Handle,access=AccessMode,func=Fun},
+ {ok, Pos, Reader2} = do_position(Reader, {cur, 0}),
+ {ok, Reader2#reader{pos=Pos}};
+init(_Handle, _AccessMode, _Fun) ->
+ {error, badarg}.
+%%%================================================================
%% Extracts all files from the tar file Name.
-
+-spec extract(open_handle()) -> ok | {error, term()}.
extract(Name) ->
extract(Name, []).
%% Extracts (all) files from the tar file Name.
-%% Options accepted: keep_old_files, {files, ListOfFilesToExtract}, verbose,
-%% {cwd, AbsoluteDirectory}
+%% Options accepted:
+%% - cooked: Opens the tar file without mode `raw`
+%% - compressed: Uncompresses the tar file when reading
+%% - memory: Returns the tar contents as a list of tuples {Name, Bin}
+%% - keep_old_files: Extracted files will not overwrite the destination
+%% - {files, ListOfFilesToExtract}: Only extract ListOfFilesToExtract
+%% - verbose: Prints verbose information about the extraction,
+%% - {cwd, AbsoluteDir}: Sets the current working directory for the extraction
+-spec extract(open_handle(), [extract_opt()]) ->
+ ok
+ | {ok, [{string(), binary()}]}
+ | {error, term()}.
+extract({binary, Bin}, Opts) when is_list(Opts) ->
+ do_extract({binary, Bin}, Opts);
+extract({file, Fd}, Opts) when is_list(Opts) ->
+ do_extract({file, Fd}, Opts);
+extract(#reader{}=Reader, Opts) when is_list(Opts) ->
+ do_extract(Reader, Opts);
+extract(Name, Opts) when is_list(Name); is_binary(Name), is_list(Opts) ->
+ do_extract(Name, Opts).
+
+do_extract(Handle, Opts) when is_list(Opts) ->
+ Opts2 = extract_opts(Opts),
+ Acc = if Opts2#read_opts.output =:= memory -> []; true -> ok end,
+ foldl_read(Handle, fun extract1/4, Acc, Opts2).
+
+extract1(eof, Reader, _, Acc) when is_list(Acc) ->
+ {ok, {ok, lists:reverse(Acc)}, Reader};
+extract1(eof, Reader, _, Acc) ->
+ {ok, Acc, Reader};
+extract1(#tar_header{name=Name,size=Size}=Header, Reader, Opts, Acc) ->
+ case check_extract(Name, Opts) of
+ true ->
+ case do_read(Reader, Size) of
+ {ok, Bin, Reader2} ->
+ case write_extracted_element(Header, Bin, Opts) of
+ ok ->
+ {ok, Acc, Reader2};
+ {ok, NameBin} when is_list(Acc) ->
+ {ok, [NameBin | Acc], Reader2};
+ {error, _} = Err ->
+ throw(Err)
+ end;
+ {error, _} = Err ->
+ throw(Err)
+ end;
+ false ->
+ {ok, Acc, skip_file(Reader)}
+ end.
-extract(Name, Opts) ->
- foldl_read(Name, fun extract1/4, ok, extract_opts(Opts)).
+%% Checks if the file Name should be extracted.
+check_extract(_, #read_opts{files=all}) ->
+ true;
+check_extract(Name, #read_opts{files=Files}) ->
+ ordsets:is_element(Name, Files).
-%% Returns a list of names of the files in the tar file Name.
-%% Options accepted: verbose
+%%%================================================================
+%% The following table functions produce a list of information about
+%% the files contained in the archive.
+-type filename() :: string().
+-type typeflag() :: regular | link | symlink |
+ char | block | directory |
+ fifo | reserved | unknown.
+-type mode() :: non_neg_integer().
+-type uid() :: non_neg_integer().
+-type gid() :: non_neg_integer().
+
+-type tar_entry() :: {filename(),
+ typeflag(),
+ non_neg_integer(),
+ calendar:datetime(),
+ mode(),
+ uid(),
+ gid()}.
+%% Returns a list of names of the files in the tar file Name.
+-spec table(open_handle()) -> {ok, [string()]} | {error, term()}.
table(Name) ->
table(Name, []).
%% Returns a list of names of the files in the tar file Name.
%% Options accepted: compressed, verbose, cooked.
-
-table(Name, Opts) ->
+-spec table(open_handle(), [compressed | verbose | cooked]) ->
+ {ok, [tar_entry()]} | {error, term()}.
+table(Name, Opts) when is_list(Opts) ->
foldl_read(Name, fun table1/4, [], table_opts(Opts)).
+table1(eof, Reader, _, Result) ->
+ {ok, {ok, lists:reverse(Result)}, Reader};
+table1(#tar_header{}=Header, Reader, #read_opts{verbose=Verbose}, Result) ->
+ Attrs = table1_attrs(Header, Verbose),
+ Reader2 = skip_file(Reader),
+ {ok, [Attrs|Result], Reader2}.
+
+%% Extracts attributes relevant to table1's output
+table1_attrs(#tar_header{typeflag=Typeflag,mode=Mode}=Header, true) ->
+ Type = typeflag(Typeflag),
+ Name = Header#tar_header.name,
+ Mtime = Header#tar_header.mtime,
+ Uid = Header#tar_header.uid,
+ Gid = Header#tar_header.gid,
+ Size = Header#tar_header.size,
+ {Name, Type, Size, Mtime, Mode, Uid, Gid};
+table1_attrs(#tar_header{name=Name}, _Verbose) ->
+ Name.
+
+typeflag(?TYPE_REGULAR) -> regular;
+typeflag(?TYPE_REGULAR_A) -> regular;
+typeflag(?TYPE_GNU_SPARSE) -> regular;
+typeflag(?TYPE_CONT) -> regular;
+typeflag(?TYPE_LINK) -> link;
+typeflag(?TYPE_SYMLINK) -> symlink;
+typeflag(?TYPE_CHAR) -> char;
+typeflag(?TYPE_BLOCK) -> block;
+typeflag(?TYPE_DIR) -> directory;
+typeflag(?TYPE_FIFO) -> fifo;
+typeflag(_) -> unknown.
+%%%================================================================
%% Comments for printing the contents of a tape archive,
%% meant to be invoked from the shell.
-t(Name) ->
+%% Prints each filename in the archive
+-spec t(file:filename()) -> ok | {error, term()}.
+t(Name) when is_list(Name); is_binary(Name) ->
case table(Name) of
- {ok, List} ->
- lists:foreach(fun(N) -> ok = io:format("~ts\n", [N]) end, List);
- Error ->
- Error
+ {ok, List} ->
+ lists:foreach(fun(N) -> ok = io:format("~ts\n", [N]) end, List);
+ Error ->
+ Error
end.
+%% Prints verbose information about each file in the archive
+-spec tt(open_handle()) -> ok | {error, term()}.
tt(Name) ->
case table(Name, [verbose]) of
- {ok, List} ->
- lists:foreach(fun print_header/1, List);
- Error ->
- Error
+ {ok, List} ->
+ lists:foreach(fun print_header/1, List);
+ Error ->
+ Error
end.
+%% Used by tt/1 to print a tar_entry tuple
+-spec print_header(tar_entry()) -> ok.
print_header({Name, Type, Size, Mtime, Mode, Uid, Gid}) ->
io:format("~s~s ~4w/~-4w ~7w ~s ~s\n",
- [type_to_string(Type), mode_to_string(Mode),
- Uid, Gid, Size, time_to_string(Mtime), Name]).
+ [type_to_string(Type), mode_to_string(Mode),
+ Uid, Gid, Size, time_to_string(Mtime), Name]).
-type_to_string(regular) -> "-";
+type_to_string(regular) -> "-";
type_to_string(directory) -> "d";
-type_to_string(link) -> "l";
-type_to_string(symlink) -> "s";
-type_to_string(char) -> "c";
-type_to_string(block) -> "b";
-type_to_string(fifo) -> "f";
-type_to_string(_) -> "?".
-
+type_to_string(link) -> "l";
+type_to_string(symlink) -> "s";
+type_to_string(char) -> "c";
+type_to_string(block) -> "b";
+type_to_string(fifo) -> "f";
+type_to_string(unknown) -> "?".
+
+%% Converts a numeric mode to its human-readable representation
mode_to_string(Mode) ->
mode_to_string(Mode, "xwrxwrxwr", []).
-
mode_to_string(Mode, [C|T], Acc) when Mode band 1 =:= 1 ->
mode_to_string(Mode bsr 1, T, [C|Acc]);
mode_to_string(Mode, [_|T], Acc) ->
@@ -206,6 +260,7 @@ mode_to_string(Mode, [_|T], Acc) ->
mode_to_string(_, [], Acc) ->
Acc.
+%% Converts a datetime tuple to a readable string
time_to_string({{Y, Mon, Day}, {H, Min, _}}) ->
io_lib:format("~s ~2w ~s:~s ~w", [month(Mon), Day, two_d(H), two_d(Min), Y]).
@@ -225,809 +280,1612 @@ month(10) -> "Oct";
month(11) -> "Nov";
month(12) -> "Dec".
-%% Converts the short error reason to a descriptive string.
+%%%================================================================
+%% The open function with friends is to keep the file and binary api of this module
+-type open_handle() :: file:filename()
+ | {binary, binary()}
+ | {file, term()}.
+-spec open(open_handle(), [write | compressed | cooked]) ->
+ {ok, reader()} | {error, term()}.
+open({binary, Bin}, Mode) when is_binary(Bin) ->
+ do_open({binary, Bin}, Mode);
+open({file, Fd}, Mode) ->
+ do_open({file, Fd}, Mode);
+open(Name, Mode) when is_list(Name); is_binary(Name) ->
+ do_open(Name, Mode).
+
+do_open(Name, Mode) when is_list(Mode) ->
+ case open_mode(Mode) of
+ {ok, Access, Raw, Opts} ->
+ open1(Name, Access, Raw, Opts);
+ {error, Reason} ->
+ {error, {Name, Reason}}
+ end.
-format_error(bad_header) -> "Bad directory header";
-format_error(eof) -> "Unexpected end of file";
-format_error(symbolic_link_too_long) -> "Symbolic link too long";
-format_error({Name,Reason}) ->
- lists:flatten(io_lib:format("~ts: ~ts", [Name,format_error(Reason)]));
-format_error(Atom) when is_atom(Atom) ->
- file:format_error(Atom);
-format_error(Term) ->
- lists:flatten(io_lib:format("~tp", [Term])).
+open1({binary,Bin}, read, _Raw, Opts) when is_binary(Bin) ->
+ case file:open(Bin, [ram,binary,read]) of
+ {ok,File} ->
+ _ = [ram_file:uncompress(File) || Opts =:= [compressed]],
+ {ok, #reader{handle=File,access=read,func=fun file_op/2}};
+ Error ->
+ Error
+ end;
+open1({file, Fd}, read, _Raw, _Opts) ->
+ Reader = #reader{handle=Fd,access=read,func=fun file_op/2},
+ case do_position(Reader, {cur, 0}) of
+ {ok, Pos, Reader2} ->
+ {ok, Reader2#reader{pos=Pos}};
+ {error, _} = Err ->
+ Err
+ end;
+open1(Name, Access, Raw, Opts) when is_list(Name) or is_binary(Name) ->
+ case file:open(Name, Raw ++ [binary, Access|Opts]) of
+ {ok, File} ->
+ {ok, #reader{handle=File,access=Access,func=fun file_op/2}};
+ {error, Reason} ->
+ {error, {Name, Reason}}
+ end.
+open_mode(Mode) ->
+ open_mode(Mode, false, [raw], []).
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%%
-%%% Useful definitions (also start of implementation).
-%%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% Offset for fields in the tar header.
-%% Note that these offsets are ZERO-based as in the POSIX standard
-%% document, while binaries use ONE-base offset. Caveat Programmer.
-
--define(th_name, 0).
--define(th_mode, 100).
--define(th_uid, 108).
--define(th_gid, 116).
--define(th_size, 124).
--define(th_mtime, 136).
--define(th_chksum, 148).
--define(th_typeflag, 156).
--define(th_linkname, 157).
--define(th_magic, 257).
--define(th_version, 263).
--define(th_prefix, 345).
-
-%% Length of these fields.
-
--define(th_name_len, 100).
--define(th_mode_len, 8).
--define(th_uid_len, 8).
--define(th_gid_len, 8).
--define(th_size_len, 12).
--define(th_mtime_len, 12).
--define(th_chksum_len, 8).
--define(th_linkname_len, 100).
--define(th_magic_len, 6).
--define(th_version_len, 2).
--define(th_prefix_len, 167).
-
--record(tar_header,
- {name, % Name of file.
- mode, % Mode bits.
- uid, % User id.
- gid, % Group id.
- size, % Size of file
- mtime, % Last modified (seconds since
- % Jan 1, 1970).
- chksum, % Checksum of header.
- typeflag = [], % Type of file.
- linkname = [], % Name of link.
- filler = [],
- prefix}). % Filename prefix.
-
--define(record_size, 512).
--define(block_size, (512*20)).
-
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%%
-%%% Adding members to a tar archive.
-%%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-add1(TarFile, Bin, NameInArchive, Opts) when is_binary(Bin) ->
- Now = calendar:now_to_local_time(erlang:timestamp()),
- Info = #file_info{size = byte_size(Bin),
- type = regular,
- access = read_write,
- atime = Now,
- mtime = Now,
- ctime = Now,
- mode = 8#100644,
- links = 1,
- major_device = 0,
- minor_device = 0,
- inode = 0,
- uid = 0,
- gid = 0},
- Header = create_header(NameInArchive, Info),
- add1(TarFile, NameInArchive, Header, Bin, Opts);
-add1(TarFile, Name, NameInArchive, Opts) ->
- case read_file_and_info(Name, Opts) of
- {ok, Bin, Info} when Info#file_info.type =:= regular ->
- Header = create_header(NameInArchive, Info),
- add1(TarFile, Name, Header, Bin, Opts);
- {ok, PointsTo, Info} when Info#file_info.type =:= symlink ->
- if
- length(PointsTo) > 100 ->
- {error,{PointsTo,symbolic_link_too_long}};
- true ->
- Info2 = Info#file_info{size=0},
- Header = create_header(NameInArchive, Info2, PointsTo),
- add1(TarFile, Name, Header, list_to_binary([]), Opts)
- end;
- {ok, _, Info} when Info#file_info.type =:= directory ->
- add_directory(TarFile, Name, NameInArchive, Info, Opts);
- {ok, _, #file_info{type=Type}} ->
- {error, {bad_file_type, Name, Type}};
- {error, Reason} ->
- {error, {Name, Reason}}
+open_mode(read, _, Raw, _) ->
+ {ok, read, Raw, []};
+open_mode(write, _, Raw, _) ->
+ {ok, write, Raw, []};
+open_mode([read|Rest], false, Raw, Opts) ->
+ open_mode(Rest, read, Raw, Opts);
+open_mode([write|Rest], false, Raw, Opts) ->
+ open_mode(Rest, write, Raw, Opts);
+open_mode([compressed|Rest], Access, Raw, Opts) ->
+ open_mode(Rest, Access, Raw, [compressed|Opts]);
+open_mode([cooked|Rest], Access, _Raw, Opts) ->
+ open_mode(Rest, Access, [], Opts);
+open_mode([], Access, Raw, Opts) ->
+ {ok, Access, Raw, Opts};
+open_mode(_, _, _, _) ->
+ {error, einval}.
+
+file_op(write, {Fd, Data}) ->
+ file:write(Fd, Data);
+file_op(position, {Fd, Pos}) ->
+ file:position(Fd, Pos);
+file_op(read2, {Fd, Size}) ->
+ file:read(Fd, Size);
+file_op(close, Fd) ->
+ file:close(Fd).
+
+%% Closes a tar archive.
+-spec close(reader()) -> ok | {error, term()}.
+close(#reader{access=read}=Reader) ->
+ ok = do_close(Reader);
+close(#reader{access=write}=Reader) ->
+ {ok, Reader2} = pad_file(Reader),
+ ok = do_close(Reader2),
+ ok;
+close(_) ->
+ {error, einval}.
+
+pad_file(#reader{pos=Pos}=Reader) ->
+ %% There must be at least two zero blocks at the end.
+ PadCurrent = skip_padding(Pos+?BLOCK_SIZE),
+ Padding = <<0:PadCurrent/unit:8>>,
+ do_write(Reader, [Padding, ?ZERO_BLOCK, ?ZERO_BLOCK]).
+
+
+%%%================================================================
+%% Creation/modification of tar archives
+
+%% Creates a tar file Name containing the given files.
+-spec create(file:filename(), filelist()) -> ok | {error, {string(), term()}}.
+create(Name, FileList) when is_list(Name); is_binary(Name) ->
+ create(Name, FileList, []).
+
+%% Creates a tar archive Name containing the given files.
+%% Accepted options: verbose, compressed, cooked
+-spec create(file:filename(), filelist(), [create_opt()]) ->
+ ok | {error, term()} | {error, {string(), term()}}.
+create(Name, FileList, Options) when is_list(Name); is_binary(Name) ->
+ Mode = lists:filter(fun(X) -> (X=:=compressed) or (X=:=cooked)
+ end, Options),
+ case open(Name, [write|Mode]) of
+ {ok, TarFile} ->
+ do_create(TarFile, FileList, Options);
+ {error, _} = Err ->
+ Err
end.
-add1(Tar, Name, Header, chunked, Options) ->
- add_verbose(Options, "a ~ts [chunked ", [Name]),
- try
- ok = do_write(Tar, Header),
- {ok,D} = file:open(Name, [read,binary]),
- {ok,NumBytes} = add_read_write_chunks(D, Tar, Options#add_opts.chunk_size, 0, Options),
- _ = file:close(D),
- ok = do_write(Tar, padding(NumBytes,?record_size))
- of
- ok ->
- add_verbose(Options, "~n", []),
- ok
- catch
- error:{badmatch,{error,Error}} ->
- add_verbose(Options, "~n", []),
- {error,{Name,Error}}
+do_create(TarFile, [], _Opts) ->
+ close(TarFile);
+do_create(TarFile, [{NameInArchive, NameOrBin}|Rest], Opts) ->
+ case add(TarFile, NameOrBin, NameInArchive, Opts) of
+ ok ->
+ do_create(TarFile, Rest, Opts);
+ {error, _} = Err ->
+ _ = close(TarFile),
+ Err
end;
-add1(Tar, Name, Header, Bin, Options) ->
- add_verbose(Options, "a ~ts~n", [Name]),
- do_write(Tar, [Header, Bin, padding(byte_size(Bin), ?record_size)]).
-
-add_read_write_chunks(D, Tar, ChunkSize, SumNumBytes, Options) ->
- case file:read(D, ChunkSize) of
- {ok,Bin} ->
- ok = do_write(Tar, Bin),
- add_verbose(Options, ".", []),
- add_read_write_chunks(D, Tar, ChunkSize, SumNumBytes+byte_size(Bin), Options);
- eof ->
- add_verbose(Options, "]", []),
- {ok,SumNumBytes};
- Other ->
- Other
+do_create(TarFile, [Name|Rest], Opts) ->
+ case add(TarFile, Name, Name, Opts) of
+ ok ->
+ do_create(TarFile, Rest, Opts);
+ {error, _} = Err ->
+ _ = close(TarFile),
+ Err
end.
-add_directory(TarFile, DirName, NameInArchive, Info, Options) ->
+%% Adds a file to a tape archive.
+-type add_type() :: string()
+ | {string(), string()}
+ | {string(), binary()}.
+-spec add(reader(), add_type(), [add_opt()]) -> ok | {error, term()}.
+add(Reader, {NameInArchive, Name}, Opts)
+ when is_list(NameInArchive), is_list(Name) ->
+ do_add(Reader, Name, NameInArchive, Opts);
+add(Reader, {NameInArchive, Bin}, Opts)
+ when is_list(NameInArchive), is_binary(Bin) ->
+ do_add(Reader, Bin, NameInArchive, Opts);
+add(Reader, Name, Opts) when is_list(Name) ->
+ do_add(Reader, Name, Name, Opts).
+
+
+-spec add(reader(), string() | binary(), string(), [add_opt()]) ->
+ ok | {error, term()}.
+add(Reader, NameOrBin, NameInArchive, Options)
+ when is_list(NameOrBin); is_binary(NameOrBin),
+ is_list(NameInArchive), is_list(Options) ->
+ do_add(Reader, NameOrBin, NameInArchive, Options).
+
+do_add(#reader{access=write}=Reader, Name, NameInArchive, Options)
+ when is_list(NameInArchive), is_list(Options) ->
+ Opts = #add_opts{read_info=fun(F) -> file:read_link_info(F) end},
+ add1(Reader, Name, NameInArchive, add_opts(Options, Opts));
+do_add(#reader{access=read},_,_,_) ->
+ {error, eacces};
+do_add(Reader,_,_,_) ->
+ {error, {badarg, Reader}}.
+
+add_opts([dereference|T], Opts) ->
+ add_opts(T, Opts#add_opts{read_info=fun(F) -> file:read_file_info(F) end});
+add_opts([verbose|T], Opts) ->
+ add_opts(T, Opts#add_opts{verbose=true});
+add_opts([{chunks,N}|T], Opts) ->
+ add_opts(T, Opts#add_opts{chunk_size=N});
+add_opts([_|T], Opts) ->
+ add_opts(T, Opts);
+add_opts([], Opts) ->
+ Opts.
+
+add1(#reader{}=Reader, Name, NameInArchive, #add_opts{read_info=ReadInfo}=Opts)
+ when is_list(Name) ->
+ Res = case ReadInfo(Name) of
+ {error, Reason0} ->
+ {error, {Name, Reason0}};
+ {ok, #file_info{type=symlink}=Fi} ->
+ add_verbose(Opts, "a ~ts~n", [NameInArchive]),
+ {ok, Linkname} = file:read_link(Name),
+ Header = fileinfo_to_header(NameInArchive, Fi, Linkname),
+ add_header(Reader, Header, Opts);
+ {ok, #file_info{type=regular}=Fi} ->
+ add_verbose(Opts, "a ~ts~n", [NameInArchive]),
+ Header = fileinfo_to_header(NameInArchive, Fi, false),
+ {ok, Reader2} = add_header(Reader, Header, Opts),
+ FileSize = Header#tar_header.size,
+ {ok, FileSize, Reader3} = do_copy(Reader2, Name, Opts),
+ Padding = skip_padding(FileSize),
+ Pad = <<0:Padding/unit:8>>,
+ do_write(Reader3, Pad);
+ {ok, #file_info{type=directory}=Fi} ->
+ add_directory(Reader, Name, NameInArchive, Fi, Opts);
+ {ok, #file_info{}=Fi} ->
+ add_verbose(Opts, "a ~ts~n", [NameInArchive]),
+ Header = fileinfo_to_header(NameInArchive, Fi, false),
+ add_header(Reader, Header, Opts)
+ end,
+ case Res of
+ ok -> ok;
+ {ok, _Reader} -> ok;
+ {error, _Reason} = Err -> Err
+ end;
+add1(Reader, Bin, NameInArchive, Opts) when is_binary(Bin) ->
+ add_verbose(Opts, "a ~ts~n", [NameInArchive]),
+ Now = calendar:now_to_local_time(erlang:timestamp()),
+ Header = #tar_header{
+ name = NameInArchive,
+ size = byte_size(Bin),
+ typeflag = ?TYPE_REGULAR,
+ atime = Now,
+ mtime = Now,
+ ctime = Now,
+ mode = 8#100644},
+ {ok, Reader2} = add_header(Reader, Header, Opts),
+ Padding = skip_padding(byte_size(Bin)),
+ Data = [Bin, <<0:Padding/unit:8>>],
+ case do_write(Reader2, Data) of
+ {ok, _Reader3} -> ok;
+ {error, Reason} -> {error, {NameInArchive, Reason}}
+ end.
+
+add_directory(Reader, DirName, NameInArchive, Info, Opts) ->
case file:list_dir(DirName) of
- {ok, []} ->
- add_verbose(Options, "a ~ts~n", [DirName]),
- Header = create_header(NameInArchive, Info),
- do_write(TarFile, Header);
- {ok, Files} ->
- Add = fun (File) ->
- add1(TarFile,
- filename:join(DirName, File),
- filename:join(NameInArchive, File),
- Options) end,
- foreach_while_ok(Add, Files);
- {error, Reason} ->
- {error, {DirName, Reason}}
+ {ok, []} ->
+ add_verbose(Opts, "a ~ts~n", [NameInArchive]),
+ Header = fileinfo_to_header(NameInArchive, Info, false),
+ add_header(Reader, Header, Opts);
+ {ok, Files} ->
+ add_verbose(Opts, "a ~ts~n", [NameInArchive]),
+ try add_files(Reader, Files, DirName, NameInArchive, Opts) of
+ ok -> ok;
+ {error, _} = Err -> Err
+ catch
+ throw:{error, {_Name, _Reason}} = Err -> Err;
+ throw:{error, Reason} -> {error, {DirName, Reason}}
+ end;
+ {error, Reason} ->
+ {error, {DirName, Reason}}
end.
-
-%% Creates a header for file in a tar file.
-
-create_header(Name, Info) ->
- create_header(Name, Info, []).
-create_header(Name, #file_info {mode=Mode, uid=Uid, gid=Gid,
- size=Size, mtime=Mtime0, type=Type}, Linkname) ->
- Mtime = posix_time(erlang:localtime_to_universaltime(Mtime0)),
- {Prefix,Suffix} = split_filename(Name),
- H0 = [to_string(Suffix, 100),
- to_octal(Mode, 8),
- to_octal(Uid, 8),
- to_octal(Gid, 8),
- to_octal(Size, ?th_size_len),
- to_octal(Mtime, ?th_mtime_len),
- <<" ">>,
- file_type(Type),
- to_string(Linkname, ?th_linkname_len),
- "ustar",0,
- "00",
- zeroes(?th_prefix-?th_version-?th_version_len),
- to_string(Prefix, ?th_prefix_len)],
- H = list_to_binary(H0),
- 512 = byte_size(H), %Assertion.
- ChksumString = to_octal(checksum(H), 6, [0,$\s]),
- <<Before:?th_chksum/binary,_:?th_chksum_len/binary,After/binary>> = H,
- [Before,ChksumString,After].
-
-file_type(regular) -> $0;
-file_type(symlink) -> $2;
-file_type(directory) -> $5.
-
-to_octal(Int, Count) when Count > 1 ->
- to_octal(Int, Count-1, [0]).
-
-to_octal(_, 0, Result) -> Result;
-to_octal(Int, Count, Result) ->
- to_octal(Int div 8, Count-1, [Int rem 8 + $0|Result]).
-
-to_string(Str0, Count) ->
- Str = case file:native_name_encoding() of
- utf8 ->
- unicode:characters_to_binary(Str0);
- latin1 ->
- list_to_binary(Str0)
- end,
- case byte_size(Str) of
- Size when Size < Count ->
- [Str|zeroes(Count-Size)];
- _ -> Str
+
+add_files(_Reader, [], _Dir, _DirInArchive, _Opts) ->
+ ok;
+add_files(Reader, [Name|Rest], Dir, DirInArchive, #add_opts{read_info=Info}=Opts) ->
+ FullName = filename:join(Dir, Name),
+ NameInArchive = filename:join(DirInArchive, Name),
+ Res = case Info(FullName) of
+ {error, Reason} ->
+ {error, {FullName, Reason}};
+ {ok, #file_info{type=directory}=Fi} ->
+ add_directory(Reader, FullName, NameInArchive, Fi, Opts);
+ {ok, #file_info{type=symlink}=Fi} ->
+ add_verbose(Opts, "a ~ts~n", [NameInArchive]),
+ {ok, Linkname} = file:read_link(FullName),
+ Header = fileinfo_to_header(NameInArchive, Fi, Linkname),
+ add_header(Reader, Header, Opts);
+ {ok, #file_info{type=regular}=Fi} ->
+ add_verbose(Opts, "a ~ts~n", [NameInArchive]),
+ Header = fileinfo_to_header(NameInArchive, Fi, false),
+ {ok, Reader2} = add_header(Reader, Header, Opts),
+ FileSize = Header#tar_header.size,
+ {ok, FileSize, Reader3} = do_copy(Reader2, FullName, Opts),
+ Padding = skip_padding(FileSize),
+ Pad = <<0:Padding/unit:8>>,
+ do_write(Reader3, Pad);
+ {ok, #file_info{}=Fi} ->
+ add_verbose(Opts, "a ~ts~n", [NameInArchive]),
+ Header = fileinfo_to_header(NameInArchive, Fi, false),
+ add_header(Reader, Header, Opts)
+ end,
+ case Res of
+ ok -> add_files(Reader, Rest, Dir, DirInArchive, Opts);
+ {ok, ReaderNext} -> add_files(ReaderNext, Rest, Dir, DirInArchive, Opts);
+ {error, _} = Err -> Err
end.
-%% Pads out end of file.
-
-pad_file(File) ->
- {ok,Position} = do_position(File, {cur,0}),
- %% There must be at least two zero records at the end.
- Fill = case ?block_size - (Position rem ?block_size) of
- Fill0 when Fill0 < 2*?record_size ->
- %% We need to another block here to ensure that there
- %% are at least two zero records at the end.
- Fill0 + ?block_size;
- Fill0 ->
- %% Large enough.
- Fill0
- end,
- do_write(File, zeroes(Fill)).
-
-split_filename(Name) when length(Name) =< ?th_name_len ->
- {"", Name};
-split_filename(Name0) ->
- split_filename(lists:reverse(filename:split(Name0)), [], [], 0).
-
-split_filename([Comp|Rest], Prefix, Suffix, Len)
- when Len+length(Comp) < ?th_name_len ->
- split_filename(Rest, Prefix, [Comp|Suffix], Len+length(Comp)+1);
-split_filename([Comp|Rest], Prefix, Suffix, Len) ->
- split_filename(Rest, [Comp|Prefix], Suffix, Len+length(Comp)+1);
-split_filename([], Prefix, Suffix, _) ->
- {filename:join(Prefix),filename:join(Suffix)}.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%%
-%%% Retrieving files from a tape archive.
-%%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% Options used when reading a tar archive.
-
--record(read_opts,
- {cwd :: string(), % Current working directory.
- keep_old_files = false :: boolean(), % Owerwrite or not.
- files = all, % Set of files to extract
- % (or all).
- output = file :: 'file' | 'memory',
- open_mode = [], % Open mode options.
- verbose = false :: boolean()}). % Verbose on/off.
+format_string(String, Size) when length(String) > Size ->
+ throw({error, {write_string, field_too_long}});
+format_string(String, Size) ->
+ Ascii = to_ascii(String),
+ if byte_size(Ascii) < Size ->
+ [Ascii, 0];
+ true ->
+ Ascii
+ end.
-extract_opts(List) ->
- extract_opts(List, default_options()).
+format_octal(Octal) ->
+ iolist_to_binary(io_lib:fwrite("~.8B", [Octal])).
+
+add_header(#reader{}=Reader, #tar_header{}=Header, Opts) ->
+ {ok, Iodata} = build_header(Header, Opts),
+ do_write(Reader, Iodata).
+
+write_to_block(Block, IoData, Start) when is_list(IoData) ->
+ write_to_block(Block, iolist_to_binary(IoData), Start);
+write_to_block(Block, Bin, Start) when is_binary(Bin) ->
+ Size = byte_size(Bin),
+ <<Head:Start/unit:8, _:Size/unit:8, Rest/binary>> = Block,
+ <<Head:Start/unit:8, Bin/binary, Rest/binary>>.
+
+build_header(#tar_header{}=Header, Opts) ->
+ #tar_header{
+ name=Name,
+ mode=Mode,
+ uid=Uid,
+ gid=Gid,
+ size=Size,
+ typeflag=Type,
+ linkname=Linkname,
+ uname=Uname,
+ gname=Gname,
+ devmajor=Devmaj,
+ devminor=Devmin
+ } = Header,
+ Mtime = datetime_to_posix(Header#tar_header.mtime),
+
+ Block0 = ?ZERO_BLOCK,
+ {Block1, Pax0} = write_string(Block0, ?V7_NAME, ?V7_NAME_LEN, Name, ?PAX_PATH, #{}),
+ Block2 = write_octal(Block1, ?V7_MODE, ?V7_MODE_LEN, Mode),
+ {Block3, Pax1} = write_numeric(Block2, ?V7_UID, ?V7_UID_LEN, Uid, ?PAX_UID, Pax0),
+ {Block4, Pax2} = write_numeric(Block3, ?V7_GID, ?V7_GID_LEN, Gid, ?PAX_GID, Pax1),
+ {Block5, Pax3} = write_numeric(Block4, ?V7_SIZE, ?V7_SIZE_LEN, Size, ?PAX_SIZE, Pax2),
+ {Block6, Pax4} = write_numeric(Block5, ?V7_MTIME, ?V7_MTIME_LEN, Mtime, ?PAX_NONE, Pax3),
+ {Block7, Pax5} = write_string(Block6, ?V7_TYPE, ?V7_TYPE_LEN, <<Type>>, ?PAX_NONE, Pax4),
+ {Block8, Pax6} = write_string(Block7, ?V7_LINKNAME, ?V7_LINKNAME_LEN,
+ Linkname, ?PAX_LINKPATH, Pax5),
+ {Block9, Pax7} = write_string(Block8, ?USTAR_UNAME, ?USTAR_UNAME_LEN,
+ Uname, ?PAX_UNAME, Pax6),
+ {Block10, Pax8} = write_string(Block9, ?USTAR_GNAME, ?USTAR_GNAME_LEN,
+ Gname, ?PAX_GNAME, Pax7),
+ {Block11, Pax9} = write_numeric(Block10, ?USTAR_DEVMAJ, ?USTAR_DEVMAJ_LEN,
+ Devmaj, ?PAX_NONE, Pax8),
+ {Block12, Pax10} = write_numeric(Block11, ?USTAR_DEVMIN, ?USTAR_DEVMIN_LEN,
+ Devmin, ?PAX_NONE, Pax9),
+ {Block13, Pax11} = set_path(Block12, Pax10),
+ PaxEntry = case maps:size(Pax11) of
+ 0 -> [];
+ _ -> build_pax_entry(Header, Pax11, Opts)
+ end,
+ Block14 = set_format(Block13, ?FORMAT_USTAR),
+ Block15 = set_checksum(Block14),
+ {ok, [PaxEntry, Block15]}.
+
+set_path(Block0, Pax) ->
+ %% only use ustar header when name is too long
+ case maps:get(?PAX_PATH, Pax, nil) of
+ nil ->
+ {Block0, Pax};
+ PaxPath ->
+ case split_ustar_path(PaxPath) of
+ {ok, UstarName, UstarPrefix} ->
+ {Block1, _} = write_string(Block0, ?V7_NAME, ?V7_NAME_LEN,
+ UstarName, ?PAX_NONE, #{}),
+ {Block2, _} = write_string(Block1, ?USTAR_PREFIX, ?USTAR_PREFIX_LEN,
+ UstarPrefix, ?PAX_NONE, #{}),
+ {Block2, maps:remove(?PAX_PATH, Pax)};
+ false ->
+ {Block0, Pax}
+ end
+ end.
-table_opts(List) ->
- read_opts(List, default_options()).
+set_format(Block0, Format)
+ when Format =:= ?FORMAT_USTAR; Format =:= ?FORMAT_PAX ->
+ Block1 = write_to_block(Block0, ?MAGIC_USTAR, ?USTAR_MAGIC),
+ write_to_block(Block1, ?VERSION_USTAR, ?USTAR_VERSION);
+set_format(_Block, Format) ->
+ throw({error, {invalid_format, Format}}).
+
+set_checksum(Block) ->
+ Checksum = compute_checksum(Block),
+ write_octal(Block, ?V7_CHKSUM, ?V7_CHKSUM_LEN, Checksum).
+
+build_pax_entry(Header, PaxAttrs, Opts) ->
+ Path = Header#tar_header.name,
+ Filename = filename:basename(Path),
+ Dir = filename:dirname(Path),
+ Path2 = filename:join([Dir, "PaxHeaders.0", Filename]),
+ AsciiPath = to_ascii(Path2),
+ Path3 = if byte_size(AsciiPath) > ?V7_NAME_LEN ->
+ binary_part(AsciiPath, 0, ?V7_NAME_LEN - 1);
+ true ->
+ AsciiPath
+ end,
+ Keys = maps:keys(PaxAttrs),
+ SortedKeys = lists:sort(Keys),
+ PaxFile = build_pax_file(SortedKeys, PaxAttrs),
+ Size = byte_size(PaxFile),
+ Padding = (?BLOCK_SIZE -
+ (byte_size(PaxFile) rem ?BLOCK_SIZE)) rem ?BLOCK_SIZE,
+ Pad = <<0:Padding/unit:8>>,
+ PaxHeader = #tar_header{
+ name=unicode:characters_to_list(Path3),
+ size=Size,
+ mtime=Header#tar_header.mtime,
+ atime=Header#tar_header.atime,
+ ctime=Header#tar_header.ctime,
+ typeflag=?TYPE_X_HEADER
+ },
+ {ok, PaxHeaderData} = build_header(PaxHeader, Opts),
+ [PaxHeaderData, PaxFile, Pad].
+
+build_pax_file(Keys, PaxAttrs) ->
+ build_pax_file(Keys, PaxAttrs, []).
+build_pax_file([], _, Acc) ->
+ unicode:characters_to_binary(Acc);
+build_pax_file([K|Rest], Attrs, Acc) ->
+ V = maps:get(K, Attrs),
+ Size = sizeof(K) + sizeof(V) + 3,
+ Size2 = sizeof(Size) + Size,
+ Key = to_string(K),
+ Value = to_string(V),
+ Record = unicode:characters_to_binary(io_lib:format("~B ~ts=~ts\n", [Size2, Key, Value])),
+ if byte_size(Record) =/= Size2 ->
+ Size3 = byte_size(Record),
+ Record2 = io_lib:format("~B ~ts=~ts\n", [Size3, Key, Value]),
+ build_pax_file(Rest, Attrs, [Acc, Record2]);
+ true ->
+ build_pax_file(Rest, Attrs, [Acc, Record])
+ end.
-default_options() ->
- {ok, Cwd} = file:get_cwd(),
- #read_opts{cwd=Cwd}.
+sizeof(Bin) when is_binary(Bin) ->
+ byte_size(Bin);
+sizeof(List) when is_list(List) ->
+ length(List);
+sizeof(N) when is_integer(N) ->
+ byte_size(integer_to_binary(N));
+sizeof(N) when is_float(N) ->
+ byte_size(float_to_binary(N)).
+
+to_string(Bin) when is_binary(Bin) ->
+ unicode:characters_to_list(Bin);
+to_string(List) when is_list(List) ->
+ List;
+to_string(N) when is_integer(N) ->
+ integer_to_list(N);
+to_string(N) when is_float(N) ->
+ float_to_list(N).
+
+split_ustar_path(Path) ->
+ Len = length(Path),
+ NotAscii = not is_ascii(Path),
+ if Len =< ?V7_NAME_LEN; NotAscii ->
+ false;
+ true ->
+ PathBin = binary:list_to_bin(Path),
+ case binary:split(PathBin, [<<$/>>], [global, trim_all]) of
+ [Part] when byte_size(Part) >= ?V7_NAME_LEN ->
+ false;
+ Parts ->
+ case lists:last(Parts) of
+ Name when byte_size(Name) >= ?V7_NAME_LEN ->
+ false;
+ Name ->
+ Parts2 = lists:sublist(Parts, length(Parts) - 1),
+ join_split_ustar_path(Parts2, {ok, Name, nil})
+ end
+ end
+ end.
-%% Parse options for extract.
+join_split_ustar_path([], Acc) ->
+ Acc;
+join_split_ustar_path([Part|_], {ok, _, nil})
+ when byte_size(Part) > ?USTAR_PREFIX_LEN ->
+ false;
+join_split_ustar_path([Part|_], {ok, _Name, Acc})
+ when (byte_size(Part)+byte_size(Acc)) > ?USTAR_PREFIX_LEN ->
+ false;
+join_split_ustar_path([Part|Rest], {ok, Name, nil}) ->
+ join_split_ustar_path(Rest, {ok, Name, Part});
+join_split_ustar_path([Part|Rest], {ok, Name, Acc}) ->
+ join_split_ustar_path(Rest, {ok, Name, <<Acc/binary,$/,Part/binary>>}).
+
+datetime_to_posix(DateTime) ->
+ Epoch = calendar:datetime_to_gregorian_seconds(?EPOCH),
+ Secs = calendar:datetime_to_gregorian_seconds(DateTime),
+ case Secs - Epoch of
+ N when N < 0 -> 0;
+ N -> N
+ end.
-extract_opts([keep_old_files|Rest], Opts) ->
- extract_opts(Rest, Opts#read_opts{keep_old_files=true});
-extract_opts([{cwd, Cwd}|Rest], Opts) ->
- extract_opts(Rest, Opts#read_opts{cwd=Cwd});
-extract_opts([{files, Files}|Rest], Opts) ->
- Set = ordsets:from_list(Files),
- extract_opts(Rest, Opts#read_opts{files=Set});
-extract_opts([memory|Rest], Opts) ->
- extract_opts(Rest, Opts#read_opts{output=memory});
-extract_opts([compressed|Rest], Opts=#read_opts{open_mode=OpenMode}) ->
- extract_opts(Rest, Opts#read_opts{open_mode=[compressed|OpenMode]});
-extract_opts([cooked|Rest], Opts=#read_opts{open_mode=OpenMode}) ->
- extract_opts(Rest, Opts#read_opts{open_mode=[cooked|OpenMode]});
-extract_opts([verbose|Rest], Opts) ->
- extract_opts(Rest, Opts#read_opts{verbose=true});
-extract_opts([Other|Rest], Opts) ->
- extract_opts(Rest, read_opts([Other], Opts));
-extract_opts([], Opts) ->
- Opts.
+write_octal(Block, Pos, Size, X) ->
+ Octal = zero_pad(format_octal(X), Size-1),
+ if byte_size(Octal) < Size ->
+ write_to_block(Block, Octal, Pos);
+ true ->
+ throw({error, {write_failed, octal_field_too_long}})
+ end.
-%% Common options for all read operations.
+write_string(Block, Pos, Size, Str, PaxAttr, Pax0) ->
+ NotAscii = not is_ascii(Str),
+ if PaxAttr =/= ?PAX_NONE andalso (length(Str) > Size orelse NotAscii) ->
+ Pax1 = maps:put(PaxAttr, Str, Pax0),
+ {Block, Pax1};
+ true ->
+ Formatted = format_string(Str, Size),
+ {write_to_block(Block, Formatted, Pos), Pax0}
+ end.
+write_numeric(Block, Pos, Size, X, PaxAttr, Pax0) ->
+ %% attempt octal
+ Octal = zero_pad(format_octal(X), Size-1),
+ if byte_size(Octal) < Size ->
+ {write_to_block(Block, [Octal, 0], Pos), Pax0};
+ PaxAttr =/= ?PAX_NONE ->
+ Pax1 = maps:put(PaxAttr, X, Pax0),
+ {Block, Pax1};
+ true ->
+ throw({error, {write_failed, numeric_field_too_long}})
+ end.
-read_opts([compressed|Rest], Opts=#read_opts{open_mode=OpenMode}) ->
- read_opts(Rest, Opts#read_opts{open_mode=[compressed|OpenMode]});
-read_opts([cooked|Rest], Opts=#read_opts{open_mode=OpenMode}) ->
- read_opts(Rest, Opts#read_opts{open_mode=[cooked|OpenMode]});
-read_opts([verbose|Rest], Opts) ->
- read_opts(Rest, Opts#read_opts{verbose=true});
-read_opts([_|Rest], Opts) ->
- read_opts(Rest, Opts);
-read_opts([], Opts) ->
- Opts.
+zero_pad(Str, Size) when byte_size(Str) >= Size ->
+ Str;
+zero_pad(Str, Size) ->
+ Padding = Size - byte_size(Str),
+ Pad = binary:copy(<<$0>>, Padding),
+ <<Pad/binary, Str/binary>>.
-foldl_read({AccessMode,TD={tar_descriptor,_UsrHandle,_AccessFun}}, Fun, Accu, Opts) ->
- case AccessMode of
- read ->
- foldl_read0(TD, Fun, Accu, Opts);
- _ ->
- {error,{read_mode_expected,AccessMode}}
- end;
-foldl_read(TarName, Fun, Accu, Opts) ->
- case open(TarName, [read|Opts#read_opts.open_mode]) of
- {ok, {read, File}} ->
- Result = foldl_read0(File, Fun, Accu, Opts),
- ok = do_close(File),
- Result;
- Error ->
- Error
+
+%%%================================================================
+%% Functions for creating or modifying tar archives
+
+read_block(Reader) ->
+ case do_read(Reader, ?BLOCK_SIZE) of
+ eof ->
+ throw({error, eof});
+ %% Two zero blocks mark the end of the archive
+ {ok, ?ZERO_BLOCK, Reader1} ->
+ case do_read(Reader1, ?BLOCK_SIZE) of
+ eof ->
+ % This is technically a malformed end-of-archive marker,
+ % as two ZERO_BLOCKs are expected as the marker,
+ % but if we've already made it this far, we should just ignore it
+ eof;
+ {ok, ?ZERO_BLOCK, _Reader2} ->
+ eof;
+ {ok, _Block, _Reader2} ->
+ throw({error, invalid_end_of_archive});
+ {error,_} = Err ->
+ throw(Err)
+ end;
+ {ok, Block, Reader1} when is_binary(Block) ->
+ {ok, Block, Reader1};
+ {error, _} = Err ->
+ throw(Err)
end.
-foldl_read0(File, Fun, Accu, Opts) ->
- case catch foldl_read1(Fun, Accu, File, Opts) of
- {'EXIT', Reason} ->
- exit(Reason);
- {error, {Reason, Format, Args}} ->
- read_verbose(Opts, Format, Args),
- {error, Reason};
- {error, Reason} ->
- {error, Reason};
- Ok ->
- Ok
+get_header(#reader{}=Reader) ->
+ case read_block(Reader) of
+ eof ->
+ eof;
+ {ok, Block, Reader1} ->
+ convert_header(Block, Reader1)
end.
-foldl_read1(Fun, Accu0, File, Opts) ->
- case get_header(File) of
- eof ->
- Fun(eof, File, Opts, Accu0);
- Header ->
- {ok, NewAccu} = Fun(Header, File, Opts, Accu0),
- foldl_read1(Fun, NewAccu, File, Opts)
+%% Converts the tar header to a record.
+to_v7(Bin) when is_binary(Bin), byte_size(Bin) =:= ?BLOCK_SIZE ->
+ #header_v7{
+ name=binary_part(Bin, ?V7_NAME, ?V7_NAME_LEN),
+ mode=binary_part(Bin, ?V7_MODE, ?V7_MODE_LEN),
+ uid=binary_part(Bin, ?V7_UID, ?V7_UID_LEN),
+ gid=binary_part(Bin, ?V7_GID, ?V7_GID_LEN),
+ size=binary_part(Bin, ?V7_SIZE, ?V7_SIZE_LEN),
+ mtime=binary_part(Bin, ?V7_MTIME, ?V7_MTIME_LEN),
+ checksum=binary_part(Bin, ?V7_CHKSUM, ?V7_CHKSUM_LEN),
+ typeflag=binary:at(Bin, ?V7_TYPE),
+ linkname=binary_part(Bin, ?V7_LINKNAME, ?V7_LINKNAME_LEN)
+ };
+to_v7(_) ->
+ {error, header_block_too_small}.
+
+to_gnu(#header_v7{}=V7, Bin)
+ when is_binary(Bin), byte_size(Bin) =:= ?BLOCK_SIZE ->
+ #header_gnu{
+ header_v7=V7,
+ magic=binary_part(Bin, ?GNU_MAGIC, ?GNU_MAGIC_LEN),
+ version=binary_part(Bin, ?GNU_VERSION, ?GNU_VERSION_LEN),
+ uname=binary_part(Bin, 265, 32),
+ gname=binary_part(Bin, 297, 32),
+ devmajor=binary_part(Bin, 329, 8),
+ devminor=binary_part(Bin, 337, 8),
+ atime=binary_part(Bin, 345, 12),
+ ctime=binary_part(Bin, 357, 12),
+ sparse=to_sparse_array(binary_part(Bin, 386, 24*4+1)),
+ real_size=binary_part(Bin, 483, 12)
+ }.
+
+to_star(#header_v7{}=V7, Bin)
+ when is_binary(Bin), byte_size(Bin) =:= ?BLOCK_SIZE ->
+ #header_star{
+ header_v7=V7,
+ magic=binary_part(Bin, ?USTAR_MAGIC, ?USTAR_MAGIC_LEN),
+ version=binary_part(Bin, ?USTAR_VERSION, ?USTAR_VERSION_LEN),
+ uname=binary_part(Bin, ?USTAR_UNAME, ?USTAR_UNAME_LEN),
+ gname=binary_part(Bin, ?USTAR_GNAME, ?USTAR_GNAME_LEN),
+ devmajor=binary_part(Bin, ?USTAR_DEVMAJ, ?USTAR_DEVMAJ_LEN),
+ devminor=binary_part(Bin, ?USTAR_DEVMIN, ?USTAR_DEVMIN_LEN),
+ prefix=binary_part(Bin, 345, 131),
+ atime=binary_part(Bin, 476, 12),
+ ctime=binary_part(Bin, 488, 12),
+ trailer=binary_part(Bin, ?STAR_TRAILER, ?STAR_TRAILER_LEN)
+ }.
+
+to_ustar(#header_v7{}=V7, Bin)
+ when is_binary(Bin), byte_size(Bin) =:= ?BLOCK_SIZE ->
+ #header_ustar{
+ header_v7=V7,
+ magic=binary_part(Bin, ?USTAR_MAGIC, ?USTAR_MAGIC_LEN),
+ version=binary_part(Bin, ?USTAR_VERSION, ?USTAR_VERSION_LEN),
+ uname=binary_part(Bin, ?USTAR_UNAME, ?USTAR_UNAME_LEN),
+ gname=binary_part(Bin, ?USTAR_GNAME, ?USTAR_GNAME_LEN),
+ devmajor=binary_part(Bin, ?USTAR_DEVMAJ, ?USTAR_DEVMAJ_LEN),
+ devminor=binary_part(Bin, ?USTAR_DEVMIN, ?USTAR_DEVMIN_LEN),
+ prefix=binary_part(Bin, 345, 155)
+ }.
+
+to_sparse_array(Bin) when is_binary(Bin) ->
+ MaxEntries = byte_size(Bin) div 24,
+ IsExtended = 1 =:= binary:at(Bin, 24*MaxEntries),
+ Entries = parse_sparse_entries(Bin, MaxEntries-1, []),
+ #sparse_array{
+ entries=Entries,
+ max_entries=MaxEntries,
+ is_extended=IsExtended
+ }.
+
+parse_sparse_entries(<<>>, _, Acc) ->
+ Acc;
+parse_sparse_entries(_, -1, Acc) ->
+ Acc;
+parse_sparse_entries(Bin, N, Acc) ->
+ case to_sparse_entry(binary_part(Bin, N*24, 24)) of
+ nil ->
+ parse_sparse_entries(Bin, N-1, Acc);
+ Entry = #sparse_entry{} ->
+ parse_sparse_entries(Bin, N-1, [Entry|Acc])
end.
-table1(eof, _, _, Result) ->
- {ok, lists:reverse(Result)};
-table1(Header = #tar_header{}, File, #read_opts{verbose=true}, Result) ->
- #tar_header{name=Name, size=Size, mtime=Mtime, typeflag=Type,
- mode=Mode, uid=Uid, gid=Gid} = Header,
- skip(File, Size),
- {ok, [{Name, Type, Size, posix_to_erlang_time(Mtime), Mode, Uid, Gid}|Result]};
-table1(#tar_header{name=Name, size=Size}, File, _, Result) ->
- skip(File, Size),
- {ok, [Name|Result]}.
-
-extract1(eof, _, _, Acc) ->
- if
- is_list(Acc) ->
- {ok, lists:reverse(Acc)};
- true ->
- Acc
- end;
-extract1(Header, File, Opts, Acc) ->
- Name = Header#tar_header.name,
- case check_extract(Name, Opts) of
- true ->
- {ok, Bin} = get_element(File, Header),
- case write_extracted_element(Header, Bin, Opts) of
- ok ->
- {ok, Acc};
- {ok, NameBin} when is_list(Acc) ->
- {ok, [NameBin | Acc]};
- {ok, NameBin} when Acc =:= ok ->
- {ok, [NameBin]}
- end;
- false ->
- ok = skip(File, Header#tar_header.size),
- {ok, Acc}
+-define(EMPTY_ENTRY, <<0,0,0,0,0,0,0,0,0,0,0,0>>).
+to_sparse_entry(Bin) when is_binary(Bin), byte_size(Bin) =:= 24 ->
+ OffsetBin = binary_part(Bin, 0, 12),
+ NumBytesBin = binary_part(Bin, 12, 12),
+ case {OffsetBin, NumBytesBin} of
+ {?EMPTY_ENTRY, ?EMPTY_ENTRY} ->
+ nil;
+ _ ->
+ #sparse_entry{
+ offset=parse_numeric(OffsetBin),
+ num_bytes=parse_numeric(NumBytesBin)}
end.
-%% Checks if the file Name should be extracted.
+-spec get_format(binary()) -> {ok, pos_integer(), header_v7()}
+ | ?FORMAT_UNKNOWN
+ | {error, term()}.
+get_format(Bin) when is_binary(Bin), byte_size(Bin) =:= ?BLOCK_SIZE ->
+ do_get_format(to_v7(Bin), Bin).
+
+do_get_format({error, _} = Err, _Bin) ->
+ Err;
+do_get_format(#header_v7{}=V7, Bin)
+ when is_binary(Bin), byte_size(Bin) =:= ?BLOCK_SIZE ->
+ Checksum = parse_octal(V7#header_v7.checksum),
+ Chk1 = compute_checksum(Bin),
+ Chk2 = compute_signed_checksum(Bin),
+ if Checksum =/= Chk1 andalso Checksum =/= Chk2 ->
+ ?FORMAT_UNKNOWN;
+ true ->
+ %% guess magic
+ Ustar = to_ustar(V7, Bin),
+ Star = to_star(V7, Bin),
+ Magic = Ustar#header_ustar.magic,
+ Version = Ustar#header_ustar.version,
+ Trailer = Star#header_star.trailer,
+ Format = if
+ Magic =:= ?MAGIC_USTAR, Trailer =:= ?TRAILER_STAR ->
+ ?FORMAT_STAR;
+ Magic =:= ?MAGIC_USTAR ->
+ ?FORMAT_USTAR;
+ Magic =:= ?MAGIC_GNU, Version =:= ?VERSION_GNU ->
+ ?FORMAT_GNU;
+ true ->
+ ?FORMAT_V7
+ end,
+ {ok, Format, V7}
+ end.
-check_extract(_, #read_opts{files=all}) ->
+unpack_format(Format, #header_v7{}=V7, Bin, Reader)
+ when is_binary(Bin), byte_size(Bin) =:= ?BLOCK_SIZE ->
+ Mtime = posix_to_erlang_time(parse_numeric(V7#header_v7.mtime)),
+ Header0 = #tar_header{
+ name=parse_string(V7#header_v7.name),
+ mode=parse_numeric(V7#header_v7.mode),
+ uid=parse_numeric(V7#header_v7.uid),
+ gid=parse_numeric(V7#header_v7.gid),
+ size=parse_numeric(V7#header_v7.size),
+ mtime=Mtime,
+ atime=Mtime,
+ ctime=Mtime,
+ typeflag=V7#header_v7.typeflag,
+ linkname=parse_string(V7#header_v7.linkname)
+ },
+ Typeflag = Header0#tar_header.typeflag,
+ Header1 = if Format > ?FORMAT_V7 ->
+ unpack_modern(Format, V7, Bin, Header0);
+ true ->
+ Name = Header0#tar_header.name,
+ Header0#tar_header{name=safe_join_path("", Name)}
+ end,
+ HeaderOnly = is_header_only_type(Typeflag),
+ Header2 = if HeaderOnly ->
+ Header1#tar_header{size=0};
+ true ->
+ Header1
+ end,
+ if Typeflag =:= ?TYPE_GNU_SPARSE ->
+ Gnu = to_gnu(V7, Bin),
+ RealSize = parse_numeric(Gnu#header_gnu.real_size),
+ {Sparsemap, Reader2} = parse_sparse_map(Gnu, Reader),
+ Header3 = Header2#tar_header{size=RealSize},
+ {Header3, new_sparse_file_reader(Reader2, Sparsemap, RealSize)};
+ true ->
+ FileReader = #reg_file_reader{
+ handle=Reader,
+ num_bytes=Header2#tar_header.size,
+ size=Header2#tar_header.size,
+ pos = 0
+ },
+ {Header2, FileReader}
+ end.
+
+unpack_modern(Format, #header_v7{}=V7, Bin, #tar_header{}=Header0)
+ when is_binary(Bin) ->
+ Typeflag = Header0#tar_header.typeflag,
+ Ustar = to_ustar(V7, Bin),
+ H0 = Header0#tar_header{
+ uname=parse_string(Ustar#header_ustar.uname),
+ gname=parse_string(Ustar#header_ustar.gname)},
+ H1 = if Typeflag =:= ?TYPE_CHAR
+ orelse Typeflag =:= ?TYPE_BLOCK ->
+ Ma = parse_numeric(Ustar#header_ustar.devmajor),
+ Mi = parse_numeric(Ustar#header_ustar.devminor),
+ H0#tar_header{
+ devmajor=Ma,
+ devminor=Mi
+ };
+ true ->
+ H0
+ end,
+ {Prefix, H2} = case Format of
+ ?FORMAT_USTAR ->
+ {parse_string(Ustar#header_ustar.prefix), H1};
+ ?FORMAT_STAR ->
+ Star = to_star(V7, Bin),
+ Prefix0 = parse_string(Star#header_star.prefix),
+ Atime0 = Star#header_star.atime,
+ Atime = posix_to_erlang_time(parse_numeric(Atime0)),
+ Ctime0 = Star#header_star.ctime,
+ Ctime = posix_to_erlang_time(parse_numeric(Ctime0)),
+ {Prefix0, H1#tar_header{
+ atime=Atime,
+ ctime=Ctime
+ }};
+ _ ->
+ {"", H1}
+ end,
+ Name = H2#tar_header.name,
+ H2#tar_header{name=safe_join_path(Prefix, Name)}.
+
+
+safe_join_path([], Name) ->
+ strip_slashes(Name, both);
+safe_join_path(Prefix, []) ->
+ strip_slashes(Prefix, right);
+safe_join_path(Prefix, Name) ->
+ filename:join(strip_slashes(Prefix, right), strip_slashes(Name, both)).
+
+strip_slashes(Str, Direction) ->
+ string:strip(Str, Direction, $/).
+
+new_sparse_file_reader(Reader, Sparsemap, RealSize) ->
+ true = validate_sparse_entries(Sparsemap, RealSize),
+ #sparse_file_reader{
+ handle = Reader,
+ num_bytes = RealSize,
+ pos = 0,
+ size = RealSize,
+ sparse_map = Sparsemap}.
+
+validate_sparse_entries(Entries, RealSize) ->
+ validate_sparse_entries(Entries, RealSize, 0, 0).
+validate_sparse_entries([], _RealSize, _I, _LastOffset) ->
true;
-check_extract(Name, #read_opts{files=Files}) ->
- ordsets:is_element(Name, Files).
+validate_sparse_entries([#sparse_entry{}=Entry|Rest], RealSize, I, LastOffset) ->
+ Offset = Entry#sparse_entry.offset,
+ NumBytes = Entry#sparse_entry.num_bytes,
+ if
+ Offset > ?MAX_INT64-NumBytes ->
+ throw({error, {invalid_sparse_map_entry, offset_too_large}});
+ Offset+NumBytes > RealSize ->
+ throw({error, {invalid_sparse_map_entry, offset_too_large}});
+ I > 0 andalso LastOffset > Offset ->
+ throw({error, {invalid_sparse_map_entry, overlapping_offsets}});
+ true ->
+ ok
+ end,
+ validate_sparse_entries(Rest, RealSize, I+1, Offset+NumBytes).
+
+
+-spec parse_sparse_map(header_gnu(), reader_type()) ->
+ {[sparse_entry()], reader_type()}.
+parse_sparse_map(#header_gnu{sparse=Sparse}, Reader)
+ when Sparse#sparse_array.is_extended ->
+ parse_sparse_map(Sparse, Reader, []);
+parse_sparse_map(#header_gnu{sparse=Sparse}, Reader) ->
+ {Sparse#sparse_array.entries, Reader}.
+parse_sparse_map(#sparse_array{is_extended=true,entries=Entries}, Reader, Acc) ->
+ case read_block(Reader) of
+ eof ->
+ throw({error, eof});
+ {ok, Block, Reader2} ->
+ Sparse2 = to_sparse_array(Block),
+ parse_sparse_map(Sparse2, Reader2, Entries++Acc)
+ end;
+parse_sparse_map(#sparse_array{entries=Entries}, Reader, Acc) ->
+ Sorted = lists:sort(fun (#sparse_entry{offset=A},#sparse_entry{offset=B}) ->
+ A =< B
+ end, Entries++Acc),
+ {Sorted, Reader}.
+
+%% Defined by taking the sum of the unsigned byte values of the
+%% entire header record, treating the checksum bytes to as ASCII spaces
+compute_checksum(<<H1:?V7_CHKSUM/binary,
+ H2:?V7_CHKSUM_LEN/binary,
+ Rest:(?BLOCK_SIZE - ?V7_CHKSUM - ?V7_CHKSUM_LEN)/binary,
+ _/binary>>) ->
+ C0 = checksum(H1) + (byte_size(H2) * $\s),
+ C1 = checksum(Rest),
+ C0 + C1.
+
+compute_signed_checksum(<<H1:?V7_CHKSUM/binary,
+ H2:?V7_CHKSUM_LEN/binary,
+ Rest:(?BLOCK_SIZE - ?V7_CHKSUM - ?V7_CHKSUM_LEN)/binary,
+ _/binary>>) ->
+ C0 = signed_checksum(H1) + (byte_size(H2) * $\s),
+ C1 = signed_checksum(Rest),
+ C0 + C1.
-get_header(File) ->
- case do_read(File, ?record_size) of
- eof ->
- throw({error,eof});
- {ok, Bin} when is_binary(Bin) ->
- convert_header(Bin);
- {ok, List} ->
- convert_header(list_to_binary(List));
- {error, Reason} ->
- throw({error, Reason})
- end.
+%% Returns the checksum of a binary.
+checksum(Bin) -> checksum(Bin, 0).
+checksum(<<A/unsigned,Rest/binary>>, Sum) ->
+ checksum(Rest, Sum+A);
+checksum(<<>>, Sum) -> Sum.
-%% Converts the tar header to a record.
+signed_checksum(Bin) -> signed_checksum(Bin, 0).
+signed_checksum(<<A/signed,Rest/binary>>, Sum) ->
+ signed_checksum(Rest, Sum+A);
+signed_checksum(<<>>, Sum) -> Sum.
+
+-spec parse_numeric(binary()) -> non_neg_integer().
+parse_numeric(<<>>) ->
+ 0;
+parse_numeric(<<First, _/binary>> = Bin) ->
+ %% check for base-256 format first
+ %% if the bit is set, then all following bits constitute a two's
+ %% complement encoded number in big-endian byte order
+ if
+ First band 16#80 =/= 0 ->
+ %% Handling negative numbers relies on the following identity:
+ %% -a-1 == ^a
+ %% If the number is negative, we use an inversion mask to invert
+ %% the data bytes and treat the value as an unsigned number
+ Inv = if First band 16#40 =/= 0 -> 16#00; true -> 16#FF end,
+ Bytes = binary:bin_to_list(Bin),
+ Reducer = fun (C, {I, X}) ->
+ C1 = C bxor Inv,
+ C2 = if I =:= 0 -> C1 band 16#7F; true -> C1 end,
+ if (X bsr 56) > 0 ->
+ throw({error,integer_overflow});
+ true ->
+ {I+1, (X bsl 8) bor C2}
+ end
+ end,
+ {_, N} = lists:foldl(Reducer, {0,0}, Bytes),
+ if (N bsr 63) > 0 ->
+ throw({error, integer_overflow});
+ true ->
+ if Inv =:= 16#FF ->
+ -1 bxor N;
+ true ->
+ N
+ end
+ end;
+ true ->
+ %% normal case is an octal number
+ parse_octal(Bin)
+ end.
-convert_header(Bin) when byte_size(Bin) =:= ?record_size ->
- case verify_checksum(Bin) of
- ok ->
- Hd = #tar_header{name=get_name(Bin),
- mode=from_octal(Bin, ?th_mode, ?th_mode_len),
- uid=from_octal(Bin, ?th_uid, ?th_uid_len),
- gid=from_octal(Bin, ?th_gid, ?th_gid_len),
- size=from_octal(Bin, ?th_size, ?th_size_len),
- mtime=from_octal(Bin, ?th_mtime, ?th_mtime_len),
- linkname=from_string(Bin,
- ?th_linkname, ?th_linkname_len),
- typeflag=typeflag(Bin)},
- convert_header1(Hd);
- eof ->
- eof
+parse_octal(Bin) when is_binary(Bin) ->
+ %% skip leading/trailing zero bytes and spaces
+ do_parse_octal(Bin, <<>>).
+do_parse_octal(<<>>, <<>>) ->
+ 0;
+do_parse_octal(<<>>, Acc) ->
+ case io_lib:fread("~8u", binary:bin_to_list(Acc)) of
+ {error, _} -> throw({error, invalid_tar_checksum});
+ {ok, [Octal], []} -> Octal;
+ {ok, _, _} -> throw({error, invalid_tar_checksum})
end;
-convert_header(Bin) when byte_size(Bin) =:= 0 ->
+do_parse_octal(<<$\s,Rest/binary>>, Acc) ->
+ do_parse_octal(Rest, Acc);
+do_parse_octal(<<0, Rest/binary>>, Acc) ->
+ do_parse_octal(Rest, Acc);
+do_parse_octal(<<C, Rest/binary>>, Acc) ->
+ do_parse_octal(Rest, <<Acc/binary, C>>).
+
+parse_string(Bin) when is_binary(Bin) ->
+ do_parse_string(Bin, <<>>).
+do_parse_string(<<>>, Acc) ->
+ case unicode:characters_to_list(Acc) of
+ Str when is_list(Str) ->
+ Str;
+ {incomplete, _Str, _Rest} ->
+ binary:bin_to_list(Acc);
+ {error, _Str, _Rest} ->
+ throw({error, {bad_header, invalid_string}})
+ end;
+do_parse_string(<<0, _/binary>>, Acc) ->
+ do_parse_string(<<>>, Acc);
+do_parse_string(<<C, Rest/binary>>, Acc) ->
+ do_parse_string(Rest, <<Acc/binary, C>>).
+
+convert_header(Bin, #reader{pos=Pos}=Reader)
+ when byte_size(Bin) =:= ?BLOCK_SIZE, (Pos rem ?BLOCK_SIZE) =:= 0 ->
+ case get_format(Bin) of
+ ?FORMAT_UNKNOWN ->
+ throw({error, bad_header});
+ {ok, Format, V7} ->
+ unpack_format(Format, V7, Bin, Reader);
+ {error, Reason} ->
+ throw({error, {bad_header, Reason}})
+ end;
+convert_header(Bin, #reader{pos=Pos}) when byte_size(Bin) =:= ?BLOCK_SIZE ->
+ throw({error, misaligned_read, Pos});
+convert_header(Bin, _Reader) when byte_size(Bin) =:= 0 ->
eof;
-convert_header(_Bin) ->
+convert_header(_Bin, _Reader) ->
throw({error, eof}).
-%% Basic sanity. Better set the element size to zero here if the type
-%% always is of zero length.
-
-convert_header1(H) when H#tar_header.typeflag =:= symlink, H#tar_header.size =/= 0 ->
- convert_header1(H#tar_header{size=0});
-convert_header1(H) when H#tar_header.typeflag =:= directory, H#tar_header.size =/= 0 ->
- convert_header1(H#tar_header{size=0});
-convert_header1(Header) ->
- Header.
-
-typeflag(Bin) ->
- [T] = binary_to_list(Bin, ?th_typeflag+1, ?th_typeflag+1),
- case T of
- 0 -> regular;
- $0 -> regular;
- $1 -> link;
- $2 -> symlink;
- $3 -> char;
- $4 -> block;
- $5 -> directory;
- $6 -> fifo;
- $7 -> regular;
- _ -> unknown
+%% Creates a partially-populated header record based
+%% on the provided file_info record. If the file is
+%% a symlink, then `link` is used as the link target.
+%% If the file is a directory, a slash is appended to the name.
+fileinfo_to_header(Name, #file_info{}=Fi, Link) when is_list(Name) ->
+ BaseHeader = #tar_header{name=Name,
+ mtime=Fi#file_info.mtime,
+ atime=Fi#file_info.atime,
+ ctime=Fi#file_info.ctime,
+ mode=Fi#file_info.mode,
+ uid=Fi#file_info.uid,
+ gid=Fi#file_info.gid,
+ typeflag=?TYPE_REGULAR},
+ do_fileinfo_to_header(BaseHeader, Fi, Link).
+
+do_fileinfo_to_header(Header, #file_info{size=Size,type=regular}, _Link) ->
+ Header#tar_header{size=Size,typeflag=?TYPE_REGULAR};
+do_fileinfo_to_header(#tar_header{name=Name}=Header,
+ #file_info{type=directory}, _Link) ->
+ Header#tar_header{name=Name++"/",typeflag=?TYPE_DIR};
+do_fileinfo_to_header(Header, #file_info{type=symlink}, Link) ->
+ Header#tar_header{typeflag=?TYPE_SYMLINK,linkname=Link};
+do_fileinfo_to_header(Header, #file_info{type=device,mode=Mode}=Fi, _Link)
+ when (Mode band ?S_IFMT) =:= ?S_IFCHR ->
+ Header#tar_header{typeflag=?TYPE_CHAR,
+ devmajor=Fi#file_info.major_device,
+ devminor=Fi#file_info.minor_device};
+do_fileinfo_to_header(Header, #file_info{type=device,mode=Mode}=Fi, _Link)
+ when (Mode band ?S_IFMT) =:= ?S_IFBLK ->
+ Header#tar_header{typeflag=?TYPE_BLOCK,
+ devmajor=Fi#file_info.major_device,
+ devminor=Fi#file_info.minor_device};
+do_fileinfo_to_header(Header, #file_info{type=other,mode=Mode}, _Link)
+ when (Mode band ?S_IFMT) =:= ?S_FIFO ->
+ Header#tar_header{typeflag=?TYPE_FIFO};
+do_fileinfo_to_header(Header, Fi, _Link) ->
+ {error, {invalid_file_type, Header#tar_header.name, Fi}}.
+
+is_ascii(Str) when is_list(Str) ->
+ not lists:any(fun (Char) -> Char >= 16#80 end, Str);
+is_ascii(Bin) when is_binary(Bin) ->
+ is_ascii1(Bin).
+
+is_ascii1(<<>>) ->
+ true;
+is_ascii1(<<C,_Rest/binary>>) when C >= 16#80 ->
+ false;
+is_ascii1(<<_, Rest/binary>>) ->
+ is_ascii1(Rest).
+
+to_ascii(Str) when is_list(Str) ->
+ case is_ascii(Str) of
+ true ->
+ unicode:characters_to_binary(Str);
+ false ->
+ Chars = lists:filter(fun (Char) -> Char < 16#80 end, Str),
+ unicode:characters_to_binary(Chars)
+ end;
+to_ascii(Bin) when is_binary(Bin) ->
+ to_ascii(Bin, <<>>).
+to_ascii(<<>>, Acc) ->
+ Acc;
+to_ascii(<<C, Rest/binary>>, Acc) when C < 16#80 ->
+ to_ascii(Rest, <<Acc/binary,C>>);
+to_ascii(<<_, Rest/binary>>, Acc) ->
+ to_ascii(Rest, Acc).
+
+is_header_only_type(?TYPE_SYMLINK) -> true;
+is_header_only_type(?TYPE_LINK) -> true;
+is_header_only_type(?TYPE_DIR) -> true;
+is_header_only_type(_) -> false.
+
+posix_to_erlang_time(Sec) ->
+ OneMillion = 1000000,
+ Time = calendar:now_to_datetime({Sec div OneMillion, Sec rem OneMillion, 0}),
+ erlang:universaltime_to_localtime(Time).
+
+foldl_read(#reader{access=read}=Reader, Fun, Accu, #read_opts{}=Opts)
+ when is_function(Fun,4) ->
+ case foldl_read0(Reader, Fun, Accu, Opts) of
+ {ok, Result, _Reader2} ->
+ Result;
+ {error, _} = Err ->
+ Err
+ end;
+foldl_read(#reader{access=Access}, _Fun, _Accu, _Opts) ->
+ {error, {read_mode_expected, Access}};
+foldl_read(TarName, Fun, Accu, #read_opts{}=Opts)
+ when is_function(Fun,4) ->
+ try open(TarName, [read|Opts#read_opts.open_mode]) of
+ {ok, #reader{access=read}=Reader} ->
+ try
+ foldl_read(Reader, Fun, Accu, Opts)
+ after
+ _ = close(Reader)
+ end;
+ {error, _} = Err ->
+ Err
+ catch
+ throw:Err ->
+ Err
end.
-%% Get the name of the file from the prefix and name fields of the
-%% tar header.
-
-get_name(Bin0) ->
- List0 = get_name_raw(Bin0),
- case file:native_name_encoding() of
- utf8 ->
- Bin = list_to_binary(List0),
- case unicode:characters_to_list(Bin) of
- {error,_,_} ->
- List0;
- List when is_list(List) ->
- List
- end;
- latin1 ->
- List0
+foldl_read0(Reader, Fun, Accu, Opts) ->
+ try foldl_read1(Fun, Accu, Reader, Opts, #{}) of
+ {ok,_,_} = Ok ->
+ Ok
+ catch
+ throw:{error, {Reason, Format, Args}} ->
+ read_verbose(Opts, Format, Args),
+ {error, Reason};
+ throw:Err ->
+ Err
end.
-get_name_raw(Bin) ->
- Name = from_string(Bin, ?th_name, ?th_name_len),
- case binary_to_list(Bin, ?th_prefix+1, ?th_prefix+1) of
- [0] ->
- Name;
- [_] ->
- Prefix = binary_to_list(Bin, ?th_prefix+1, byte_size(Bin)),
- lists:reverse(remove_nulls(Prefix), [$/|Name])
+foldl_read1(Fun, Accu0, Reader0, Opts, ExtraHeaders) ->
+ {ok, Reader1} = skip_unread(Reader0),
+ case get_header(Reader1) of
+ eof ->
+ Fun(eof, Reader1, Opts, Accu0);
+ {Header, Reader2} ->
+ case Header#tar_header.typeflag of
+ ?TYPE_X_HEADER ->
+ {ExtraHeaders2, Reader3} = parse_pax(Reader2),
+ ExtraHeaders3 = maps:merge(ExtraHeaders, ExtraHeaders2),
+ foldl_read1(Fun, Accu0, Reader3, Opts, ExtraHeaders3);
+ ?TYPE_GNU_LONGNAME ->
+ {RealName, Reader3} = get_real_name(Reader2),
+ ExtraHeaders2 = maps:put(?PAX_PATH,
+ parse_string(RealName), ExtraHeaders),
+ foldl_read1(Fun, Accu0, Reader3, Opts, ExtraHeaders2);
+ ?TYPE_GNU_LONGLINK ->
+ {RealName, Reader3} = get_real_name(Reader2),
+ ExtraHeaders2 = maps:put(?PAX_LINKPATH,
+ parse_string(RealName), ExtraHeaders),
+ foldl_read1(Fun, Accu0, Reader3, Opts, ExtraHeaders2);
+ _ ->
+ Header1 = merge_pax(Header, ExtraHeaders),
+ {ok, NewAccu, Reader3} = Fun(Header1, Reader2, Opts, Accu0),
+ foldl_read1(Fun, NewAccu, Reader3, Opts, #{})
+ end
end.
-from_string(Bin, Pos, Len) ->
- lists:reverse(remove_nulls(binary_to_list(Bin, Pos+1, Pos+Len))).
-
-%% Returns all characters up to (but not including) the first null
-%% character, in REVERSE order.
-
-remove_nulls(List) ->
- remove_nulls(List, []).
-
-remove_nulls([0|_], Result) ->
- remove_nulls([], Result);
-remove_nulls([C|Rest], Result) ->
- remove_nulls(Rest, [C|Result]);
-remove_nulls([], Result) ->
- Result.
-
-from_octal(Bin, Pos, Len) ->
- from_octal(binary_to_list(Bin, Pos+1, Pos+Len)).
-
-from_octal([$\s|Rest]) ->
- from_octal(Rest);
-from_octal([Digit|Rest]) when $0 =< Digit, Digit =< $7 ->
- from_octal(Rest, Digit-$0);
-from_octal(Bin) when is_binary(Bin) ->
- from_octal(binary_to_list(Bin));
-from_octal(Other) ->
- throw({error, {bad_header, "Bad octal number: ~p", [Other]}}).
-
-from_octal([Digit|Rest], Result) when $0 =< Digit, Digit =< $7 ->
- from_octal(Rest, Result*8+Digit-$0);
-from_octal([$\s|_], Result) ->
- Result;
-from_octal([0|_], Result) ->
- Result;
-from_octal(Other, _) ->
- throw({error, {bad_header, "Bad contents in octal field: ~p", [Other]}}).
-
-%% Retrieves the next element from the archive.
-%% Returns {ok, Bin} | eof | {error, Reason}
-
-get_element(File, #tar_header{size = 0}) ->
- skip_to_next(File),
- {ok,<<>>};
-get_element(File, #tar_header{size = Size}) ->
- case do_read(File, Size) of
- {ok,Bin}=Res when byte_size(Bin) =:= Size ->
- skip_to_next(File),
- Res;
- {ok,List} when length(List) =:= Size ->
- skip_to_next(File),
- {ok,list_to_binary(List)};
- {ok,_} -> throw({error,eof});
- {error, Reason} -> throw({error, Reason});
- eof -> throw({error,eof})
+%% Applies all known PAX attributes to the current tar header
+-spec merge_pax(tar_header(), #{binary() => binary()}) -> tar_header().
+merge_pax(Header, ExtraHeaders) when is_map(ExtraHeaders) ->
+ do_merge_pax(Header, maps:to_list(ExtraHeaders)).
+
+do_merge_pax(Header, []) ->
+ Header;
+do_merge_pax(Header, [{?PAX_PATH, Path}|Rest]) ->
+ do_merge_pax(Header#tar_header{name=unicode:characters_to_list(Path)}, Rest);
+do_merge_pax(Header, [{?PAX_LINKPATH, LinkPath}|Rest]) ->
+ do_merge_pax(Header#tar_header{linkname=unicode:characters_to_list(LinkPath)}, Rest);
+do_merge_pax(Header, [{?PAX_GNAME, Gname}|Rest]) ->
+ do_merge_pax(Header#tar_header{gname=unicode:characters_to_list(Gname)}, Rest);
+do_merge_pax(Header, [{?PAX_UNAME, Uname}|Rest]) ->
+ do_merge_pax(Header#tar_header{uname=unicode:characters_to_list(Uname)}, Rest);
+do_merge_pax(Header, [{?PAX_UID, Uid}|Rest]) ->
+ Uid2 = binary_to_integer(Uid),
+ do_merge_pax(Header#tar_header{uid=Uid2}, Rest);
+do_merge_pax(Header, [{?PAX_GID, Gid}|Rest]) ->
+ Gid2 = binary_to_integer(Gid),
+ do_merge_pax(Header#tar_header{gid=Gid2}, Rest);
+do_merge_pax(Header, [{?PAX_ATIME, Atime}|Rest]) ->
+ Atime2 = parse_pax_time(Atime),
+ do_merge_pax(Header#tar_header{atime=Atime2}, Rest);
+do_merge_pax(Header, [{?PAX_MTIME, Mtime}|Rest]) ->
+ Mtime2 = parse_pax_time(Mtime),
+ do_merge_pax(Header#tar_header{mtime=Mtime2}, Rest);
+do_merge_pax(Header, [{?PAX_CTIME, Ctime}|Rest]) ->
+ Ctime2 = parse_pax_time(Ctime),
+ do_merge_pax(Header#tar_header{ctime=Ctime2}, Rest);
+do_merge_pax(Header, [{?PAX_SIZE, Size}|Rest]) ->
+ Size2 = binary_to_integer(Size),
+ do_merge_pax(Header#tar_header{size=Size2}, Rest);
+do_merge_pax(Header, [{<<?PAX_XATTR_STR, _Key/binary>>, _Value}|Rest]) ->
+ do_merge_pax(Header, Rest);
+do_merge_pax(Header, [_Ignore|Rest]) ->
+ do_merge_pax(Header, Rest).
+
+%% Returns the time since UNIX epoch as a datetime
+-spec parse_pax_time(binary()) -> calendar:datetime().
+parse_pax_time(Bin) when is_binary(Bin) ->
+ TotalNano = case binary:split(Bin, [<<$.>>]) of
+ [SecondsStr, NanoStr0] ->
+ Seconds = binary_to_integer(SecondsStr),
+ if byte_size(NanoStr0) < ?MAX_NANO_INT_SIZE ->
+ %% right pad
+ PaddingN = ?MAX_NANO_INT_SIZE-byte_size(NanoStr0),
+ Padding = binary:copy(<<$0>>, PaddingN),
+ NanoStr1 = <<NanoStr0/binary,Padding/binary>>,
+ Nano = binary_to_integer(NanoStr1),
+ (Seconds*?BILLION)+Nano;
+ byte_size(NanoStr0) > ?MAX_NANO_INT_SIZE ->
+ %% right truncate
+ NanoStr1 = binary_part(NanoStr0, 0, ?MAX_NANO_INT_SIZE),
+ Nano = binary_to_integer(NanoStr1),
+ (Seconds*?BILLION)+Nano;
+ true ->
+ (Seconds*?BILLION)+binary_to_integer(NanoStr0)
+ end;
+ [SecondsStr] ->
+ binary_to_integer(SecondsStr)*?BILLION
+ end,
+ %% truncate to microseconds
+ Micro = TotalNano div 1000,
+ Mega = Micro div 1000000000000,
+ Secs = Micro div 1000000 - (Mega*1000000),
+ Micro2 = Micro rem 1000000,
+ calendar:now_to_datetime({Mega, Secs, Micro2}).
+
+%% Given a regular file reader, reads the whole file and
+%% parses all extended attributes it contains.
+parse_pax(#reg_file_reader{handle=Handle,num_bytes=0}) ->
+ {#{}, Handle};
+parse_pax(#reg_file_reader{handle=Handle0,num_bytes=NumBytes}) ->
+ case do_read(Handle0, NumBytes) of
+ {ok, Bytes, Handle1} ->
+ do_parse_pax(Handle1, Bytes, #{});
+ {error, _} = Err ->
+ throw(Err)
end.
-%% Verify the checksum in the header. First try an unsigned addition
-%% of all bytes in the header (as it should be according to Posix).
-
-verify_checksum(Bin) ->
- <<H1:?th_chksum/binary,CheckStr:?th_chksum_len/binary,H2/binary>> = Bin,
- case checksum(H1) + checksum(H2) of
- 0 -> eof;
- Checksum0 ->
- Csum = from_octal(CheckStr),
- CsumInit = ?th_chksum_len * $\s,
- case Checksum0 + CsumInit of
- Csum -> ok;
- Unsigned ->
- verify_checksum(H1, H2, CsumInit, Csum, Unsigned)
- end
+do_parse_pax(Reader, <<>>, Headers) ->
+ {Headers, Reader};
+do_parse_pax(Reader, Bin, Headers) ->
+ {Key, Value, Residual} = parse_pax_record(Bin),
+ NewHeaders = maps:put(Key, Value, Headers),
+ do_parse_pax(Reader, Residual, NewHeaders).
+
+%% Parse an extended attribute
+parse_pax_record(Bin) when is_binary(Bin) ->
+ case binary:split(Bin, [<<$\n>>]) of
+ [Record, Residual] ->
+ case binary:split(Record, [<<$\s>>], [trim_all]) of
+ [_Len, Record1] ->
+ case binary:split(Record1, [<<$=>>], [trim_all]) of
+ [AttrName, AttrValue] ->
+ {AttrName, AttrValue, Residual};
+ _Other ->
+ throw({error, malformed_pax_record})
+ end;
+ _Other ->
+ throw({error, malformed_pax_record})
+ end;
+ _Other ->
+ throw({error, malformed_pax_record})
end.
-%% The checksums didn't match. Now try a signed addition.
+get_real_name(#reg_file_reader{handle=Handle,num_bytes=0}) ->
+ {"", Handle};
+get_real_name(#reg_file_reader{handle=Handle0,num_bytes=NumBytes}) ->
+ case do_read(Handle0, NumBytes) of
+ {ok, RealName, Handle1} ->
+ {RealName, Handle1};
+ {error, _} = Err ->
+ throw(Err)
+ end;
+get_real_name(#sparse_file_reader{num_bytes=NumBytes}=Reader0) ->
+ case do_read(Reader0, NumBytes) of
+ {ok, RealName, Reader1} ->
+ {RealName, Reader1};
+ {error, _} = Err ->
+ throw(Err)
+ end.
-verify_checksum(H1, H2, Csum, ShouldBe, Unsigned) ->
- case signed_sum(binary_to_list(H1), signed_sum(binary_to_list(H2), Csum)) of
- ShouldBe -> ok;
- Signed ->
- throw({error,
- {bad_header,
- "Incorrect directory checksum ~w (~w), should be ~w",
- [Signed, Unsigned, ShouldBe]}})
+%% Skip the remaining bytes for the current file entry
+skip_file(#reg_file_reader{handle=Handle0,pos=Pos,size=Size}=Reader) ->
+ Padding = skip_padding(Size),
+ AbsPos = Handle0#reader.pos + (Size-Pos) + Padding,
+ case do_position(Handle0, AbsPos) of
+ {ok, _, Handle1} ->
+ Reader#reg_file_reader{handle=Handle1,num_bytes=0,pos=Size};
+ Err ->
+ throw(Err)
+ end;
+skip_file(#sparse_file_reader{pos=Pos,size=Size}=Reader) ->
+ case do_read(Reader, Size-Pos) of
+ {ok, _, Reader2} ->
+ Reader2;
+ Err ->
+ throw(Err)
end.
-signed_sum([C|Rest], Sum) when C < 128 ->
- signed_sum(Rest, Sum+C);
-signed_sum([C|Rest], Sum) ->
- signed_sum(Rest, Sum+C-256);
-signed_sum([], Sum) -> Sum.
-
-write_extracted_element(Header, Bin, Opts)
- when Opts#read_opts.output =:= memory ->
- case Header#tar_header.typeflag of
- regular ->
- {ok, {Header#tar_header.name, Bin}};
- _ ->
- ok
+skip_padding(0) ->
+ 0;
+skip_padding(Size) when (Size rem ?BLOCK_SIZE) =:= 0 ->
+ 0;
+skip_padding(Size) when Size =< ?BLOCK_SIZE ->
+ ?BLOCK_SIZE - Size;
+skip_padding(Size) ->
+ ?BLOCK_SIZE - (Size rem ?BLOCK_SIZE).
+
+skip_unread(#reader{pos=Pos}=Reader0) when (Pos rem ?BLOCK_SIZE) > 0 ->
+ Padding = skip_padding(Pos + ?BLOCK_SIZE),
+ AbsPos = Pos + Padding,
+ case do_position(Reader0, AbsPos) of
+ {ok, _, Reader1} ->
+ {ok, Reader1};
+ Err ->
+ throw(Err)
+ end;
+skip_unread(#reader{}=Reader) ->
+ {ok, Reader};
+skip_unread(#reg_file_reader{handle=Handle,num_bytes=0}) ->
+ skip_unread(Handle);
+skip_unread(#reg_file_reader{}=Reader) ->
+ #reg_file_reader{handle=Handle} = skip_file(Reader),
+ {ok, Handle};
+skip_unread(#sparse_file_reader{handle=Handle,num_bytes=0}) ->
+ skip_unread(Handle);
+skip_unread(#sparse_file_reader{}=Reader) ->
+ #sparse_file_reader{handle=Handle} = skip_file(Reader),
+ {ok, Handle}.
+
+write_extracted_element(#tar_header{name=Name,typeflag=Type},
+ Bin,
+ #read_opts{output=memory}=Opts) ->
+ case typeflag(Type) of
+ regular ->
+ read_verbose(Opts, "x ~ts~n", [Name]),
+ {ok, {Name, Bin}};
+ _ ->
+ ok
end;
-write_extracted_element(Header, Bin, Opts) ->
- Name = filename:absname(Header#tar_header.name, Opts#read_opts.cwd),
- Created =
- case Header#tar_header.typeflag of
- regular ->
- write_extracted_file(Name, Bin, Opts);
- directory ->
- create_extracted_dir(Name, Opts);
- symlink ->
- create_symlink(Name, Header, Opts);
- Other -> % Ignore.
- read_verbose(Opts, "x ~ts - unsupported type ~p~n",
- [Name, Other]),
- not_written
- end,
+write_extracted_element(#tar_header{name=Name0}=Header, Bin, Opts) ->
+ Name1 = filename:absname(Name0, Opts#read_opts.cwd),
+ Created =
+ case typeflag(Header#tar_header.typeflag) of
+ regular ->
+ create_regular(Name1, Name0, Bin, Opts);
+ directory ->
+ read_verbose(Opts, "x ~ts~n", [Name0]),
+ create_extracted_dir(Name1, Opts);
+ symlink ->
+ read_verbose(Opts, "x ~ts~n", [Name0]),
+ create_symlink(Name1, Header#tar_header.linkname, Opts);
+ Device when Device =:= char orelse Device =:= block ->
+ %% char/block devices will be created as empty files
+ %% and then have their major/minor device set later
+ create_regular(Name1, Name0, <<>>, Opts);
+ fifo ->
+ %% fifo devices will be created as empty files
+ create_regular(Name1, Name0, <<>>, Opts);
+ Other -> % Ignore.
+ read_verbose(Opts, "x ~ts - unsupported type ~p~n",
+ [Name0, Other]),
+ not_written
+ end,
case Created of
- ok -> set_extracted_file_info(Name, Header);
- not_written -> ok
+ ok -> set_extracted_file_info(Name1, Header);
+ not_written -> ok
+ end.
+
+create_regular(Name, NameInArchive, Bin, Opts) ->
+ case write_extracted_file(Name, Bin, Opts) of
+ not_written ->
+ read_verbose(Opts, "x ~ts - exists, not created~n", [NameInArchive]),
+ not_written;
+ Ok ->
+ read_verbose(Opts, "x ~ts~n", [NameInArchive]),
+ Ok
end.
create_extracted_dir(Name, _Opts) ->
case file:make_dir(Name) of
- ok -> ok;
- {error,enotsup} -> not_written;
- {error,eexist} -> not_written;
- {error,enoent} -> make_dirs(Name, dir);
- {error,Reason} -> throw({error, Reason})
+ ok -> ok;
+ {error,enotsup} -> not_written;
+ {error,eexist} -> not_written;
+ {error,enoent} -> make_dirs(Name, dir);
+ {error,Reason} -> throw({error, Reason})
end.
-create_symlink(Name, #tar_header{linkname=Linkname}=Header, Opts) ->
+create_symlink(Name, Linkname, Opts) ->
case file:make_symlink(Linkname, Name) of
- ok -> ok;
- {error,enoent} ->
- ok = make_dirs(Name, file),
- create_symlink(Name, Header, Opts);
- {error,eexist} -> not_written;
- {error,enotsup} ->
- read_verbose(Opts, "x ~ts - symbolic links not supported~n", [Name]),
- not_written;
- {error,Reason} -> throw({error, Reason})
+ ok -> ok;
+ {error,enoent} ->
+ ok = make_dirs(Name, file),
+ create_symlink(Name, Linkname, Opts);
+ {error,eexist} -> not_written;
+ {error,enotsup} ->
+ read_verbose(Opts, "x ~ts - symbolic links not supported~n", [Name]),
+ not_written;
+ {error,Reason} -> throw({error, Reason})
end.
write_extracted_file(Name, Bin, Opts) ->
Write =
- case Opts#read_opts.keep_old_files of
- true ->
- case file:read_file_info(Name) of
- {ok, _} -> false;
- _ -> true
- end;
- false -> true
- end,
+ case Opts#read_opts.keep_old_files of
+ true ->
+ case file:read_file_info(Name) of
+ {ok, _} -> false;
+ _ -> true
+ end;
+ false -> true
+ end,
case Write of
- true ->
- read_verbose(Opts, "x ~ts~n", [Name]),
- write_file(Name, Bin);
- false ->
- read_verbose(Opts, "x ~ts - exists, not created~n", [Name]),
- not_written
+ true -> write_file(Name, Bin);
+ false -> not_written
end.
write_file(Name, Bin) ->
case file:write_file(Name, Bin) of
- ok -> ok;
- {error,enoent} ->
- ok = make_dirs(Name, file),
- write_file(Name, Bin);
- {error,Reason} ->
- throw({error, Reason})
+ ok -> ok;
+ {error,enoent} ->
+ ok = make_dirs(Name, file),
+ write_file(Name, Bin);
+ {error,Reason} ->
+ throw({error, Reason})
end.
-set_extracted_file_info(_, #tar_header{typeflag = symlink}) -> ok;
-set_extracted_file_info(Name, #tar_header{mode=Mode, mtime=Mtime}) ->
- Info = #file_info{mode=Mode, mtime=posix_to_erlang_time(Mtime)},
+set_extracted_file_info(_, #tar_header{typeflag = ?TYPE_SYMLINK}) -> ok;
+set_extracted_file_info(_, #tar_header{typeflag = ?TYPE_LINK}) -> ok;
+set_extracted_file_info(Name, #tar_header{typeflag = ?TYPE_CHAR}=Header) ->
+ set_device_info(Name, Header);
+set_extracted_file_info(Name, #tar_header{typeflag = ?TYPE_BLOCK}=Header) ->
+ set_device_info(Name, Header);
+set_extracted_file_info(Name, #tar_header{mtime=Mtime,mode=Mode}) ->
+ Info = #file_info{mode=Mode, mtime=Mtime},
+ file:write_file_info(Name, Info).
+
+set_device_info(Name, #tar_header{}=Header) ->
+ Mtime = Header#tar_header.mtime,
+ Mode = Header#tar_header.mode,
+ Devmajor = Header#tar_header.devmajor,
+ Devminor = Header#tar_header.devminor,
+ Info = #file_info{
+ mode=Mode,
+ mtime=Mtime,
+ major_device=Devmajor,
+ minor_device=Devminor
+ },
file:write_file_info(Name, Info).
%% Makes all directories leading up to the file.
make_dirs(Name, file) ->
- filelib:ensure_dir(Name);
+ filelib:ensure_dir(Name);
make_dirs(Name, dir) ->
- filelib:ensure_dir(filename:join(Name,"*")).
+ filelib:ensure_dir(filename:join(Name,"*")).
%% Prints the message on if the verbose option is given (for reading).
-
read_verbose(#read_opts{verbose=true}, Format, Args) ->
- io:format(Format, Args),
- io:nl();
+ io:format(Format, Args);
read_verbose(_, _, _) ->
ok.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%%%
-%%% Utility functions.
-%%%
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%% Returns the checksum of a binary.
-
-checksum(Bin) -> checksum(Bin, 0).
-
-checksum(<<A,B,C,D,E,F,G,H,T/binary>>, Sum) ->
- checksum(T, Sum+A+B+C+D+E+F+G+H);
-checksum(<<A,T/binary>>, Sum) ->
- checksum(T, Sum+A);
-checksum(<<>>, Sum) -> Sum.
-
-%% Returns a list of zeroes to pad out to the given block size.
-
-padding(Size, BlockSize) ->
- zeroes(pad_size(Size, BlockSize)).
-
-pad_size(Size, BlockSize) ->
- case Size rem BlockSize of
- 0 -> 0;
- Rem -> BlockSize-Rem
- end.
-
-zeroes(0) -> [];
-zeroes(1) -> [0];
-zeroes(2) -> [0,0];
-zeroes(Number) ->
- Half = zeroes(Number div 2),
- case Number rem 2 of
- 0 -> [Half|Half];
- 1 -> [Half|[0|Half]]
- end.
-
-%% Skips the given number of bytes rounded up to an even record.
-
-skip(File, Size) ->
- %% Note: There is no point in handling failure to get the current position
- %% in the file. If it doesn't work, something serious is wrong.
- Amount = ((Size + ?record_size - 1) div ?record_size) * ?record_size,
- {ok,_} = do_position(File, {cur, Amount}),
- ok.
-
-%% Skips to the next record in the file.
-
-skip_to_next(File) ->
- %% Note: There is no point in handling failure to get the current position
- %% in the file. If it doesn't work, something serious is wrong.
- {ok, Position} = do_position(File, {cur, 0}),
- NewPosition = ((Position + ?record_size - 1) div ?record_size) * ?record_size,
- {ok,NewPosition} = do_position(File, NewPosition),
- ok.
-
%% Prints the message on if the verbose option is given.
-
add_verbose(#add_opts{verbose=true}, Format, Args) ->
io:format(Format, Args);
add_verbose(_, _, _) ->
ok.
-%% Converts a tuple containing the time to a Posix time (seconds
-%% since Jan 1, 1970).
+%%%%%%%%%%%%%%%%%%
+%% I/O primitives
+%%%%%%%%%%%%%%%%%%
+
+do_write(#reader{handle=Handle,func=Fun}=Reader0, Data)
+ when is_function(Fun,2) ->
+ case Fun(write,{Handle,Data}) of
+ ok ->
+ {ok, Pos, Reader1} = do_position(Reader0, {cur,0}),
+ {ok, Reader1#reader{pos=Pos}};
+ {error, _} = Err ->
+ Err
+ end.
-posix_time(Time) ->
- EpochStart = {{1970,1,1},{0,0,0}},
- {Days,{Hour,Min,Sec}} = calendar:time_difference(EpochStart, Time),
- 86400*Days + 3600*Hour + 60*Min + Sec.
+do_copy(#reader{func=Fun}=Reader, Source, #add_opts{chunk_size=0}=Opts)
+ when is_function(Fun, 2) ->
+ do_copy(Reader, Source, Opts#add_opts{chunk_size=65536});
+do_copy(#reader{func=Fun}=Reader, Source, #add_opts{chunk_size=ChunkSize})
+ when is_function(Fun, 2) ->
+ case file:open(Source, [read, binary]) of
+ {ok, SourceFd} ->
+ case copy_chunked(Reader, SourceFd, ChunkSize, 0) of
+ {ok, _Copied, _Reader2} = Ok->
+ _ = file:close(SourceFd),
+ Ok;
+ Err ->
+ _ = file:close(SourceFd),
+ throw(Err)
+ end;
+ Err ->
+ throw(Err)
+ end.
-posix_to_erlang_time(Sec) ->
- OneMillion = 1000000,
- Time = calendar:now_to_datetime({Sec div OneMillion, Sec rem OneMillion, 0}),
- erlang:universaltime_to_localtime(Time).
+copy_chunked(#reader{}=Reader, Source, ChunkSize, Copied) ->
+ case file:read(Source, ChunkSize) of
+ {ok, Bin} ->
+ {ok, Reader2} = do_write(Reader, Bin),
+ copy_chunked(Reader2, Source, ChunkSize, Copied+byte_size(Bin));
+ eof ->
+ {ok, Copied, Reader};
+ Other ->
+ Other
+ end.
-read_file_and_info(Name, Opts) ->
- ReadInfo = Opts#add_opts.read_info,
- case ReadInfo(Name) of
- {ok,Info} when Info#file_info.type =:= regular,
- Opts#add_opts.chunk_size>0 ->
- {ok,chunked,Info};
- {ok,Info} when Info#file_info.type =:= regular ->
- case file:read_file(Name) of
- {ok,Bin} ->
- {ok,Bin,Info};
- Error ->
- Error
- end;
- {ok,Info} when Info#file_info.type =:= symlink ->
- case file:read_link(Name) of
- {ok,PointsTo} ->
- {ok,PointsTo,Info};
- Error ->
- Error
- end;
- {ok, Info} ->
- {ok,[],Info};
- Error ->
- Error
+
+do_position(#reader{handle=Handle,func=Fun}=Reader, Pos)
+ when is_function(Fun,2)->
+ case Fun(position, {Handle,Pos}) of
+ {ok, NewPos} ->
+ %% since Pos may not always be an absolute seek,
+ %% make sure we update the reader with the new absolute position
+ {ok, AbsPos} = Fun(position, {Handle, {cur, 0}}),
+ {ok, NewPos, Reader#reader{pos=AbsPos}};
+ Other ->
+ Other
end.
-foreach_while_ok(Fun, [First|Rest]) ->
- case Fun(First) of
- ok -> foreach_while_ok(Fun, Rest);
- Other -> Other
+do_read(#reg_file_reader{handle=Handle,pos=Pos,size=Size}=Reader, Len) ->
+ NumBytes = Size - Pos,
+ ActualLen = if NumBytes - Len < 0 -> NumBytes; true -> Len end,
+ case do_read(Handle, ActualLen) of
+ {ok, Bin, Handle2} ->
+ NewPos = Pos + ActualLen,
+ NumBytes2 = Size - NewPos,
+ Reader1 = Reader#reg_file_reader{
+ handle=Handle2,
+ pos=NewPos,
+ num_bytes=NumBytes2},
+ {ok, Bin, Reader1};
+ Other ->
+ Other
end;
-foreach_while_ok(_, []) -> ok.
-
-open_mode(Mode) ->
- open_mode(Mode, false, [raw], []).
+do_read(#sparse_file_reader{}=Reader, Len) ->
+ do_sparse_read(Reader, Len);
+do_read(#reader{pos=Pos,handle=Handle,func=Fun}=Reader, Len)
+ when is_function(Fun,2)->
+ %% Always convert to binary internally
+ case Fun(read2,{Handle,Len}) of
+ {ok, List} when is_list(List) ->
+ Bin = list_to_binary(List),
+ NewPos = Pos+byte_size(Bin),
+ {ok, Bin, Reader#reader{pos=NewPos}};
+ {ok, Bin} when is_binary(Bin) ->
+ NewPos = Pos+byte_size(Bin),
+ {ok, Bin, Reader#reader{pos=NewPos}};
+ Other ->
+ Other
+ end.
-open_mode(read, _, Raw, _) ->
- {ok, read, Raw, []};
-open_mode(write, _, Raw, _) ->
- {ok, write, Raw, []};
-open_mode([read|Rest], false, Raw, Opts) ->
- open_mode(Rest, read, Raw, Opts);
-open_mode([write|Rest], false, Raw, Opts) ->
- open_mode(Rest, write, Raw, Opts);
-open_mode([compressed|Rest], Access, Raw, Opts) ->
- open_mode(Rest, Access, Raw, [compressed|Opts]);
-open_mode([cooked|Rest], Access, _Raw, Opts) ->
- open_mode(Rest, Access, [], Opts);
-open_mode([], Access, Raw, Opts) ->
- {ok, Access, Raw, Opts};
-open_mode(_, _, _, _) ->
- {error, einval}.
-%%%================================================================
-do_write({tar_descriptor,UsrHandle,Fun}, Data) -> Fun(write,{UsrHandle,Data}).
+do_sparse_read(Reader, Len) ->
+ do_sparse_read(Reader, Len, <<>>).
+
+do_sparse_read(#sparse_file_reader{sparse_map=[#sparse_entry{num_bytes=0}|Entries]
+ }=Reader0, Len, Acc) ->
+ %% skip all empty fragments
+ Reader1 = Reader0#sparse_file_reader{sparse_map=Entries},
+ do_sparse_read(Reader1, Len, Acc);
+do_sparse_read(#sparse_file_reader{sparse_map=[],
+ pos=Pos,size=Size}=Reader0, Len, Acc)
+ when Pos < Size ->
+ %% if there are no more fragments, it is possible that there is one last sparse hole
+ %% this behaviour matches the BSD tar utility
+ %% however, GNU tar stops returning data even if we haven't reached the end
+ {ok, Bin, Reader1} = read_sparse_hole(Reader0, Size, Len),
+ do_sparse_read(Reader1, Len-byte_size(Bin), <<Acc/binary,Bin/binary>>);
+do_sparse_read(#sparse_file_reader{sparse_map=[]}=Reader, _Len, Acc) ->
+ {ok, Acc, Reader};
+do_sparse_read(#sparse_file_reader{}=Reader, 0, Acc) ->
+ {ok, Acc, Reader};
+do_sparse_read(#sparse_file_reader{sparse_map=[#sparse_entry{offset=Offset}|_],
+ pos=Pos}=Reader0, Len, Acc)
+ when Pos < Offset ->
+ {ok, Bin, Reader1} = read_sparse_hole(Reader0, Offset, Offset-Pos),
+ do_sparse_read(Reader1, Len-byte_size(Bin), <<Acc/binary,Bin/binary>>);
+do_sparse_read(#sparse_file_reader{sparse_map=[Entry|Entries],
+ pos=Pos}=Reader0, Len, Acc) ->
+ %% we're in a data fragment, so read from it
+ %% end offset of fragment
+ EndPos = Entry#sparse_entry.offset + Entry#sparse_entry.num_bytes,
+ %% bytes left in fragment
+ NumBytes = EndPos - Pos,
+ ActualLen = if Len > NumBytes -> NumBytes; true -> Len end,
+ case do_read(Reader0#sparse_file_reader.handle, ActualLen) of
+ {ok, Bin, Handle} ->
+ BytesRead = byte_size(Bin),
+ ActualEndPos = Pos+BytesRead,
+ Reader1 = if ActualEndPos =:= EndPos ->
+ Reader0#sparse_file_reader{sparse_map=Entries};
+ true ->
+ Reader0
+ end,
+ Size = Reader1#sparse_file_reader.size,
+ NumBytes2 = Size - ActualEndPos,
+ Reader2 = Reader1#sparse_file_reader{
+ handle=Handle,
+ pos=ActualEndPos,
+ num_bytes=NumBytes2},
+ do_sparse_read(Reader2, Len-byte_size(Bin), <<Acc/binary,Bin/binary>>);
+ Other ->
+ Other
+ end.
+
+%% Reads a sparse hole ending at Offset
+read_sparse_hole(#sparse_file_reader{pos=Pos}=Reader, Offset, Len) ->
+ N = Offset - Pos,
+ N2 = if N > Len ->
+ Len;
+ true ->
+ N
+ end,
+ Bin = <<0:N2/unit:8>>,
+ NumBytes = Reader#sparse_file_reader.size - (Pos+N2),
+ {ok, Bin, Reader#sparse_file_reader{
+ num_bytes=NumBytes,
+ pos=Pos+N2}}.
+
+-spec do_close(reader()) -> ok | {error, term()}.
+do_close(#reader{handle=Handle,func=Fun}) when is_function(Fun,2) ->
+ Fun(close,Handle).
+
+%%%%%%%%%%%%%%%%%%
+%% Option parsing
+%%%%%%%%%%%%%%%%%%
-do_position({tar_descriptor,UsrHandle,Fun}, Pos) -> Fun(position,{UsrHandle,Pos}).
+extract_opts(List) ->
+ extract_opts(List, default_options()).
-do_read({tar_descriptor,UsrHandle,Fun}, Len) -> Fun(read2,{UsrHandle,Len}).
+table_opts(List) ->
+ read_opts(List, default_options()).
+
+default_options() ->
+ {ok, Cwd} = file:get_cwd(),
+ #read_opts{cwd=Cwd}.
-do_close({tar_descriptor,UsrHandle,Fun}) -> Fun(close,UsrHandle).
+extract_opts([keep_old_files|Rest], Opts) ->
+ extract_opts(Rest, Opts#read_opts{keep_old_files=true});
+extract_opts([{cwd, Cwd}|Rest], Opts) ->
+ extract_opts(Rest, Opts#read_opts{cwd=Cwd});
+extract_opts([{files, Files}|Rest], Opts) ->
+ Set = ordsets:from_list(Files),
+ extract_opts(Rest, Opts#read_opts{files=Set});
+extract_opts([memory|Rest], Opts) ->
+ extract_opts(Rest, Opts#read_opts{output=memory});
+extract_opts([compressed|Rest], Opts=#read_opts{open_mode=OpenMode}) ->
+ extract_opts(Rest, Opts#read_opts{open_mode=[compressed|OpenMode]});
+extract_opts([cooked|Rest], Opts=#read_opts{open_mode=OpenMode}) ->
+ extract_opts(Rest, Opts#read_opts{open_mode=[cooked|OpenMode]});
+extract_opts([verbose|Rest], Opts) ->
+ extract_opts(Rest, Opts#read_opts{verbose=true});
+extract_opts([Other|Rest], Opts) ->
+ extract_opts(Rest, read_opts([Other], Opts));
+extract_opts([], Opts) ->
+ Opts.
+
+read_opts([compressed|Rest], Opts=#read_opts{open_mode=OpenMode}) ->
+ read_opts(Rest, Opts#read_opts{open_mode=[compressed|OpenMode]});
+read_opts([cooked|Rest], Opts=#read_opts{open_mode=OpenMode}) ->
+ read_opts(Rest, Opts#read_opts{open_mode=[cooked|OpenMode]});
+read_opts([verbose|Rest], Opts) ->
+ read_opts(Rest, Opts#read_opts{verbose=true});
+read_opts([_|Rest], Opts) ->
+ read_opts(Rest, Opts);
+read_opts([], Opts) ->
+ Opts.
diff --git a/lib/stdlib/src/erl_tar.hrl b/lib/stdlib/src/erl_tar.hrl
new file mode 100644
index 0000000000..d646d02989
--- /dev/null
+++ b/lib/stdlib/src/erl_tar.hrl
@@ -0,0 +1,394 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2017. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+
+%% Options used when adding files to a tar archive.
+-record(add_opts, {
+ read_info, %% Fun to use for read file/link info.
+ chunk_size = 0, %% For file reading when sending to sftp. 0=do not chunk
+ verbose = false}). %% Verbose on/off.
+-type add_opts() :: #add_opts{}.
+
+%% Options used when reading a tar archive.
+-record(read_opts, {
+ cwd :: string(), %% Current working directory.
+ keep_old_files = false :: boolean(), %% Owerwrite or not.
+ files = all, %% Set of files to extract (or all)
+ output = file :: 'file' | 'memory',
+ open_mode = [], %% Open mode options.
+ verbose = false :: boolean()}). %% Verbose on/off.
+-type read_opts() :: #read_opts{}.
+
+-type add_opt() :: dereference |
+ verbose |
+ {chunks, pos_integer()}.
+
+-type extract_opt() :: {cwd, string()} |
+ {files, [string()]} |
+ compressed |
+ cooked |
+ memory |
+ keep_old_files |
+ verbose.
+
+-type create_opt() :: compressed |
+ cooked |
+ dereference |
+ verbose.
+
+-type filelist() :: [file:filename() |
+ {string(), binary()} |
+ {string(), file:filename()}].
+
+%% The tar header, once fully parsed.
+-record(tar_header, {
+ name = "" :: string(), %% name of header file entry
+ mode = 8#100644 :: non_neg_integer(), %% permission and mode bits
+ uid = 0 :: non_neg_integer(), %% user id of owner
+ gid = 0 :: non_neg_integer(), %% group id of owner
+ size = 0 :: non_neg_integer(), %% length in bytes
+ mtime :: calendar:datetime(), %% modified time
+ typeflag :: char(), %% type of header entry
+ linkname = "" :: string(), %% target name of link
+ uname = "" :: string(), %% user name of owner
+ gname = "" :: string(), %% group name of owner
+ devmajor = 0 :: non_neg_integer(), %% major number of character or block device
+ devminor = 0 :: non_neg_integer(), %% minor number of character or block device
+ atime :: calendar:datetime(), %% access time
+ ctime :: calendar:datetime() %% status change time
+ }).
+-type tar_header() :: #tar_header{}.
+
+%% Metadata for a sparse file fragment
+-record(sparse_entry, {
+ offset = 0 :: non_neg_integer(),
+ num_bytes = 0 :: non_neg_integer()}).
+-type sparse_entry() :: #sparse_entry{}.
+%% Contains metadata about fragments of a sparse file
+-record(sparse_array, {
+ entries = [] :: [sparse_entry()],
+ is_extended = false :: boolean(),
+ max_entries = 0 :: non_neg_integer()}).
+-type sparse_array() :: #sparse_array{}.
+%% A subset of tar header fields common to all tar implementations
+-record(header_v7, {
+ name :: binary(),
+ mode :: binary(), %% octal
+ uid :: binary(), %% integer
+ gid :: binary(), %% integer
+ size :: binary(), %% integer
+ mtime :: binary(), %% integer
+ checksum :: binary(), %% integer
+ typeflag :: byte(), %% char
+ linkname :: binary()}).
+-type header_v7() :: #header_v7{}.
+%% The set of fields specific to GNU tar formatted archives
+-record(header_gnu, {
+ header_v7 :: header_v7(),
+ magic :: binary(),
+ version :: binary(),
+ uname :: binary(),
+ gname :: binary(),
+ devmajor :: binary(), %% integer
+ devminor :: binary(), %% integer
+ atime :: binary(), %% integer
+ ctime :: binary(), %% integer
+ sparse :: sparse_array(),
+ real_size :: binary()}). %% integer
+-type header_gnu() :: #header_gnu{}.
+%% The set of fields specific to STAR-formatted archives
+-record(header_star, {
+ header_v7 :: header_v7(),
+ magic :: binary(),
+ version :: binary(),
+ uname :: binary(),
+ gname :: binary(),
+ devmajor :: binary(), %% integer
+ devminor :: binary(), %% integer
+ prefix :: binary(),
+ atime :: binary(), %% integer
+ ctime :: binary(), %% integer
+ trailer :: binary()}).
+-type header_star() :: #header_star{}.
+%% The set of fields specific to USTAR-formatted archives
+-record(header_ustar, {
+ header_v7 :: header_v7(),
+ magic :: binary(),
+ version :: binary(),
+ uname :: binary(),
+ gname :: binary(),
+ devmajor :: binary(), %% integer
+ devminor :: binary(), %% integer
+ prefix :: binary()}).
+-type header_ustar() :: #header_ustar{}.
+
+-type header_fields() :: header_v7() |
+ header_gnu() |
+ header_star() |
+ header_ustar().
+
+%% The overall tar reader, it holds the low-level file handle,
+%% its access, position, and the I/O primitives wrapper.
+-record(reader, {
+ handle :: file:io_device() | term(),
+ access :: read | write | ram,
+ pos = 0 :: non_neg_integer(),
+ func :: file_op()
+ }).
+-type reader() :: #reader{}.
+%% A reader for a regular file within the tar archive,
+%% It tracks its current state relative to that file.
+-record(reg_file_reader, {
+ handle :: reader(),
+ num_bytes = 0,
+ pos = 0,
+ size = 0
+ }).
+-type reg_file_reader() :: #reg_file_reader{}.
+%% A reader for a sparse file within the tar archive,
+%% It tracks its current state relative to that file.
+-record(sparse_file_reader, {
+ handle :: reader(),
+ num_bytes = 0, %% bytes remaining
+ pos = 0, %% pos
+ size = 0, %% total size of file
+ sparse_map = #sparse_array{}
+ }).
+-type sparse_file_reader() :: #sparse_file_reader{}.
+
+%% Types for the readers
+-type reader_type() :: reader() | reg_file_reader() | sparse_file_reader().
+-type handle() :: file:io_device() | term().
+
+%% Type for the I/O primitive wrapper function
+-type file_op() :: fun((write | close | read2 | position,
+ {handle(), iodata()} | handle() | {handle(), non_neg_integer()}
+ | {handle(), non_neg_integer()}) ->
+ ok | eof | {ok, string() | binary()} | {ok, non_neg_integer()}
+ | {error, term()}).
+
+%% These constants (except S_IFMT) are
+%% used to determine what type of device
+%% a file is. Namely, `S_IFMT band file_info.mode`
+%% will equal one of these contants, and tells us
+%% which type it is. The stdlib file_info record
+%% does not differentiate between device types, and
+%% will not allow us to differentiate between sockets
+%% and named pipes. These constants are pulled from libc.
+-define(S_IFMT, 61440).
+-define(S_IFSOCK, 49152). %% socket
+-define(S_FIFO, 4096). %% fifo/named pipe
+-define(S_IFBLK, 24576). %% block device
+-define(S_IFCHR, 8192). %% character device
+
+%% Typeflag constants for the tar header
+-define(TYPE_REGULAR, $0). %% regular file
+-define(TYPE_REGULAR_A, 0). %% regular file
+-define(TYPE_LINK, $1). %% hard link
+-define(TYPE_SYMLINK, $2). %% symbolic link
+-define(TYPE_CHAR, $3). %% character device node
+-define(TYPE_BLOCK, $4). %% block device node
+-define(TYPE_DIR, $5). %% directory
+-define(TYPE_FIFO, $6). %% fifo node
+-define(TYPE_CONT, $7). %% reserved
+-define(TYPE_X_HEADER, $x). %% extended header
+-define(TYPE_X_GLOBAL_HEADER, $g). %% global extended header
+-define(TYPE_GNU_LONGNAME, $L). %% next file has a long name
+-define(TYPE_GNU_LONGLINK, $K). %% next file symlinks to a file with a long name
+-define(TYPE_GNU_SPARSE, $S). %% sparse file
+
+%% Mode constants from tar spec
+-define(MODE_ISUID, 4000). %% set uid
+-define(MODE_ISGID, 2000). %% set gid
+-define(MODE_ISVTX, 1000). %% save text (sticky bit)
+-define(MODE_ISDIR, 40000). %% directory
+-define(MODE_ISFIFO, 10000). %% fifo
+-define(MODE_ISREG, 100000). %% regular file
+-define(MODE_ISLNK, 120000). %% symbolic link
+-define(MODE_ISBLK, 60000). %% block special file
+-define(MODE_ISCHR, 20000). %% character special file
+-define(MODE_ISSOCK, 140000). %% socket
+
+%% Keywords for PAX extended header
+-define(PAX_ATIME, <<"atime">>).
+-define(PAX_CHARSET, <<"charset">>).
+-define(PAX_COMMENT, <<"comment">>).
+-define(PAX_CTIME, <<"ctime">>). %% ctime is not a valid pax header
+-define(PAX_GID, <<"gid">>).
+-define(PAX_GNAME, <<"gname">>).
+-define(PAX_LINKPATH, <<"linkpath">>).
+-define(PAX_MTIME, <<"mtime">>).
+-define(PAX_PATH, <<"path">>).
+-define(PAX_SIZE, <<"size">>).
+-define(PAX_UID, <<"uid">>).
+-define(PAX_UNAME, <<"uname">>).
+-define(PAX_XATTR, <<"SCHILY.xattr.">>).
+-define(PAX_XATTR_STR, "SCHILY.xattr.").
+-define(PAX_NONE, <<"">>).
+
+%% Tar format constants
+%% Unknown format
+-define(FORMAT_UNKNOWN, 0).
+%% The format of the original Unix V7 tar tool prior to standardization
+-define(FORMAT_V7, 1).
+%% The old and new GNU formats, incompatible with USTAR.
+%% This covers the old GNU sparse extension, but it does
+%% not cover the GNU sparse extensions using PAX headers,
+%% versions 0.0, 0.1, and 1.0; these fall under the PAX format.
+-define(FORMAT_GNU, 2).
+%% Schily's tar format, which is incompatible with USTAR.
+%% This does not cover STAR extensions to the PAX format; these
+%% fall under the PAX format.
+-define(FORMAT_STAR, 3).
+%% USTAR is the former standardization of tar defined in POSIX.1-1988,
+%% it is incompatible with the GNU and STAR formats.
+-define(FORMAT_USTAR, 4).
+%% PAX is the latest standardization of tar defined in POSIX.1-2001.
+%% This is an extension of USTAR and is "backwards compatible" with it.
+%%
+%% Some newer formats add their own extensions to PAX, such as GNU sparse
+%% files and SCHILY extended attributes. Since they are backwards compatible
+%% with PAX, they will be labelled as "PAX".
+-define(FORMAT_PAX, 5).
+
+%% Magic constants
+-define(MAGIC_GNU, <<"ustar ">>).
+-define(VERSION_GNU, <<" \x00">>).
+-define(MAGIC_USTAR, <<"ustar\x00">>).
+-define(VERSION_USTAR, <<"00">>).
+-define(TRAILER_STAR, <<"tar\x00">>).
+
+%% Size constants
+-define(BLOCK_SIZE, 512). %% size of each block in a tar stream
+-define(NAME_SIZE, 100). %% max length of the name field in USTAR format
+-define(PREFIX_SIZE, 155). %% max length of the prefix field in USTAR format
+
+%% Maximum size of a nanosecond value as an integer
+-define(MAX_NANO_INT_SIZE, 9).
+%% Maximum size of a 64-bit signed integer
+-define(MAX_INT64, (1 bsl 63 - 1)).
+
+-define(PAX_GNU_SPARSE_NUMBLOCKS, <<"GNU.sparse.numblocks">>).
+-define(PAX_GNU_SPARSE_OFFSET, <<"GNU.sparse.offset">>).
+-define(PAX_GNU_SPARSE_NUMBYTES, <<"GNU.sparse.numbytes">>).
+-define(PAX_GNU_SPARSE_MAP, <<"GNU.sparse.map">>).
+-define(PAX_GNU_SPARSE_NAME, <<"GNU.sparse.name">>).
+-define(PAX_GNU_SPARSE_MAJOR, <<"GNU.sparse.major">>).
+-define(PAX_GNU_SPARSE_MINOR, <<"GNU.sparse.minor">>).
+-define(PAX_GNU_SPARSE_SIZE, <<"GNU.sparse.size">>).
+-define(PAX_GNU_SPARSE_REALSIZE, <<"GNU.sparse.realsize">>).
+
+-define(V7_NAME, 0).
+-define(V7_NAME_LEN, 100).
+-define(V7_MODE, 100).
+-define(V7_MODE_LEN, 8).
+-define(V7_UID, 108).
+-define(V7_UID_LEN, 8).
+-define(V7_GID, 116).
+-define(V7_GID_LEN, 8).
+-define(V7_SIZE, 124).
+-define(V7_SIZE_LEN, 12).
+-define(V7_MTIME, 136).
+-define(V7_MTIME_LEN, 12).
+-define(V7_CHKSUM, 148).
+-define(V7_CHKSUM_LEN, 8).
+-define(V7_TYPE, 156).
+-define(V7_TYPE_LEN, 1).
+-define(V7_LINKNAME, 157).
+-define(V7_LINKNAME_LEN, 100).
+
+-define(STAR_TRAILER, 508).
+-define(STAR_TRAILER_LEN, 4).
+
+-define(USTAR_MAGIC, 257).
+-define(USTAR_MAGIC_LEN, 6).
+-define(USTAR_VERSION, 263).
+-define(USTAR_VERSION_LEN, 2).
+-define(USTAR_UNAME, 265).
+-define(USTAR_UNAME_LEN, 32).
+-define(USTAR_GNAME, 297).
+-define(USTAR_GNAME_LEN, 32).
+-define(USTAR_DEVMAJ, 329).
+-define(USTAR_DEVMAJ_LEN, 8).
+-define(USTAR_DEVMIN, 337).
+-define(USTAR_DEVMIN_LEN, 8).
+-define(USTAR_PREFIX, 345).
+-define(USTAR_PREFIX_LEN, 155).
+
+-define(GNU_MAGIC, 257).
+-define(GNU_MAGIC_LEN, 6).
+-define(GNU_VERSION, 263).
+-define(GNU_VERSION_LEN, 2).
+
+%% ?BLOCK_SIZE of zero-bytes.
+%% Two of these in a row mark the end of an archive.
+-define(ZERO_BLOCK, <<0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,
+ 0,0,0,0,0,0,0,0,0,0,0,0>>).
+
+-define(BILLION, 1000000000).
+
+-define(EPOCH, {{1970,1,1}, {0,0,0}}).
diff --git a/lib/stdlib/src/error_logger_file_h.erl b/lib/stdlib/src/error_logger_file_h.erl
index 665685d3ee..0b262de3ab 100644
--- a/lib/stdlib/src/error_logger_file_h.erl
+++ b/lib/stdlib/src/error_logger_file_h.erl
@@ -116,8 +116,8 @@ write_event(#st{fd=Fd}=State, Event) ->
ignore ->
ok;
{Head,Pid,FormatList} ->
- Time = maybe_utc(erlang:universaltime()),
- Header = write_time(Time, Head),
+ Time = erlang:universaltime(),
+ Header = header(Time, Head),
Body = format_body(State, FormatList),
AtNode = if
node(Pid) =/= node() ->
@@ -125,7 +125,7 @@ write_event(#st{fd=Fd}=State, Event) ->
true ->
[]
end,
- io:put_chars(Fd, [Header,Body,AtNode])
+ io:put_chars(Fd, [Header,AtNode,Body])
end.
format_body(State, [{Format,Args}|T]) ->
@@ -172,21 +172,6 @@ parse_event({warning_report, _GL, {Pid, std_warning, Args}}) ->
{"WARNING REPORT",Pid,format_term(Args)};
parse_event(_) -> ignore.
-maybe_utc(Time) ->
- UTC = case application:get_env(sasl, utc_log) of
- {ok, Val} -> Val;
- undefined ->
- %% Backwards compatible:
- case application:get_env(stdlib, utc_log) of
- {ok, Val} -> Val;
- undefined -> false
- end
- end,
- maybe_utc(Time, UTC).
-
-maybe_utc(Time, true) -> {utc, Time};
-maybe_utc(Time, _) -> {local, calendar:universal_time_to_local_time(Time)}.
-
format_term(Term) when is_list(Term) ->
case string_p(Term) of
true ->
@@ -227,17 +212,33 @@ string_p1([H|T]) when is_list(H) ->
string_p1([]) -> true;
string_p1(_) -> false.
-write_time({utc,{{Y,Mo,D},{H,Mi,S}}}, Type) ->
- io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s UTC ===~n",
- [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]);
-write_time({local, {{Y,Mo,D},{H,Mi,S}}}, Type) ->
- io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s ===~n",
- [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]).
+get_utc_config() ->
+ %% SASL utc_log configuration overrides stdlib config
+ %% in order to have uniform timestamps in log messages
+ case application:get_env(sasl, utc_log) of
+ {ok, Val} -> Val;
+ undefined ->
+ case application:get_env(stdlib, utc_log) of
+ {ok, Val} -> Val;
+ undefined -> false
+ end
+ end.
+
+header(Time, Title) ->
+ case get_utc_config() of
+ true ->
+ header(Time, Title, "UTC ");
+ _ ->
+ header(calendar:universal_time_to_local_time(Time), Title, "")
+ end.
+
+header({{Y,Mo,D},{H,Mi,S}}, Title, UTC) ->
+ io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s ~s===~n",
+ [Title,D,month(Mo),Y,t(H),t(Mi),t(S),UTC]).
t(X) when is_integer(X) ->
- t1(integer_to_list(X));
-t(_) ->
- "".
+ t1(integer_to_list(X)).
+
t1([X]) -> [$0,X];
t1(X) -> X.
@@ -253,5 +254,3 @@ month(9) -> "Sep";
month(10) -> "Oct";
month(11) -> "Nov";
month(12) -> "Dec".
-
-
diff --git a/lib/stdlib/src/error_logger_tty_h.erl b/lib/stdlib/src/error_logger_tty_h.erl
index cb22a8c0b6..2f2fd65252 100644
--- a/lib/stdlib/src/error_logger_tty_h.erl
+++ b/lib/stdlib/src/error_logger_tty_h.erl
@@ -128,13 +128,12 @@ write_events(State, [Ev|Es]) ->
write_events(_State, []) ->
ok.
-do_write_event(State, {Time0, Event}) ->
+do_write_event(State, {Time, Event}) ->
case parse_event(Event) of
ignore ->
ok;
- {Head,Pid,FormatList} ->
- Time = maybe_utc(Time0),
- Header = write_time(Time, Head),
+ {Title,Pid,FormatList} ->
+ Header = header(Time, Title),
Body = format_body(State, FormatList),
AtNode = if
node(Pid) =/= node() ->
@@ -142,7 +141,7 @@ do_write_event(State, {Time0, Event}) ->
true ->
[]
end,
- Str = [Header,Body,AtNode],
+ Str = [Header,AtNode,Body],
case State#st.io_mod of
io_lib ->
Str;
@@ -197,21 +196,6 @@ parse_event({warning_report, _GL, {Pid, std_warning, Args}}) ->
{"WARNING REPORT",Pid,format_term(Args)};
parse_event(_) -> ignore.
-maybe_utc(Time) ->
- UTC = case application:get_env(sasl, utc_log) of
- {ok, Val} -> Val;
- undefined ->
- %% Backwards compatible:
- case application:get_env(stdlib, utc_log) of
- {ok, Val} -> Val;
- undefined -> false
- end
- end,
- maybe_utc(Time, UTC).
-
-maybe_utc(Time, true) -> {utc, Time};
-maybe_utc(Time, _) -> {local, calendar:universal_time_to_local_time(Time)}.
-
format_term(Term) when is_list(Term) ->
case string_p(Term) of
true ->
@@ -255,12 +239,29 @@ string_p1([H|T]) when is_list(H) ->
string_p1([]) -> true;
string_p1(_) -> false.
-write_time({utc,{{Y,Mo,D},{H,Mi,S}}},Type) ->
- io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s UTC ===~n",
- [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]);
-write_time({local, {{Y,Mo,D},{H,Mi,S}}},Type) ->
- io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s ===~n",
- [Type,D,month(Mo),Y,t(H),t(Mi),t(S)]).
+get_utc_config() ->
+ %% SASL utc_log configuration overrides stdlib config
+ %% in order to have uniform timestamps in log messages
+ case application:get_env(sasl, utc_log) of
+ {ok, Val} -> Val;
+ undefined ->
+ case application:get_env(stdlib, utc_log) of
+ {ok, Val} -> Val;
+ undefined -> false
+ end
+ end.
+
+header(Time, Title) ->
+ case get_utc_config() of
+ true ->
+ header(Time, Title, "UTC ");
+ _ ->
+ header(calendar:universal_time_to_local_time(Time), Title, "")
+ end.
+
+header({{Y,Mo,D},{H,Mi,S}}, Title, UTC) ->
+ io_lib:format("~n=~s==== ~p-~s-~p::~s:~s:~s ~s===~n",
+ [Title,D,month(Mo),Y,t(H),t(Mi),t(S),UTC]).
t(X) when is_integer(X) ->
t1(integer_to_list(X));
@@ -281,8 +282,3 @@ month(9) -> "Sep";
month(10) -> "Oct";
month(11) -> "Nov";
month(12) -> "Dec".
-
-
-
-
-
diff --git a/lib/stdlib/src/escript.erl b/lib/stdlib/src/escript.erl
index c42ae981e7..6e8f780f7c 100644
--- a/lib/stdlib/src/escript.erl
+++ b/lib/stdlib/src/escript.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2007-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -629,8 +629,7 @@ parse_source(S, File, Fd, StartLine, HeaderSz, CheckOnly) ->
{error, _} ->
epp_parse_file2(Epp, S2, [FileForm], OptModRes);
{eof, LastLine} ->
- Anno = anno(LastLine),
- S#state{forms_or_bin = [FileForm, {eof, Anno}]}
+ S#state{forms_or_bin = [FileForm, {eof, LastLine}]}
end,
ok = epp:close(Epp),
ok = file:close(Fd),
@@ -728,8 +727,7 @@ epp_parse_file2(Epp, S, Forms, Parsed) ->
[S#state.file,Ln,Mod:format_error(Args)]),
epp_parse_file(Epp, S#state{n_errors = S#state.n_errors + 1}, [Form | Forms]);
{eof, LastLine} ->
- Anno = anno(LastLine),
- S#state{forms_or_bin = lists:reverse([{eof, Anno} | Forms])}
+ S#state{forms_or_bin = lists:reverse([{eof, LastLine} | Forms])}
end.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
diff --git a/lib/stdlib/src/ets.erl b/lib/stdlib/src/ets.erl
index 20de06fd0b..195a407570 100644
--- a/lib/stdlib/src/ets.erl
+++ b/lib/stdlib/src/ets.erl
@@ -51,8 +51,8 @@
-type tab() :: atom() | tid().
-type type() :: set | ordered_set | bag | duplicate_bag.
-type continuation() :: '$end_of_table'
- | {tab(),integer(),integer(),binary(),list(),integer()}
- | {tab(),_,_,integer(),binary(),list(),integer(),integer()}.
+ | {tab(),integer(),integer(),comp_match_spec(),list(),integer()}
+ | {tab(),_,_,integer(),comp_match_spec(),list(),integer(),integer()}.
-opaque tid() :: integer().
@@ -70,15 +70,33 @@
match_object/2, match_object/3, match_spec_compile/1,
match_spec_run_r/3, member/2, new/2, next/2, prev/2,
rename/2, safe_fixtable/2, select/1, select/2, select/3,
- select_count/2, select_delete/2, select_reverse/1,
+ select_count/2, select_delete/2, select_replace/2, select_reverse/1,
select_reverse/2, select_reverse/3, setopts/2, slot/2,
take/2,
update_counter/3, update_counter/4, update_element/3]).
+%% internal exports
+-export([internal_request_all/0]).
+
-spec all() -> [Tab] when
Tab :: tab().
all() ->
+ receive_all(ets:internal_request_all(),
+ erlang:system_info(schedulers),
+ []).
+
+receive_all(_Ref, 0, All) ->
+ All;
+receive_all(Ref, N, All) ->
+ receive
+ {Ref, SchedAll} ->
+ receive_all(Ref, N-1, SchedAll ++ All)
+ end.
+
+-spec internal_request_all() -> reference().
+
+internal_request_all() ->
erlang:nif_error(undef).
-spec delete(Tab) -> true when
@@ -361,6 +379,14 @@ select_count(_, _) ->
select_delete(_, _) ->
erlang:nif_error(undef).
+-spec select_replace(Tab, MatchSpec) -> NumReplaced when
+ Tab :: tab(),
+ MatchSpec :: match_spec(),
+ NumReplaced :: non_neg_integer().
+
+select_replace(_, _) ->
+ erlang:nif_error(undef).
+
-spec select_reverse(Tab, MatchSpec) -> [Match] when
Tab :: tab(),
MatchSpec :: match_spec(),
@@ -488,7 +514,7 @@ update_element(_, _, _) ->
%%% End of BIFs
--opaque comp_match_spec() :: binary(). %% this one is REALLY opaque
+-opaque comp_match_spec() :: reference().
-spec match_spec_run(List, CompiledMatchSpec) -> list() when
List :: [tuple()],
@@ -505,28 +531,28 @@ match_spec_run(List, CompiledMS) ->
repair_continuation('$end_of_table', _) ->
'$end_of_table';
%% ordered_set
-repair_continuation(Untouched = {Table,Lastkey,EndCondition,N2,Bin,L2,N3,N4}, MS)
+repair_continuation(Untouched = {Table,Lastkey,EndCondition,N2,MSRef,L2,N3,N4}, MS)
when %% (is_atom(Table) or is_integer(Table)),
is_integer(N2),
- byte_size(Bin) =:= 0,
+ %% is_reference(MSRef),
is_list(L2),
is_integer(N3),
is_integer(N4) ->
- case ets:is_compiled_ms(Bin) of
+ case ets:is_compiled_ms(MSRef) of
true ->
Untouched;
false ->
{Table,Lastkey,EndCondition,N2,ets:match_spec_compile(MS),L2,N3,N4}
end;
%% set/bag/duplicate_bag
-repair_continuation(Untouched = {Table,N1,N2,Bin,L,N3}, MS)
+repair_continuation(Untouched = {Table,N1,N2,MSRef,L,N3}, MS)
when %% (is_atom(Table) or is_integer(Table)),
is_integer(N1),
is_integer(N2),
- byte_size(Bin) =:= 0,
+ %% is_reference(MSRef),
is_list(L),
is_integer(N3) ->
- case ets:is_compiled_ms(Bin) of
+ case ets:is_compiled_ms(MSRef) of
true ->
Untouched;
false ->
diff --git a/lib/stdlib/src/eval_bits.erl b/lib/stdlib/src/eval_bits.erl
index 80667023fb..631faa3be5 100644
--- a/lib/stdlib/src/eval_bits.erl
+++ b/lib/stdlib/src/eval_bits.erl
@@ -67,16 +67,20 @@ expr_grp([Field | FS], Bs0, Lf, Acc) ->
expr_grp([], Bs0, _Lf, Acc) ->
{value,Acc,Bs0}.
+eval_field({bin_element, _, {string, _, S}, {integer,_,8}, [integer,{unit,1},unsigned,big]}, Bs0, _Fun) ->
+ Latin1 = [C band 16#FF || C <- S],
+ {list_to_binary(Latin1),Bs0};
eval_field({bin_element, _, {string, _, S}, default, default}, Bs0, _Fun) ->
Latin1 = [C band 16#FF || C <- S],
{list_to_binary(Latin1),Bs0};
-eval_field({bin_element, Line, {string, _, S}, Size0, Options0}, Bs, _Fun) ->
- {_Size,[Type,_Unit,_Sign,Endian]} =
+eval_field({bin_element, Line, {string, _, S}, Size0, Options0}, Bs0, Fun) ->
+ {Size1,[Type,{unit,Unit},Sign,Endian]} =
make_bit_type(Line, Size0, Options0),
- Res = << <<(eval_exp_field1(C, no_size, no_unit,
- Type, Endian, no_sign))/binary>> ||
+ {value,Size,Bs1} = Fun(Size1, Bs0),
+ Res = << <<(eval_exp_field1(C, Size, Unit,
+ Type, Endian, Sign))/binary>> ||
C <- S >>,
- {Res,Bs};
+ {Res,Bs1};
eval_field({bin_element,Line,E,Size0,Options0}, Bs0, Fun) ->
{value,V,Bs1} = Fun(E, Bs0),
{Size1,[Type,{unit,Unit},Sign,Endian]} =
diff --git a/lib/stdlib/src/filelib.erl b/lib/stdlib/src/filelib.erl
index 7029389e2f..daa18da9aa 100644
--- a/lib/stdlib/src/filelib.erl
+++ b/lib/stdlib/src/filelib.erl
@@ -24,6 +24,7 @@
-export([fold_files/5, last_modified/1, file_size/1, ensure_dir/1]).
-export([wildcard/3, is_dir/2, is_file/2, is_regular/2]).
-export([fold_files/6, last_modified/2, file_size/2]).
+-export([find_file/2, find_file/3, find_source/1, find_source/2, find_source/3]).
%% For debugging/testing.
-export([compile_wildcard/1]).
@@ -517,3 +518,124 @@ eval_list_dir(Dir, erl_prim_loader) ->
end;
eval_list_dir(Dir, Mod) ->
Mod:list_dir(Dir).
+
+%% Getting the rules to use for file search
+
+keep_dir_search_rules(Rules) ->
+ [T || {_,_}=T <- Rules].
+
+keep_suffix_search_rules(Rules) ->
+ [T || {_,_,_}=T <- Rules].
+
+get_search_rules() ->
+ case application:get_env(kernel, source_search_rules) of
+ undefined -> default_search_rules();
+ {ok, []} -> default_search_rules();
+ {ok, R} when is_list(R) -> R
+ end.
+
+default_search_rules() ->
+ [%% suffix-speficic rules for source search
+ {".beam", ".erl", erl_source_search_rules()},
+ {".erl", ".yrl", []},
+ {"", ".src", erl_source_search_rules()},
+ {".so", ".c", c_source_search_rules()},
+ {".o", ".c", c_source_search_rules()},
+ {"", ".c", c_source_search_rules()},
+ {"", ".in", basic_source_search_rules()},
+ %% plain old directory rules, backwards compatible
+ {"", ""},
+ {"ebin","src"},
+ {"ebin","esrc"}
+ ].
+
+basic_source_search_rules() ->
+ (erl_source_search_rules()
+ ++ c_source_search_rules()).
+
+erl_source_search_rules() ->
+ [{"ebin","src"}, {"ebin","esrc"}].
+
+c_source_search_rules() ->
+ [{"priv","c_src"}, {"priv","src"}, {"bin","c_src"}, {"bin","src"}, {"", "src"}].
+
+%% Looks for a file relative to a given directory
+
+-type find_file_rule() :: {ObjDirSuffix::string(), SrcDirSuffix::string()}.
+
+-spec find_file(filename(), filename()) ->
+ {ok, filename()} | {error, not_found}.
+find_file(Filename, Dir) ->
+ find_file(Filename, Dir, []).
+
+-spec find_file(filename(), filename(), [find_file_rule()]) ->
+ {ok, filename()} | {error, not_found}.
+find_file(Filename, Dir, []) ->
+ find_file(Filename, Dir, get_search_rules());
+find_file(Filename, Dir, Rules) ->
+ try_dir_rules(keep_dir_search_rules(Rules), Filename, Dir).
+
+%% Looks for a source file relative to the object file name and directory
+
+-type find_source_rule() :: {ObjExtension::string(), SrcExtension::string(),
+ [find_file_rule()]}.
+
+-spec find_source(filename()) ->
+ {ok, filename()} | {error, not_found}.
+find_source(FilePath) ->
+ find_source(filename:basename(FilePath), filename:dirname(FilePath)).
+
+-spec find_source(filename(), filename()) ->
+ {ok, filename()} | {error, not_found}.
+find_source(Filename, Dir) ->
+ find_source(Filename, Dir, []).
+
+-spec find_source(filename(), filename(), [find_source_rule()]) ->
+ {ok, filename()} | {error, not_found}.
+find_source(Filename, Dir, []) ->
+ find_source(Filename, Dir, get_search_rules());
+find_source(Filename, Dir, Rules) ->
+ try_suffix_rules(keep_suffix_search_rules(Rules), Filename, Dir).
+
+try_suffix_rules(Rules, Filename, Dir) ->
+ Ext = filename:extension(Filename),
+ try_suffix_rules(Rules, filename:rootname(Filename, Ext), Dir, Ext).
+
+try_suffix_rules([{Ext,Src,Rules}|Rest], Root, Dir, Ext)
+ when is_list(Src), is_list(Rules) ->
+ case try_dir_rules(add_local_search(Rules), Root ++ Src, Dir) of
+ {ok, File} -> {ok, File};
+ _Other ->
+ try_suffix_rules(Rest, Root, Dir, Ext)
+ end;
+try_suffix_rules([_|Rest], Root, Dir, Ext) ->
+ try_suffix_rules(Rest, Root, Dir, Ext);
+try_suffix_rules([], _Root, _Dir, _Ext) ->
+ {error, not_found}.
+
+%% ensuring we check the directory of the object file before any other directory
+add_local_search(Rules) ->
+ Local = {"",""},
+ [Local] ++ lists:filter(fun (X) -> X =/= Local end, Rules).
+
+try_dir_rules([{From, To}|Rest], Filename, Dir)
+ when is_list(From), is_list(To) ->
+ case try_dir_rule(Dir, Filename, From, To) of
+ {ok, File} -> {ok, File};
+ error -> try_dir_rules(Rest, Filename, Dir)
+ end;
+try_dir_rules([], _Filename, _Dir) ->
+ {error, not_found}.
+
+try_dir_rule(Dir, Filename, From, To) ->
+ case lists:suffix(From, Dir) of
+ true ->
+ NewDir = lists:sublist(Dir, 1, length(Dir)-length(From))++To,
+ Src = filename:join(NewDir, Filename),
+ case is_regular(Src) of
+ true -> {ok, Src};
+ false -> error
+ end;
+ false ->
+ error
+ end.
diff --git a/lib/stdlib/src/filename.erl b/lib/stdlib/src/filename.erl
index 9eeba874e1..b5df5c9d37 100644
--- a/lib/stdlib/src/filename.erl
+++ b/lib/stdlib/src/filename.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -19,6 +19,9 @@
%%
-module(filename).
+-deprecated({find_src,1,next_major_release}).
+-deprecated({find_src,2,next_major_release}).
+
%% Purpose: Provides generic manipulation of filenames.
%%
%% Generally, these functions accept filenames in the native format
@@ -34,9 +37,9 @@
-export([absname/1, absname/2, absname_join/2,
basename/1, basename/2, dirname/1,
extension/1, join/1, join/2, pathtype/1,
- rootname/1, rootname/2, split/1, nativename/1,
+ rootname/1, rootname/2, split/1, flatten/1, nativename/1,
safe_relative_path/1]).
--export([find_src/1, find_src/2, flatten/1]).
+-export([find_src/1, find_src/2]). % deprecated
-export([basedir/2, basedir/3]).
%% Undocumented and unsupported exports.
@@ -784,7 +787,12 @@ climb(_, []) ->
climb(T, [_|Acc]) ->
safe_relative_path_1(T, Acc).
-
+%% NOTE: The find_src/1/2 functions are deprecated; they try to do too much
+%% at once and are not a good fit for this module. Parts of the code have
+%% been moved to filelib:find_file/2 instead. Only this part of this
+%% module is allowed to call the filelib module; such mutual dependency
+%% should otherwise be avoided! This code should eventually be removed.
+%%
%% find_src(Module) --
%% find_src(Module, Rules) --
@@ -827,14 +835,7 @@ climb(T, [_|Acc]) ->
| {'d', atom()},
ErrorReason :: 'non_existing' | 'preloaded' | 'interpreted'.
find_src(Mod) ->
- Default = [{"", ""}, {"ebin", "src"}, {"ebin", "esrc"}],
- Rules =
- case application:get_env(kernel, source_search_rules) of
- undefined -> Default;
- {ok, []} -> Default;
- {ok, R} when is_list(R) -> R
- end,
- find_src(Mod, Rules).
+ find_src(Mod, []).
-spec find_src(Beam, Rules) -> {SourceFile, Options}
| {error, {ErrorReason, Module}} when
@@ -850,44 +851,47 @@ find_src(Mod) ->
ErrorReason :: 'non_existing' | 'preloaded' | 'interpreted'.
find_src(Mod, Rules) when is_atom(Mod) ->
find_src(atom_to_list(Mod), Rules);
-find_src(File0, Rules) when is_list(File0) ->
- Mod = list_to_atom(basename(File0, ".erl")),
- File = rootname(File0, ".erl"),
- case readable_file(File++".erl") of
- true ->
- try_file(File, Mod, Rules);
- false ->
- try_file(undefined, Mod, Rules)
- end.
-
-try_file(File, Mod, Rules) ->
+find_src(ModOrFile, Rules) when is_list(ModOrFile) ->
+ Extension = ".erl",
+ Mod = list_to_atom(basename(ModOrFile, Extension)),
case code:which(Mod) of
Possibly_Rel_Path when is_list(Possibly_Rel_Path) ->
- {ok, Cwd} = file:get_cwd(),
- Path = join(Cwd, Possibly_Rel_Path),
- try_file(File, Path, Mod, Rules);
+ {ok, Cwd} = file:get_cwd(),
+ ObjPath = make_abs_path(Cwd, Possibly_Rel_Path),
+ find_src_1(ModOrFile, ObjPath, Mod, Extension, Rules);
Ecode when is_atom(Ecode) -> % Ecode :: ecode()
{error, {Ecode, Mod}}
end.
%% At this point, the Mod is known to be valid.
%% If the source name is not known, find it.
-%% Then get the compilation options.
-%% Returns: {SrcFile, Options}
+find_src_1(ModOrFile, ObjPath, Mod, Extension, Rules) ->
+ %% The documentation says this function must return the found path
+ %% without extension in all cases. Also, ModOrFile could be given with
+ %% or without extension. Hence the calls to rootname below.
+ ModOrFileRoot = rootname(ModOrFile, Extension),
+ case filelib:is_regular(ModOrFileRoot++Extension) of
+ true ->
+ find_src_2(ModOrFileRoot, Mod);
+ false ->
+ SrcName = basename(ObjPath, code:objfile_extension()) ++ Extension,
+ case filelib:find_file(SrcName, dirname(ObjPath), Rules) of
+ {ok, SrcFile} ->
+ find_src_2(rootname(SrcFile, Extension), Mod);
+ Error ->
+ Error
+ end
+ end.
-try_file(undefined, ObjFilename, Mod, Rules) ->
- case get_source_file(ObjFilename, Mod, Rules) of
- {ok, File} -> try_file(File, ObjFilename, Mod, Rules);
- Error -> Error
- end;
-try_file(Src, _ObjFilename, Mod, _Rules) ->
+%% Get the compilation options and return {SrcFileRoot, Options}
+find_src_2(SrcRoot, Mod) ->
List = case Mod:module_info(compile) of
none -> [];
List0 -> List0
end,
Options = proplists:get_value(options, List, []),
{ok, Cwd} = file:get_cwd(),
- AbsPath = make_abs_path(Cwd, Src),
+ AbsPath = make_abs_path(Cwd, SrcRoot),
{AbsPath, filter_options(dirname(AbsPath), Options, [])}.
%% Filters the options.
@@ -918,42 +922,6 @@ filter_options(Base, [_|Rest], Result) ->
filter_options(_Base, [], Result) ->
Result.
-%% Gets the source file given path of object code and module name.
-
-get_source_file(Obj, Mod, Rules) ->
- source_by_rules(dirname(Obj), atom_to_list(Mod), Rules).
-
-source_by_rules(Dir, Base, [{From, To}|Rest]) ->
- case try_rule(Dir, Base, From, To) of
- {ok, File} -> {ok, File};
- error -> source_by_rules(Dir, Base, Rest)
- end;
-source_by_rules(_Dir, _Base, []) ->
- {error, source_file_not_found}.
-
-try_rule(Dir, Base, From, To) ->
- case lists:suffix(From, Dir) of
- true ->
- NewDir = lists:sublist(Dir, 1, length(Dir)-length(From))++To,
- Src = join(NewDir, Base),
- case readable_file(Src++".erl") of
- true -> {ok, Src};
- false -> error
- end;
- false ->
- error
- end.
-
-readable_file(File) ->
- case file:read_file_info(File) of
- {ok, #file_info{type=regular, access=read}} ->
- true;
- {ok, #file_info{type=regular, access=read_write}} ->
- true;
- _Other ->
- false
- end.
-
make_abs_path(BasePath, Path) ->
join(BasePath, Path).
diff --git a/lib/stdlib/src/gb_sets.erl b/lib/stdlib/src/gb_sets.erl
index 47a8fa6db0..6d6f7d40ac 100644
--- a/lib/stdlib/src/gb_sets.erl
+++ b/lib/stdlib/src/gb_sets.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2015. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -14,8 +9,6 @@
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
-%%
-%% %CopyrightEnd%
%%
%% =====================================================================
%% Ordered Sets implemented as General Balanced Trees
diff --git a/lib/stdlib/src/gb_trees.erl b/lib/stdlib/src/gb_trees.erl
index c4a20d92a7..c0cdde012e 100644
--- a/lib/stdlib/src/gb_trees.erl
+++ b/lib/stdlib/src/gb_trees.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2015. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -14,8 +9,6 @@
%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
%% See the License for the specific language governing permissions and
%% limitations under the License.
-%%
-%% %CopyrightEnd%
%%
%% =====================================================================
%% General Balanced Trees - highly efficient dictionaries.
@@ -59,6 +52,13 @@
%% - delete_any(X, T): removes key X from tree T if the key is present
%% in the tree, otherwise does nothing; returns new tree.
%%
+%% - take(X, T): removes element with key X from tree T; returns new tree
+%% without removed element. Assumes that the key is present in the tree.
+%%
+%% - take_any(X, T): removes element with key X from tree T and returns
+%% a new tree if the key is present; otherwise does nothing and returns
+%% 'error'.
+%%
%% - balance(T): rebalances tree T. Note that this is rarely necessary,
%% but may be motivated when a large number of entries have been
%% deleted from the tree without further insertions. Rebalancing could
@@ -121,7 +121,8 @@
-export([empty/0, is_empty/1, size/1, lookup/2, get/2, insert/3,
update/3, enter/3, delete/2, delete_any/2, balance/1,
is_defined/2, keys/1, values/1, to_list/1, from_orddict/1,
- smallest/1, largest/1, take_smallest/1, take_largest/1,
+ smallest/1, largest/1, take/2, take_any/2,
+ take_smallest/1, take_largest/1,
iterator/1, iterator_from/2, next/1, map/2]).
@@ -423,6 +424,41 @@ merge(Smaller, Larger) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+-spec take_any(Key, Tree1) -> {Value, Tree2} | 'error' when
+ Tree1 :: tree(Key, _),
+ Tree2 :: tree(Key, _),
+ Key :: term(),
+ Value :: term().
+
+take_any(Key, Tree) ->
+ case is_defined(Key, Tree) of
+ true -> take(Key, Tree);
+ false -> error
+ end.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+-spec take(Key, Tree1) -> {Value, Tree2} when
+ Tree1 :: tree(Key, _),
+ Tree2 :: tree(Key, _),
+ Key :: term(),
+ Value :: term().
+
+take(Key, {S, T}) when is_integer(S), S >= 0 ->
+ {Value, Res} = take_1(Key, T),
+ {Value, {S - 1, Res}}.
+
+take_1(Key, {Key1, Value, Smaller, Larger}) when Key < Key1 ->
+ {Value2, Smaller1} = take_1(Key, Smaller),
+ {Value2, {Key1, Value, Smaller1, Larger}};
+take_1(Key, {Key1, Value, Smaller, Bigger}) when Key > Key1 ->
+ {Value2, Bigger1} = take_1(Key, Bigger),
+ {Value2, {Key1, Value, Smaller, Bigger1}};
+take_1(_, {_Key, Value, Smaller, Larger}) ->
+ {Value, merge(Smaller, Larger)}.
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
-spec take_smallest(Tree1) -> {Key, Value, Tree2} when
Tree1 :: tree(Key, Value),
Tree2 :: tree(Key, Value).
diff --git a/lib/stdlib/src/gen_event.erl b/lib/stdlib/src/gen_event.erl
index 0ded1e9fa6..0aebf1bdc5 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -32,7 +32,9 @@
%%% Modified by Martin - uses proc_lib, sys and gen!
--export([start/0, start/1, start_link/0, start_link/1, stop/1, stop/3,
+-export([start/0, start/1, start/2,
+ start_link/0, start_link/1, start_link/2,
+ stop/1, stop/3,
notify/2, sync_notify/2,
add_handler/3, add_sup_handler/3, delete_handler/3, swap_handler/3,
swap_sup_handler/3, which_handlers/1, call/3, call/4, wake_hib/4]).
@@ -117,30 +119,64 @@
-type del_handler_ret() :: ok | term() | {'EXIT',term()}.
-type emgr_name() :: {'local', atom()} | {'global', atom()}
- | {'via', atom(), term()}.
+ | {'via', atom(), term()}.
+-type debug_flag() :: 'trace' | 'log' | 'statistics' | 'debug'
+ | {'logfile', string()}.
+-type option() :: {'timeout', timeout()}
+ | {'debug', [debug_flag()]}
+ | {'spawn_opt', [proc_lib:spawn_option()]}.
-type emgr_ref() :: atom() | {atom(), atom()} | {'global', atom()}
- | {'via', atom(), term()} | pid().
+ | {'via', atom(), term()} | pid().
-type start_ret() :: {'ok', pid()} | {'error', term()}.
%%---------------------------------------------------------------------------
-define(NO_CALLBACK, 'no callback module').
+%% -----------------------------------------------------------------
+%% Starts a generic event handler.
+%% start()
+%% start(MgrName | Options)
+%% start(MgrName, Options)
+%% start_link()
+%% start_link(MgrName | Options)
+%% start_link(MgrName, Options)
+%% MgrName ::= {local, atom()} | {global, atom()} | {via, atom(), term()}
+%% Options ::= [{timeout, Timeout} | {debug, [Flag]} | {spawn_opt,SOpts}]
+%% Flag ::= trace | log | {logfile, File} | statistics | debug
+%% (debug == log && statistics)
+%% Returns: {ok, Pid} |
+%% {error, {already_started, Pid}} |
+%% {error, Reason}
+%% -----------------------------------------------------------------
+
-spec start() -> start_ret().
start() ->
gen:start(?MODULE, nolink, ?NO_CALLBACK, [], []).
--spec start(emgr_name()) -> start_ret().
-start(Name) ->
- gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], []).
+-spec start(emgr_name() | [option()]) -> start_ret().
+start(Name) when is_tuple(Name) ->
+ gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], []);
+start(Options) when is_list(Options) ->
+ gen:start(?MODULE, nolink, ?NO_CALLBACK, [], Options).
+
+-spec start(emgr_name(), [option()]) -> start_ret().
+start(Name, Options) ->
+ gen:start(?MODULE, nolink, Name, ?NO_CALLBACK, [], Options).
-spec start_link() -> start_ret().
start_link() ->
gen:start(?MODULE, link, ?NO_CALLBACK, [], []).
--spec start_link(emgr_name()) -> start_ret().
-start_link(Name) ->
- gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], []).
+-spec start_link(emgr_name() | [option()]) -> start_ret().
+start_link(Name) when is_tuple(Name) ->
+ gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], []);
+start_link(Options) when is_list(Options) ->
+ gen:start(?MODULE, link, ?NO_CALLBACK, [], Options).
+
+-spec start_link(emgr_name(), [option()]) -> start_ret().
+start_link(Name, Options) ->
+ gen:start(?MODULE, link, Name, ?NO_CALLBACK, [], Options).
%% -spec init_it(pid(), 'self' | pid(), emgr_name(), module(), [term()], [_]) ->
init_it(Starter, self, Name, Mod, Args, Options) ->
@@ -160,7 +196,7 @@ add_sup_handler(M, Handler, Args) ->
rpc(M, {add_sup_handler, Handler, Args, self()}).
-spec notify(emgr_ref(), term()) -> 'ok'.
-notify(M, Event) -> send(M, {notify, Event}).
+notify(M, Event) -> send(M, {notify, Event}).
-spec sync_notify(emgr_ref(), term()) -> 'ok'.
sync_notify(M, Event) -> rpc(M, {sync_notify, Event}).
@@ -193,7 +229,7 @@ stop(M) ->
stop(M, Reason, Timeout) ->
gen:stop(M, Reason, Timeout).
-rpc(M, Cmd) ->
+rpc(M, Cmd) ->
{ok, Reply} = gen:call(M, self(), Cmd, infinity),
Reply.
@@ -421,7 +457,7 @@ server_add_handler({Mod,Id}, Args, MSL) ->
Handler = #handler{module = Mod,
id = Id},
server_add_handler(Mod, Handler, Args, MSL);
-server_add_handler(Mod, Args, MSL) ->
+server_add_handler(Mod, Args, MSL) ->
Handler = #handler{module = Mod},
server_add_handler(Mod, Handler, Args, MSL).
@@ -446,7 +482,7 @@ server_add_sup_handler({Mod,Id}, Args, MSL, Parent) ->
id = Id,
supervised = Parent},
server_add_handler(Mod, Handler, Args, MSL);
-server_add_sup_handler(Mod, Args, MSL, Parent) ->
+server_add_sup_handler(Mod, Args, MSL, Parent) ->
link(Parent),
Handler = #handler{module = Mod,
supervised = Parent},
@@ -454,7 +490,7 @@ server_add_sup_handler(Mod, Args, MSL, Parent) ->
%% server_delete_handler(HandlerId, Args, MSL) -> {Ret, MSL'}
-server_delete_handler(HandlerId, Args, MSL, SName) ->
+server_delete_handler(HandlerId, Args, MSL, SName) ->
case split(HandlerId, MSL) of
{Mod, Handler, MSL1} ->
{do_terminate(Mod, Handler, Args,
@@ -511,7 +547,7 @@ split_and_terminate(HandlerId, Args, MSL, SName, Handler2, Sup) ->
%% server_notify(Event, Func, MSL, SName) -> MSL'
-server_notify(Event, Func, [Handler|T], SName) ->
+server_notify(Event, Func, [Handler|T], SName) ->
case server_update(Handler, Func, Event, SName) of
{ok, Handler1} ->
{Hib, NewHandlers} = server_notify(Event, Func, T, SName),
@@ -531,9 +567,9 @@ server_update(Handler1, Func, Event, SName) ->
Mod1 = Handler1#handler.module,
State = Handler1#handler.state,
case catch Mod1:Func(Event, State) of
- {ok, State1} ->
+ {ok, State1} ->
{ok, Handler1#handler{state = State1}};
- {ok, State1, hibernate} ->
+ {ok, State1, hibernate} ->
{hibernate, Handler1#handler{state = State1}};
{swap_handler, Args1, State1, Handler2, Args2} ->
do_swap(Mod1, Handler1, Args1, State1, Handler2, Args2, SName);
@@ -644,14 +680,14 @@ server_call_update(Handler1, Query, SName) ->
Mod1 = Handler1#handler.module,
State = Handler1#handler.state,
case catch Mod1:handle_call(Query, State) of
- {ok, Reply, State1} ->
+ {ok, Reply, State1} ->
{{ok, Handler1#handler{state = State1}}, Reply};
- {ok, Reply, State1, hibernate} ->
- {{hibernate, Handler1#handler{state = State1}},
+ {ok, Reply, State1, hibernate} ->
+ {{hibernate, Handler1#handler{state = State1}},
Reply};
{swap_handler, Reply, Args1, State1, Handler2, Args2} ->
{do_swap(Mod1,Handler1,Args1,State1,Handler2,Args2,SName), Reply};
- {remove_handler, Reply} ->
+ {remove_handler, Reply} ->
do_terminate(Mod1, Handler1, remove_handler, State,
remove, SName, normal),
{no, Reply};
@@ -686,7 +722,7 @@ report_error(_Handler, normal, _, _, _) -> ok;
report_error(_Handler, shutdown, _, _, _) -> ok;
report_error(_Handler, {swapped,_,_}, _, _, _) -> ok;
report_error(Handler, Reason, State, LastIn, SName) ->
- Reason1 =
+ Reason1 =
case Reason of
{'EXIT',{undef,[{M,F,A,L}|MFAs]}} ->
case code:is_loaded(M) of
diff --git a/lib/stdlib/src/gen_fsm.erl b/lib/stdlib/src/gen_fsm.erl
index 6e7528fd98..e925a75fe8 100644
--- a/lib/stdlib/src/gen_fsm.erl
+++ b/lib/stdlib/src/gen_fsm.erl
@@ -273,7 +273,7 @@ start_timer(Time, Msg) ->
send_event_after(Time, Event) ->
erlang:start_timer(Time, self(), {'$gen_event', Event}).
-%% Returns the remaing time for the timer if Ref referred to
+%% Returns the remaining time for the timer if Ref referred to
%% an active timer/send_event_after, false otherwise.
cancel_timer(Ref) ->
case erlang:cancel_timer(Ref) of
diff --git a/lib/stdlib/src/gen_server.erl b/lib/stdlib/src/gen_server.erl
index 5800aca66f..284810c971 100644
--- a/lib/stdlib/src/gen_server.erl
+++ b/lib/stdlib/src/gen_server.erl
@@ -386,7 +386,7 @@ decode_msg(Msg, Parent, Name, State, Mod, Time, Debug, Hib) ->
sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug,
[Name, State, Mod, Time], Hib);
{'EXIT', Parent, Reason} ->
- terminate(Reason, Name, Msg, Mod, State, Debug);
+ terminate(Reason, Name, undefined, Msg, Mod, State, Debug);
_Msg when Debug =:= [] ->
handle_msg(Msg, Parent, Name, State, Mod);
_Msg ->
@@ -658,14 +658,14 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod) ->
loop(Parent, Name, NState, Mod, Time1, []);
{ok, {stop, Reason, Reply, NState}} ->
{'EXIT', R} =
- (catch terminate(Reason, Name, Msg, Mod, NState, [])),
+ (catch terminate(Reason, Name, From, Msg, Mod, NState, [])),
reply(From, Reply),
exit(R);
- Other -> handle_common_reply(Other, Parent, Name, Msg, Mod, State)
+ Other -> handle_common_reply(Other, Parent, Name, From, Msg, Mod, State)
end;
handle_msg(Msg, Parent, Name, State, Mod) ->
Reply = try_dispatch(Msg, Mod, State),
- handle_common_reply(Reply, Parent, Name, Msg, Mod, State).
+ handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod, State).
handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) ->
Result = try_handle_call(Mod, Msg, From, State),
@@ -686,31 +686,31 @@ handle_msg({'$gen_call', From, Msg}, Parent, Name, State, Mod, Debug) ->
loop(Parent, Name, NState, Mod, Time1, Debug1);
{ok, {stop, Reason, Reply, NState}} ->
{'EXIT', R} =
- (catch terminate(Reason, Name, Msg, Mod, NState, Debug)),
+ (catch terminate(Reason, Name, From, Msg, Mod, NState, Debug)),
_ = reply(Name, From, Reply, NState, Debug),
exit(R);
Other ->
- handle_common_reply(Other, Parent, Name, Msg, Mod, State, Debug)
+ handle_common_reply(Other, Parent, Name, From, Msg, Mod, State, Debug)
end;
handle_msg(Msg, Parent, Name, State, Mod, Debug) ->
Reply = try_dispatch(Msg, Mod, State),
- handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug).
+ handle_common_reply(Reply, Parent, Name, undefined, Msg, Mod, State, Debug).
-handle_common_reply(Reply, Parent, Name, Msg, Mod, State) ->
+handle_common_reply(Reply, Parent, Name, From, Msg, Mod, State) ->
case Reply of
{ok, {noreply, NState}} ->
loop(Parent, Name, NState, Mod, infinity, []);
{ok, {noreply, NState, Time1}} ->
loop(Parent, Name, NState, Mod, Time1, []);
{ok, {stop, Reason, NState}} ->
- terminate(Reason, Name, Msg, Mod, NState, []);
+ terminate(Reason, Name, From, Msg, Mod, NState, []);
{'EXIT', ExitReason, ReportReason} ->
- terminate(ExitReason, ReportReason, Name, Msg, Mod, State, []);
+ terminate(ExitReason, ReportReason, Name, From, Msg, Mod, State, []);
{ok, BadReply} ->
- terminate({bad_return_value, BadReply}, Name, Msg, Mod, State, [])
+ terminate({bad_return_value, BadReply}, Name, From, Msg, Mod, State, [])
end.
-handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug) ->
+handle_common_reply(Reply, Parent, Name, From, Msg, Mod, State, Debug) ->
case Reply of
{ok, {noreply, NState}} ->
Debug1 = sys:handle_debug(Debug, fun print_event/3, Name,
@@ -721,11 +721,11 @@ handle_common_reply(Reply, Parent, Name, Msg, Mod, State, Debug) ->
{noreply, NState}),
loop(Parent, Name, NState, Mod, Time1, Debug1);
{ok, {stop, Reason, NState}} ->
- terminate(Reason, Name, Msg, Mod, NState, Debug);
+ terminate(Reason, Name, From, Msg, Mod, NState, Debug);
{'EXIT', ExitReason, ReportReason} ->
- terminate(ExitReason, ReportReason, Name, Msg, Mod, State, Debug);
+ terminate(ExitReason, ReportReason, Name, From, Msg, Mod, State, Debug);
{ok, BadReply} ->
- terminate({bad_return_value, BadReply}, Name, Msg, Mod, State, Debug)
+ terminate({bad_return_value, BadReply}, Name, From, Msg, Mod, State, Debug)
end.
reply(Name, {To, Tag}, Reply, State, Debug) ->
@@ -743,7 +743,7 @@ system_continue(Parent, Debug, [Name, State, Mod, Time]) ->
-spec system_terminate(_, _, _, [_]) -> no_return().
system_terminate(Reason, _Parent, Debug, [Name, State, Mod, _Time]) ->
- terminate(Reason, Name, [], Mod, State, Debug).
+ terminate(Reason, Name, undefined, [], Mod, State, Debug).
system_code_change([Name, State, Mod, Time], _Module, OldVsn, Extra) ->
case catch Mod:code_change(OldVsn, State, Extra) of
@@ -786,17 +786,17 @@ print_event(Dev, Event, Name) ->
%%% Terminate the server.
%%% ---------------------------------------------------
--spec terminate(_, _, _, _, _, _) -> no_return().
-terminate(Reason, Name, Msg, Mod, State, Debug) ->
- terminate(Reason, Reason, Name, Msg, Mod, State, Debug).
-
-spec terminate(_, _, _, _, _, _, _) -> no_return().
-terminate(ExitReason, ReportReason, Name, Msg, Mod, State, Debug) ->
+terminate(Reason, Name, From, Msg, Mod, State, Debug) ->
+ terminate(Reason, Reason, Name, From, Msg, Mod, State, Debug).
+
+-spec terminate(_, _, _, _, _, _, _, _) -> no_return().
+terminate(ExitReason, ReportReason, Name, From, Msg, Mod, State, Debug) ->
Reply = try_terminate(Mod, ExitReason, State),
case Reply of
{'EXIT', ExitReason1, ReportReason1} ->
FmtState = format_status(terminate, Mod, get(), State),
- error_info(ReportReason1, Name, Msg, FmtState, Debug),
+ error_info(ReportReason1, Name, From, Msg, FmtState, Debug),
exit(ExitReason1);
_ ->
case ExitReason of
@@ -808,17 +808,17 @@ terminate(ExitReason, ReportReason, Name, Msg, Mod, State, Debug) ->
exit(Shutdown);
_ ->
FmtState = format_status(terminate, Mod, get(), State),
- error_info(ReportReason, Name, Msg, FmtState, Debug),
+ error_info(ReportReason, Name, From, Msg, FmtState, Debug),
exit(ExitReason)
end
end.
-error_info(_Reason, application_controller, _Msg, _State, _Debug) ->
+error_info(_Reason, application_controller, _From, _Msg, _State, _Debug) ->
%% OTP-5811 Don't send an error report if it's the system process
%% application_controller which is terminating - let init take care
%% of it instead
ok;
-error_info(Reason, Name, Msg, State, Debug) ->
+error_info(Reason, Name, From, Msg, State, Debug) ->
Reason1 =
case Reason of
{undef,[{M,F,A,L}|MFAs]} ->
@@ -835,15 +835,36 @@ error_info(Reason, Name, Msg, State, Debug) ->
end;
_ ->
Reason
- end,
+ end,
+ {ClientFmt, ClientArgs} = client_stacktrace(From),
format("** Generic server ~p terminating \n"
"** Last message in was ~p~n"
"** When Server state == ~p~n"
- "** Reason for termination == ~n** ~p~n",
- [Name, Msg, State, Reason1]),
+ "** Reason for termination == ~n** ~p~n" ++ ClientFmt,
+ [Name, Msg, State, Reason1] ++ ClientArgs),
sys:print_log(Debug),
ok.
+client_stacktrace(undefined) ->
+ {"", []};
+client_stacktrace({From, _Tag}) ->
+ client_stacktrace(From);
+client_stacktrace(From) when is_pid(From), node(From) =:= node() ->
+ case process_info(From, [current_stacktrace, registered_name]) of
+ undefined ->
+ {"** Client ~p is dead~n", [From]};
+ [{current_stacktrace, Stacktrace}, {registered_name, []}] ->
+ {"** Client ~p stacktrace~n"
+ "** ~p~n",
+ [From, Stacktrace]};
+ [{current_stacktrace, Stacktrace}, {registered_name, Name}] ->
+ {"** Client ~p stacktrace~n"
+ "** ~p~n",
+ [Name, Stacktrace]}
+ end;
+client_stacktrace(From) when is_pid(From) ->
+ {"** Client ~p is remote on node ~p~n", [From, node(From)]}.
+
%%-----------------------------------------------------------------
%% Status information
%%-----------------------------------------------------------------
diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl
index ad98bc0420..28e5007e5a 100644
--- a/lib/stdlib/src/io_lib.erl
+++ b/lib/stdlib/src/io_lib.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -28,7 +28,7 @@
%% Most of the code here is derived from the original prolog versions and
%% from similar code written by Joe Armstrong and myself.
%%
-%% This module has been split into seperate modules:
+%% This module has been split into separate modules:
%% io_lib - basic write and utilities
%% io_lib_format - formatted output
%% io_lib_fread - formatted input
@@ -68,8 +68,8 @@
-export([write_atom/1,write_string/1,write_string/2,write_latin1_string/1,
write_latin1_string/2, write_char/1, write_latin1_char/1]).
--export([write_string_as_latin1/1, write_string_as_latin1/2,
- write_char_as_latin1/1]).
+-export([write_atom_as_latin1/1, write_string_as_latin1/1,
+ write_string_as_latin1/2, write_char_as_latin1/1]).
-export([quote_atom/2, char_list/1, latin1_char_list/1,
deep_char_list/1, deep_latin1_char_list/1,
@@ -344,6 +344,11 @@ write_binary_body(B, _D) ->
<<X:L>> = B,
[integer_to_list(X),$:,integer_to_list(L)].
+%%% There are two functions to write Unicode atoms:
+%%% - they both escape control characters < 160;
+%%% - write_atom() never escapes characters >= 160;
+%%% - write_atom_as_latin1() also escapes characters >= 255.
+
%% write_atom(Atom) -> [Char]
%% Generate the list of characters needed to print an atom.
@@ -351,17 +356,26 @@ write_binary_body(B, _D) ->
Atom :: atom().
write_atom(Atom) ->
+ write_possibly_quoted_atom(Atom, fun write_string/2).
+
+-spec write_atom_as_latin1(Atom) -> latin1_string() when
+ Atom :: atom().
+
+write_atom_as_latin1(Atom) ->
+ write_possibly_quoted_atom(Atom, fun write_string_as_latin1/2).
+
+write_possibly_quoted_atom(Atom, PFun) ->
Chars = atom_to_list(Atom),
case quote_atom(Atom, Chars) of
true ->
- write_string(Chars, $'); %'
+ PFun(Chars, $'); %'
false ->
Chars
end.
%% quote_atom(Atom, CharList)
%% Return 'true' if atom with chars in CharList needs to be quoted, else
-%% return 'false'.
+%% return 'false'. Notice that characters >= 160 are always quoted.
-spec quote_atom(atom(), chars()) -> boolean().
diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl
index 1da866dc88..3113767614 100644
--- a/lib/stdlib/src/io_lib_format.erl
+++ b/lib/stdlib/src/io_lib_format.erl
@@ -265,7 +265,10 @@ control($W, [A,Depth], F, Adj, P, Pad, _Enc, _Str, _I) when is_integer(Depth) ->
term(io_lib:write(A, Depth), F, Adj, P, Pad);
control($P, [A,Depth], F, Adj, P, Pad, Enc, Str, I) when is_integer(Depth) ->
print(A, Depth, F, Adj, P, Pad, Enc, Str, I);
-control($s, [A], F, Adj, P, Pad, _Enc, _Str, _I) when is_atom(A) ->
+control($s, [A], F, Adj, P, Pad, latin1, _Str, _I) when is_atom(A) ->
+ L = iolist_to_chars(atom_to_list(A)),
+ string(L, F, Adj, P, Pad);
+control($s, [A], F, Adj, P, Pad, unicode, _Str, _I) when is_atom(A) ->
string(atom_to_list(A), F, Adj, P, Pad);
control($s, [L0], F, Adj, P, Pad, latin1, _Str, _I) ->
L = iolist_to_chars(L0),
@@ -343,7 +346,8 @@ term(T, F, Adj, P0, Pad) ->
%% print(Term, Depth, Field, Adjust, Precision, PadChar, Encoding,
%% Indentation)
-%% Print a term.
+%% Print a term. Field width sets maximum line length, Precision sets
+%% initial indentation.
print(T, D, none, Adj, P, Pad, E, Str, I) ->
print(T, D, 80, Adj, P, Pad, E, Str, I);
diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl
index ba2cffdcb3..ff368d02da 100644
--- a/lib/stdlib/src/io_lib_pretty.erl
+++ b/lib/stdlib/src/io_lib_pretty.erl
@@ -97,31 +97,44 @@ print(Term, Col, Ll, D, RecDefFun) ->
print(Term, Col, Ll, D, M, RecDefFun) ->
print(Term, Col, Ll, D, M, RecDefFun, latin1, true).
+%% D = Depth, default -1 (infinite), or LINEMAX=30 when printing from shell
+%% Col = current column, default 1
+%% Ll = line length/~p field width, default 80
+%% M = CHAR_MAX (-1 if no max, 60 when printing from shell)
print(_, _, _, 0, _M, _RF, _Enc, _Str) -> "...";
print(Term, Col, Ll, D, M, RecDefFun, Enc, Str) when Col =< 0 ->
+ %% ensure Col is at least 1
print(Term, 1, Ll, D, M, RecDefFun, Enc, Str);
+print(Atom, _Col, _Ll, _D, _M, _RF, Enc, _Str) when is_atom(Atom) ->
+ write_atom(Atom, Enc);
print(Term, Col, Ll, D, M0, RecDefFun, Enc, Str) when is_tuple(Term);
is_list(Term);
is_map(Term);
is_bitstring(Term) ->
+ %% preprocess and compute total number of chars
If = {_S, Len} = print_length(Term, D, RecDefFun, Enc, Str),
+ %% use Len as CHAR_MAX if M0 = -1
M = max_cs(M0, Len),
if
Len < Ll - Col, Len =< M ->
+ %% write the whole thing on a single line when there is room
write(If);
true ->
+ %% compute the indentation TInd for tagged tuples and records
TInd = while_fail([-1, 4],
fun(I) -> cind(If, Col, Ll, M, I, 0, 0) end,
1),
pp(If, Col, Ll, M, TInd, indent(Col), 0, 0)
end;
print(Term, _Col, _Ll, _D, _M, _RF, _Enc, _Str) ->
+ %% atomic data types (bignums, atoms, ...) are never truncated
io_lib:write(Term).
%%%
%%% Local functions
%%%
+%% use M only if nonnegative, otherwise use Len as default value
max_cs(M, Len) when M < 0 ->
Len;
max_cs(M, _Len) ->
@@ -156,6 +169,7 @@ pp({S, _Len}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
%% Print a tagged tuple by indenting the rest of the elements
%% differently to the tag. Tuple has size >= 2.
pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) ->
+ %% this uses TInd
TagInd = Tlen + 2,
Tcol = Col + TagInd,
S = $,,
@@ -254,6 +268,7 @@ pp_field({{field, Name, NameL, F}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W0) ->
{[Name, Sep, S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl
rec_indent(RInd, TInd, Col0, Ind0, W0) ->
+ %% this uses TInd
Nl = (TInd > 0) and (RInd > TInd),
DCol = case Nl of
true -> TInd;
@@ -332,6 +347,7 @@ pp_binary(S, N, _N0, Ind) ->
S
end.
+%% write the whole thing on a single line
write({{tuple, _IsTagged, L}, _}) ->
[${, write_list(L, $,), $}];
write({{list, L}, _}) ->
@@ -393,9 +409,14 @@ print_length({}, _D, _RF, _Enc, _Str) ->
{"{}", 2};
print_length(#{}=M, _D, _RF, _Enc, _Str) when map_size(M) =:= 0 ->
{"#{}", 3};
+print_length(Atom, _D, _RF, Enc, _Str) when is_atom(Atom) ->
+ S = write_atom(Atom, Enc),
+ {S, lists:flatlength(S)};
print_length(List, D, RF, Enc, Str) when is_list(List) ->
+ %% only flat lists are "printable"
case Str andalso printable_list(List, D, Enc) of
true ->
+ %% print as string, escaping double-quotes in the list
S = write_string(List, Enc),
{S, length(S)};
%% Truncated lists could break some existing code.
@@ -451,24 +472,15 @@ print_length(<<_/bitstring>>=Bin, D, _RF, Enc, Str) ->
end;
print_length(Term, _D, _RF, _Enc, _Str) ->
S = io_lib:write(Term),
+ %% S can contain unicode, so iolist_size(S) cannot be used here
{S, lists:flatlength(S)}.
print_length_map(_Map, 1, _RF, _Enc, _Str) ->
{"#{...}", 6};
print_length_map(Map, D, RF, Enc, Str) when is_map(Map) ->
- Pairs = print_length_map_pairs(maps_to_list(Map, D), D, RF, Enc, Str),
+ Pairs = print_length_map_pairs(erts_internal:maps_to_list(Map, D), D, RF, Enc, Str),
{{map, Pairs}, list_length(Pairs, 3)}.
-maps_to_list(Map, D) when D < 0; map_size(Map) =< D ->
- maps:to_list(Map);
-maps_to_list(Map, D) ->
- F = fun(_K, _V, {N, L}) when N =:= D ->
- throw(L);
- (K, V, {N, L}) ->
- {N+1, [{K, V} | L]}
- end,
- lists:reverse(catch maps:fold(F, {0, []}, Map)).
-
print_length_map_pairs([], _D, _RF, _Enc, _Str) ->
[];
print_length_map_pairs(_Pairs, 1, _RF, _Enc, _Str) ->
@@ -493,7 +505,7 @@ print_length_tuple(Tuple, D, RF, Enc, Str) ->
print_length_record(_Tuple, 1, _RF, _RDefs, _Enc, _Str) ->
{"{...}", 5};
print_length_record(Tuple, D, RF, RDefs, Enc, Str) ->
- Name = [$# | io_lib:write_atom(element(1, Tuple))],
+ Name = [$# | write_atom(element(1, Tuple), Enc)],
NameL = length(Name),
Elements = tl(tuple_to_list(Tuple)),
L = print_length_fields(RDefs, D - 1, Elements, RF, Enc, Str),
@@ -508,7 +520,7 @@ print_length_fields([Def | Defs], D, [E | Es], RF, Enc, Str) ->
print_length_fields(Defs, D - 1, Es, RF, Enc, Str)].
print_length_field(Def, D, E, RF, Enc, Str) ->
- Name = io_lib:write_atom(Def),
+ Name = write_atom(Def, Enc),
{S, L} = print_length(E, D, RF, Enc, Str),
NameL = length(Name) + 3,
{{field, Name, NameL, {S, L}}, NameL + L}.
@@ -544,6 +556,7 @@ list_length_tail({_, Len}, Acc) ->
%% ?CHARS printable characters has depth 1.
-define(CHARS, 4).
+%% only flat lists are "printable"
printable_list(_L, 1, _Enc) ->
false;
printable_list(L, _D, latin1) ->
@@ -656,6 +669,11 @@ printable_char(C,unicode) ->
C > 16#DFFF andalso C < 16#FFFE orelse
C > 16#FFFF andalso C =< 16#10FFFF.
+write_atom(A, latin1) ->
+ io_lib:write_atom_as_latin1(A);
+write_atom(A, _Uni) ->
+ io_lib:write_atom(A).
+
write_string(S, latin1) ->
io_lib:write_latin1_string(S, $"); %"
write_string(S, _Uni) ->
@@ -841,9 +859,11 @@ while_fail([], _F, V) ->
while_fail([A | As], F, V) ->
try F(A) catch _ -> while_fail(As, F, V) end.
+%% make a string of N spaces
indent(N) when is_integer(N), N > 0 ->
chars($\s, N-1).
+%% prepend N spaces onto Ind
indent(1, Ind) -> % Optimization of common case
[$\s | Ind];
indent(4, Ind) -> % Optimization of common case
diff --git a/lib/stdlib/src/math.erl b/lib/stdlib/src/math.erl
index 97c965e27a..3a3b384d8f 100644
--- a/lib/stdlib/src/math.erl
+++ b/lib/stdlib/src/math.erl
@@ -25,7 +25,9 @@
-export([sin/1, cos/1, tan/1, asin/1, acos/1, atan/1, atan2/2, sinh/1,
cosh/1, tanh/1, asinh/1, acosh/1, atanh/1, exp/1, log/1,
- log2/1, log10/1, pow/2, sqrt/1, erf/1, erfc/1]).
+ log2/1, log10/1, pow/2, sqrt/1, erf/1, erfc/1,
+ ceil/1, floor/1,
+ fmod/2]).
-spec acos(X) -> float() when
X :: number().
@@ -63,6 +65,11 @@ atan2(_, _) ->
atanh(_) ->
erlang:nif_error(undef).
+-spec ceil(X) -> float() when
+ X :: number().
+ceil(_) ->
+ erlang:nif_error(undef).
+
-spec cos(X) -> float() when
X :: number().
cos(_) ->
@@ -88,6 +95,16 @@ erfc(_) ->
exp(_) ->
erlang:nif_error(undef).
+-spec floor(X) -> float() when
+ X :: number().
+floor(_) ->
+ erlang:nif_error(undef).
+
+-spec fmod(X, Y) -> float() when
+ X :: number(), Y :: number().
+fmod(_, _) ->
+ erlang:nif_error(undef).
+
-spec log(X) -> float() when
X :: number().
log(_) ->
diff --git a/lib/stdlib/src/orddict.erl b/lib/stdlib/src/orddict.erl
index 37cf0084f0..caa59099af 100644
--- a/lib/stdlib/src/orddict.erl
+++ b/lib/stdlib/src/orddict.erl
@@ -22,7 +22,7 @@
%% Standard interface.
-export([new/0,is_key/2,to_list/1,from_list/1,size/1,is_empty/1]).
--export([fetch/2,find/2,fetch_keys/1,erase/2]).
+-export([fetch/2,find/2,fetch_keys/1,erase/2,take/2]).
-export([store/3,append/3,append_list/3,update/3,update/4,update_counter/3]).
-export([fold/3,map/2,filter/2,merge/3]).
@@ -106,6 +106,23 @@ erase(Key, [{K,_}=E|Dict]) when Key > K ->
erase(_Key, [{_K,_Val}|Dict]) -> Dict; %Key == K
erase(_, []) -> [].
+-spec take(Key, Orddict) -> {Value, Orddict1} | error when
+ Orddict :: orddict(Key, Value),
+ Orddict1 :: orddict(Key, Value),
+ Key :: term(),
+ Value :: term().
+
+take(Key, Dict) ->
+ take_1(Key, Dict, []).
+
+take_1(Key, [{K,_}|_], _Acc) when Key < K ->
+ error;
+take_1(Key, [{K,_}=P|D], Acc) when Key > K ->
+ take_1(Key, D, [P|Acc]);
+take_1(_Key, [{_K,Value}|D], Acc) ->
+ {Value,lists:reverse(Acc, D)};
+take_1(_, [], _) -> error.
+
-spec store(Key, Value, Orddict1) -> Orddict2 when
Orddict1 :: orddict(Key, Value),
Orddict2 :: orddict(Key, Value).
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 3bd338071b..d89ff4a624 100644
--- a/lib/stdlib/src/otp_internal.erl
+++ b/lib/stdlib/src/otp_internal.erl
@@ -47,9 +47,6 @@ obsolete(Module, Name, Arity) ->
obsolete_1(net, _, _) ->
{deprecated, "module 'net' obsolete; use 'net_adm'"};
-obsolete_1(erlang, hash, 2) ->
- {deprecated, {erlang, phash2, 2}};
-
obsolete_1(erlang, now, 0) ->
{deprecated,
"Deprecated BIF. See the \"Time and Time Correction in Erlang\" "
@@ -58,6 +55,11 @@ obsolete_1(erlang, now, 0) ->
obsolete_1(calendar, local_time_to_universal_time, 1) ->
{deprecated, {calendar, local_time_to_universal_time_dst, 1}};
+%% *** CRYPTO added in OTP 20 ***
+
+obsolete_1(crypto, rand_uniform, 2) ->
+ {deprecated, {rand, uniform, 1}};
+
%% *** CRYPTO added in OTP 19 ***
obsolete_1(crypto, rand_bytes, 1) ->
@@ -66,178 +68,178 @@ obsolete_1(crypto, rand_bytes, 1) ->
%% *** CRYPTO added in R16B01 ***
obsolete_1(crypto, md4, 1) ->
- {deprecated, {crypto, hash, 2}};
+ {removed, {crypto, hash, 2}, "20.0"};
obsolete_1(crypto, md5, 1) ->
- {deprecated, {crypto, hash, 2}};
+ {removed, {crypto, hash, 2}, "20.0"};
obsolete_1(crypto, sha, 1) ->
- {deprecated, {crypto, hash, 2}};
+ {removed, {crypto, hash, 2}, "20.0"};
obsolete_1(crypto, md4_init, 0) ->
- {deprecated, {crypto, hash_init, 1}};
+ {removed, {crypto, hash_init, 1}, "20.0"};
obsolete_1(crypto, md5_init, 0) ->
- {deprecated, {crypto, hash_init, 1}};
+ {removed, {crypto, hash_init, 1}, "20.0"};
obsolete_1(crypto, sha_init, 0) ->
- {deprecated, {crypto, hash_init, 1}};
+ {removed, {crypto, hash_init, 1}, "20.0"};
obsolete_1(crypto, md4_update, 2) ->
- {deprecated, {crypto, hash_update, 2}};
+ {removed, {crypto, hash_update, 2}, "20.0"};
obsolete_1(crypto, md5_update, 2) ->
- {deprecated, {crypto, hash_update, 2}};
+ {removed, {crypto, hash_update, 2}, "20.0"};
obsolete_1(crypto, sha_update, 2) ->
- {deprecated, {crypto, hash_update, 2}};
+ {removed, {crypto, hash_update, 2}, "20.0"};
obsolete_1(crypto, md4_final, 1) ->
- {deprecated, {crypto, hash_final, 1}};
+ {removed, {crypto, hash_final, 1}, "20.0"};
obsolete_1(crypto, md5_final, 1) ->
- {deprecated, {crypto, hash_final, 1}};
+ {removed, {crypto, hash_final, 1}, "20.0"};
obsolete_1(crypto, sha_final, 1) ->
- {deprecated, {crypto, hash_final, 1}};
+ {removed, {crypto, hash_final, 1}, "20.0"};
obsolete_1(crypto, md5_mac, 2) ->
- {deprecated, {crypto, hmac, 3}};
+ {removed, {crypto, hmac, 3}, "20.0"};
obsolete_1(crypto, sha_mac, 2) ->
- {deprecated, {crypto, hmac, 3}};
+ {removed, {crypto, hmac, 3}, "20.0"};
obsolete_1(crypto, sha_mac, 3) ->
- {deprecated, {crypto, hmac, 4}};
+ {removed, {crypto, hmac, 4}, "20.0"};
obsolete_1(crypto, sha_mac_96, 2) ->
- {deprecated, {crypto, hmac, 4}};
+ {removed, {crypto, hmac, 4}, "20.0"};
obsolete_1(crypto, md5_mac_96, 2) ->
- {deprecated, {crypto, hmac, 4}};
+ {removed, {crypto, hmac, 4}, "20.0"};
obsolete_1(crypto, rsa_sign, 2) ->
- {deprecated, {crypto, sign, 4}};
+ {removed, {crypto, sign, 4}, "20.0"};
obsolete_1(crypto, rsa_sign, 3) ->
- {deprecated, {crypto, sign, 4}};
+ {removed, {crypto, sign, 4}, "20.0"};
obsolete_1(crypto, rsa_verify, 3) ->
- {deprecated, {crypto, verify, 5}};
+ {removed, {crypto, verify, 5}, "20.0"};
obsolete_1(crypto, rsa_verify, 4) ->
- {deprecated, {crypto, verify, 5}};
+ {removed, {crypto, verify, 5}, "20.0"};
obsolete_1(crypto, dss_sign, 2) ->
- {deprecated, {crypto, sign, 4}};
+ {removed, {crypto, sign, 4}, "20.0"};
obsolete_1(crypto, dss_sign, 3) ->
- {deprecated, {crypto, sign, 4}};
+ {removed, {crypto, sign, 4}, "20.0"};
obsolete_1(crypto, dss_verify, 3) ->
- {deprecated, {crypto, verify, 5}};
+ {removed, {crypto, verify, 5}, "20.0"};
obsolete_1(crypto, dss_verify, 4) ->
- {deprecated, {crypto, verify, 5}};
+ {removed, {crypto, verify, 5}, "20.0"};
obsolete_1(crypto, mod_exp, 3) ->
- {deprecated, {crypto, mod_pow, 3}};
+ {removed, {crypto, mod_pow, 3}, "20.0"};
obsolete_1(crypto, dh_compute_key, 3) ->
- {deprecated, {crypto, compute_key, 4}};
+ {removed, {crypto, compute_key, 4}, "20.0"};
obsolete_1(crypto, dh_generate_key, 1) ->
- {deprecated, {crypto, generate_key, 2}};
+ {removed, {crypto, generate_key, 2}, "20.0"};
obsolete_1(crypto, dh_generate_key, 2) ->
- {deprecated, {crypto, generate_key, 3}};
+ {removed, {crypto, generate_key, 3}, "20.0"};
obsolete_1(crypto, des_cbc_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, des3_cbc_encrypt, 5) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, des_ecb_encrypt, 2) ->
- {deprecated, {crypto, block_encrypt, 3}};
+ {removed, {crypto, block_encrypt, 3}, "20.0"};
obsolete_1(crypto, des_ede3_cbc_encrypt, 5) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, des_cfb_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, des3_cfb_encrypt, 5) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, blowfish_ecb_encrypt, 2) ->
- {deprecated, {crypto, block_encrypt, 3}};
+ {removed, {crypto, block_encrypt, 3}, "20.0"};
obsolete_1(crypto, blowfish_cbc_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, blowfish_cfb64_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, blowfish_ofb64_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, aes_cfb_128_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, aes_cbc_128_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, aes_cbc_256_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto,rc2_cbc_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto,rc2_40_cbc_encrypt, 3) ->
- {deprecated, {crypto, block_encrypt, 4}};
+ {removed, {crypto, block_encrypt, 4}, "20.0"};
obsolete_1(crypto, des_cbc_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, des3_cbc_decrypt, 5) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, des_ecb_decrypt, 2) ->
- {deprecated, {crypto, block_decrypt, 3}};
+ {removed, {crypto, block_decrypt, 3}, "20.0"};
obsolete_1(crypto, des_ede3_cbc_decrypt, 5) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, des_cfb_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, des3_cfb_decrypt, 5) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, blowfish_ecb_decrypt, 2) ->
- {deprecated, {crypto, block_decrypt, 3}};
+ {removed, {crypto, block_decrypt, 3}, "20.0"};
obsolete_1(crypto, blowfish_cbc_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, blowfish_cfb64_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, blowfish_ofb64_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, aes_cfb_128_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, aes_cbc_128_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, aes_cbc_256_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto,rc2_cbc_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto,rc2_40_cbc_decrypt, 3) ->
- {deprecated, {crypto, block_decrypt, 4}};
+ {removed, {crypto, block_decrypt, 4}, "20.0"};
obsolete_1(crypto, aes_ctr_stream_decrypt, 2) ->
- {deprecated, {crypto, stream_decrypt, 2}};
+ {removed, {crypto, stream_decrypt, 2}, "20.0"};
obsolete_1(crypto, aes_ctr_stream_encrypt, 2) ->
- {deprecated, {crypto, stream_encrypt, 2}};
+ {removed, {crypto, stream_encrypt, 2}, "20.0"};
obsolete_1(crypto, aes_ctr_decrypt, 3) ->
- {deprecated, {crypto, stream_decrypt, 2}};
+ {removed, {crypto, stream_decrypt, 2}, "20.0"};
obsolete_1(crypto, aes_ctr_encrypt, 3) ->
- {deprecated, {crypto, stream_encrypt, 2}};
+ {removed, {crypto, stream_encrypt, 2}, "20.0"};
obsolete_1(crypto, rc4_encrypt, 2) ->
- {deprecated, {crypto, stream_encrypt, 2}};
+ {removed, {crypto, stream_encrypt, 2}, "20.0"};
obsolete_1(crypto, rc4_encrypt_with_state, 2) ->
- {deprecated, {crypto, stream_encrypt, 2}};
+ {removed, {crypto, stream_encrypt, 2}, "20.0"};
obsolete_1(crypto, aes_ctr_stream_init, 2) ->
- {deprecated, {crypto, stream_init, 3}};
+ {removed, {crypto, stream_init, 3}, "20.0"};
obsolete_1(crypto, rc4_set_key, 1) ->
- {deprecated, {crypto, stream_init, 2}};
+ {removed, {crypto, stream_init, 2}, "20.0"};
obsolete_1(crypto, rsa_private_decrypt, 3) ->
- {deprecated, {crypto, private_decrypt, 4}};
+ {removed, {crypto, private_decrypt, 4}, "20.0"};
obsolete_1(crypto, rsa_public_decrypt, 3) ->
- {deprecated, {crypto, public_decrypt, 4}};
+ {removed, {crypto, public_decrypt, 4}, "20.0"};
obsolete_1(crypto, rsa_private_encrypt, 3) ->
- {deprecated, {crypto, private_encrypt, 4}};
+ {removed, {crypto, private_encrypt, 4}, "20.0"};
obsolete_1(crypto, rsa_public_encrypt, 3) ->
- {deprecated, {crypto, public_encrypt, 4}};
+ {removed, {crypto, public_encrypt, 4}, "20.0"};
obsolete_1(crypto, des_cfb_ivec, 2) ->
- {deprecated, {crypto, next_iv, 3}};
+ {removed, {crypto, next_iv, 3}, "20.0"};
obsolete_1(crypto,des_cbc_ivec, 1) ->
- {deprecated, {crypto, next_iv, 2}};
+ {removed, {crypto, next_iv, 2}, "20.0"};
obsolete_1(crypto, aes_cbc_ivec, 1) ->
- {deprecated, {crypto, next_iv, 2}};
+ {removed, {crypto, next_iv, 2}, "20.0"};
obsolete_1(crypto,info, 0) ->
- {deprecated, {crypto, module_info, 0}};
+ {removed, {crypto, module_info, 0}, "20.0"};
obsolete_1(crypto, strong_rand_mpint, 3) ->
- {deprecated, "needed only by deprecated functions"};
+ {removed, "removed in 20.0; only needed by removed functions"};
obsolete_1(crypto, erlint, 1) ->
- {deprecated, "needed only by deprecated functions"};
+ {removed, "removed in 20.0; only needed by removed functions"};
obsolete_1(crypto, mpint, 1) ->
- {deprecated, "needed only by deprecated functions"};
+ {removed, "removed in 20.0; only needed by removed functions"};
%% *** SNMP ***
@@ -390,13 +392,13 @@ obsolete_1(erlang, concat_binary, 1) ->
%% Added in R14A.
obsolete_1(ssl, peercert, 2) ->
- {deprecated,"deprecated (will be removed in R15A); use ssl:peercert/1 and public_key:pkix_decode_cert/2 instead"};
+ {removed ,"removed in R15A; use ssl:peercert/1 and public_key:pkix_decode_cert/2 instead"};
%% Added in R14B.
obsolete_1(public_key, pem_to_der, 1) ->
- {deprecated,"deprecated (will be removed in R15A); use file:read_file/1 and public_key:pem_decode/1"};
+ {removed,"removed in R15A; use file:read_file/1 and public_key:pem_decode/1"};
obsolete_1(public_key, decode_private_key, A) when A =:= 1; A =:= 2 ->
- {deprecated,{public_key,pem_entry_decode,1},"R15A"};
+ {removed, "removed in R15A; use public_key:pem_entry_decode/1"};
%% Added in R14B03.
obsolete_1(docb_gen, _, _) ->
@@ -408,7 +410,7 @@ obsolete_1(docb_xml_check, _, _) ->
%% Added in R15B
obsolete_1(asn1rt, F, _) when F == load_driver; F == unload_driver ->
- {deprecated,"deprecated (will be removed in OTP 18); has no effect as drivers are no longer used"};
+ {removed,"removed (will be removed in OTP 18); has no effect as drivers are no longer used"};
obsolete_1(ssl, pid, 1) ->
{removed,"was removed in R16; is no longer needed"};
obsolete_1(inviso, _, _) ->
@@ -416,12 +418,12 @@ obsolete_1(inviso, _, _) ->
%% Added in R15B01.
obsolete_1(gs, _, _) ->
- {deprecated,"the gs application has been deprecated and will be removed in OTP 18; use the wx application instead"};
+ {removed,"the gs application has been removed; use the wx application instead"};
obsolete_1(ssh, sign_data, 2) ->
- {deprecated,"deprecated (will be removed in R16A); use public_key:pem_decode/1, public_key:pem_entry_decode/1 "
+ {removed,"removed in R16A; use public_key:pem_decode/1, public_key:pem_entry_decode/1 "
"and public_key:sign/3 instead"};
obsolete_1(ssh, verify_data, 3) ->
- {deprecated,"deprecated (will be removed in R16A); use public_key:ssh_decode/1, and public_key:verify/4 instead"};
+ {removed,"removed in R16A; use public_key:ssh_decode/1, and public_key:verify/4 instead"};
%% Added in R16
obsolete_1(wxCalendarCtrl, enableYearChange, _) -> %% wx bug documented?
@@ -463,21 +465,23 @@ obsolete_1(wxCursor, new, 4) ->
%% Added in OTP 17.
obsolete_1(asn1ct, decode,3) ->
- {deprecated,"deprecated; use Mod:decode/2 instead"};
+ {removed,"removed; use Mod:decode/2 instead"};
+obsolete_1(asn1ct, encode, 2) ->
+ {removed,"removed; use Mod:encode/2 instead"};
obsolete_1(asn1ct, encode, 3) ->
- {deprecated,"deprecated; use Mod:encode/2 instead"};
+ {removed,"removed; use Mod:encode/2 instead"};
obsolete_1(asn1rt, decode,3) ->
- {deprecated,"deprecated; use Mod:decode/2 instead"};
+ {removed,"removed; use Mod:decode/2 instead"};
obsolete_1(asn1rt, encode, 2) ->
- {deprecated,"deprecated; use Mod:encode/2 instead"};
+ {removed,"removed; use Mod:encode/2 instead"};
obsolete_1(asn1rt, encode, 3) ->
- {deprecated,"deprecated; use Mod:encode/2 instead"};
+ {removed,"removed; use Mod:encode/2 instead"};
obsolete_1(asn1rt, info, 1) ->
- {deprecated,"deprecated; use Mod:info/0 instead"};
+ {removed,"removed; use Mod:info/0 instead"};
obsolete_1(asn1rt, utf8_binary_to_list, 1) ->
- {deprecated,{unicode,characters_to_list,1}};
+ {removed,{unicode,characters_to_list,1},"OTP 20"};
obsolete_1(asn1rt, utf8_list_to_binary, 1) ->
- {deprecated,{unicode,characters_to_binary,1}};
+ {removed,{unicode,characters_to_binary,1},"OTP 20"};
%% Added in OTP 18.
obsolete_1(core_lib, get_anno, 1) ->
@@ -516,10 +520,9 @@ obsolete_1(erl_parse, get_attribute, 2) ->
obsolete_1(erl_lint, modify_line, 2) ->
{removed,{erl_parse,map_anno,2},"19.0"};
obsolete_1(ssl, negotiated_next_protocol, 1) ->
- {deprecated,{ssl,negotiated_protocol,1}};
-
+ {removed,"removed in 20.0; use ssl:negotiated_protocol/1 instead"};
obsolete_1(ssl, connection_info, 1) ->
- {deprecated, "deprecated; use connection_information/[1,2] instead"};
+ {removed, "removed in 20.0; use ssl:connection_information/[1,2] instead"};
obsolete_1(httpd_conf, check_enum, 2) ->
{deprecated, "deprecated; use lists:member/2 instead"};
@@ -549,7 +552,21 @@ obsolete_1(queue, lait, 1) ->
obsolete_1(overload, _, _) ->
{removed, "removed in OTP 19"};
obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 ->
- {removed, {rpc, multi_server_call, A}};
+ {removed, {rpc, multi_server_call, A}, "removed in OTP 19"};
+
+%% Added in OTP 20.
+
+obsolete_1(filename, find_src, 1) ->
+ {deprecated, "deprecated; use filelib:find_source/1 instead"};
+obsolete_1(filename, find_src, 2) ->
+ {deprecated, "deprecated; use filelib:find_source/3 instead"};
+
+%% Removed in OTP 20.
+
+obsolete_1(erlang, hash, 2) ->
+ {removed, {erlang, phash2, 2}, "20.0"};
+
+%% not obsolete
obsolete_1(_, _, _) ->
no.
diff --git a/lib/stdlib/src/proc_lib.erl b/lib/stdlib/src/proc_lib.erl
index 3dc1848550..363705b0f4 100644
--- a/lib/stdlib/src/proc_lib.erl
+++ b/lib/stdlib/src/proc_lib.erl
@@ -232,7 +232,7 @@ init_p(Parent, Ancestors, Fun) when is_function(Fun) ->
Fun()
catch
Class:Reason ->
- exit_p(Class, Reason)
+ exit_p(Class, Reason, erlang:get_stacktrace())
end.
-spec init_p(pid(), [pid()], atom(), atom(), [term()]) -> term().
@@ -247,7 +247,7 @@ init_p_do_apply(M, F, A) ->
apply(M, F, A)
catch
Class:Reason ->
- exit_p(Class, Reason)
+ exit_p(Class, Reason, erlang:get_stacktrace())
end.
-spec wake_up(atom(), atom(), [term()]) -> term().
@@ -257,22 +257,29 @@ wake_up(M, F, A) when is_atom(M), is_atom(F), is_list(A) ->
apply(M, F, A)
catch
Class:Reason ->
- exit_p(Class, Reason)
+ exit_p(Class, Reason, erlang:get_stacktrace())
end.
-exit_p(Class, Reason) ->
+exit_p(Class, Reason, Stacktrace) ->
case get('$initial_call') of
{M,F,A} when is_atom(M), is_atom(F), is_integer(A) ->
MFA = {M,F,make_dummy_args(A, [])},
crash_report(Class, Reason, MFA),
- exit(Reason);
+ erlang:raise(exit, exit_reason(Class, Reason, Stacktrace), Stacktrace);
_ ->
%% The process dictionary has been cleared or
%% possibly modified.
crash_report(Class, Reason, []),
- exit(Reason)
+ erlang:raise(exit, exit_reason(Class, Reason, Stacktrace), Stacktrace)
end.
+exit_reason(error, Reason, Stacktrace) ->
+ {Reason, Stacktrace};
+exit_reason(exit, Reason, _Stacktrace) ->
+ Reason;
+exit_reason(throw, Reason, Stacktrace) ->
+ {{nocatch, Reason}, Stacktrace}.
+
-spec start(Module, Function, Args) -> Ret when
Module :: module(),
Function :: atom(),
diff --git a/lib/stdlib/src/proplists.erl b/lib/stdlib/src/proplists.erl
index 5356467b19..340dfdcac9 100644
--- a/lib/stdlib/src/proplists.erl
+++ b/lib/stdlib/src/proplists.erl
@@ -1,8 +1,3 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
-%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
%% You may obtain a copy of the License at
@@ -15,14 +10,8 @@
%% See the License for the specific language governing permissions and
%% limitations under the License.
%%
-%% %CopyrightEnd%
-%%
-%% =====================================================================
-%% Support functions for property lists
-%%
-%% Copyright (C) 2000-2003 Richard Carlsson
-%% ---------------------------------------------------------------------
-%%
+%% @copyright 2000-2003 Richard Carlsson
+%% @author Richard Carlsson <[email protected]>
%% @doc Support functions for property lists.
%%
%% <p>Property lists are ordinary lists containing entries in the form
@@ -94,7 +83,7 @@ property(Key, Value) ->
%% ---------------------------------------------------------------------
-%% @doc Unfolds all occurences of atoms in <code>ListIn</code> to tuples
+%% @doc Unfolds all occurrences of atoms in <code>ListIn</code> to tuples
%% <code>{Atom, true}</code>.
%%
%% @see compact/1
diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl
index 0db63b81f4..4a39f8ae9d 100644
--- a/lib/stdlib/src/qlc_pt.erl
+++ b/lib/stdlib/src/qlc_pt.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -41,6 +41,7 @@
}).
-record(state, {imp,
+ overridden,
maxargs,
records,
xwarnings = [],
@@ -184,7 +185,9 @@ initiate(Forms0, Imported) ->
exclude_integers_from_unique_line_numbers(Forms0, NodeInfo),
?DEBUG("node info0 ~p~n",
[lists:sort(ets:tab2list(NodeInfo))]),
+ IsOverridden = set_up_overridden(Forms0),
State0 = #state{imp = Imported,
+ overridden = IsOverridden,
maxargs = ?EVAL_MAX_NUM_OF_ARGS,
records = record_attributes(Forms0),
node_info = NodeInfo},
@@ -436,7 +439,7 @@ compile_forms(Forms0, Options) ->
(_) -> false
end,
Forms = ([F || F <- Forms0, not Exclude(element(1, F))]
- ++ [{eof,anno0()}]),
+ ++ [{eof,0}]),
try
case compile:noenv_forms(Forms, compile_options(Options)) of
{ok, _ModName, Ws0} ->
@@ -1519,36 +1522,35 @@ filter_info(FilterData, AllIVs, Dependencies, State) ->
%% to be placed after further generators (the docs states otherwise, but
%% this seems to be common practice).
filter_list(FilterData, Dependencies, State) ->
- RDs = State#state.records,
- sel_gf(FilterData, 1, Dependencies, RDs, [], []).
+ sel_gf(FilterData, 1, Dependencies, State, [], []).
sel_gf([], _N, _Deps, _RDs, _Gens, _Gens1) ->
[];
-sel_gf([{#qid{no = N}=Id,{fil,F}}=Fil | FData], N, Deps, RDs, Gens, Gens1) ->
- case erl_lint:is_guard_test(F, RDs) of
+sel_gf([{#qid{no = N}=Id,{fil,F}}=Fil | FData], N, Deps, State, Gens, Gens1) ->
+ case is_guard_test(F, State) of
true ->
{Id,GIds} = lists:keyfind(Id, 1, Deps),
case length(GIds) =< 1 of
true ->
case generators_in_scope(GIds, Gens1) of
true ->
- [Fil|sel_gf(FData, N+1, Deps, RDs, Gens, Gens1)];
+ [Fil|sel_gf(FData, N+1, Deps, State, Gens, Gens1)];
false ->
- sel_gf(FData, N + 1, Deps, RDs, [], [])
+ sel_gf(FData, N + 1, Deps, State, [], [])
end;
false ->
case generators_in_scope(GIds, Gens) of
true ->
- [Fil | sel_gf(FData, N + 1, Deps, RDs, Gens, [])];
+ [Fil | sel_gf(FData, N + 1, Deps, State, Gens, [])];
false ->
- sel_gf(FData, N + 1, Deps, RDs, [], [])
+ sel_gf(FData, N + 1, Deps, State, [], [])
end
end;
false ->
- sel_gf(FData, N + 1, Deps, RDs, [], [])
+ sel_gf(FData, N + 1, Deps, State, [], [])
end;
-sel_gf(FData, N, Deps, RDs, Gens, Gens1) ->
- sel_gf(FData, N + 1, Deps, RDs, [N | Gens], [N | Gens1]).
+sel_gf(FData, N, Deps, State, Gens, Gens1) ->
+ sel_gf(FData, N + 1, Deps, State, [N | Gens], [N | Gens1]).
generators_in_scope(GenIds, GenNumbers) ->
lists:all(fun(#qid{no=N}) -> lists:member(N, GenNumbers) end, GenIds).
@@ -1870,7 +1872,8 @@ prep_expr(E, F, S, BF, Imported) ->
unify_column(Frame, Var, Col, BindFun, Imported) ->
A = anno0(),
- Call = {call,A,{atom,A,element},[{integer,A,Col}, {var,A,Var}]},
+ Call = {call,A,{remote,A,{atom,A,erlang},{atom,A,element}},
+ [{integer,A,Col}, {var,A,Var}]},
element_calls(Call, Frame, BindFun, Imported).
%% cons_tuple is used for representing {V1, ..., Vi | TupleTail}.
@@ -1880,6 +1883,8 @@ unify_column(Frame, Var, Col, BindFun, Imported) ->
%% about the size of the tuple is known.
element_calls({call,_,{remote,_,{atom,_,erlang},{atom,_,element}},
[{integer,_,I},Term0]}, F0, BF, Imported) when I > 0 ->
+ %% Note: erl_expand_records ensures that all calls to element/2
+ %% have an explicit "erlang:" prefix.
TupleTail = unique_var(),
VarsL = [unique_var() || _ <- lists:seq(1, I)],
Vars = VarsL ++ TupleTail,
@@ -1887,10 +1892,6 @@ element_calls({call,_,{remote,_,{atom,_,erlang},{atom,_,element}},
VarI = lists:nth(I, VarsL),
{Term, F} = element_calls(Term0, F0, BF, Imported),
{VarI, unify('=:=', Tuple, Term, F, BF, Imported)};
-element_calls({call,L1,{atom,_,element}=E,As}, F0, BF, Imported) ->
- %% erl_expand_records should add "erlang:"...
- element_calls({call,L1,{remote,L1,{atom,L1,erlang},E}, As}, F0, BF,
- Imported);
element_calls(T, F0, BF, Imported) when is_tuple(T) ->
{L, F} = element_calls(tuple_to_list(T), F0, BF, Imported),
{list_to_tuple(L), F};
@@ -2484,7 +2485,7 @@ filter(E, L, QIVs, S, RL, Fun, Go, GoI, IVs, State) ->
%% This is the "guard semantics" used in ordinary list
%% comprehension: if a filter looks like a guard test, it returns
%% 'false' rather than fails.
- Body = case erl_lint:is_guard_test(E, State#state.records) of
+ Body = case is_guard_test(E, State) of
true ->
CT = {clause,L,[],[[E]],[{call,L,?V(Fun),NAsT}]},
CF = {clause,L,[],[[?A(true)]],[{call,L,?V(Fun),NAsF}]},
@@ -2888,6 +2889,26 @@ family_list(L) ->
family(L) ->
sofs:relation_to_family(sofs:relation(L)).
+is_guard_test(E, #state{records = RDs, overridden = IsOverridden}) ->
+ erl_lint:is_guard_test(E, RDs, IsOverridden).
+
+%% In code that has been run through erl_expand_records, a guard
+%% test will never contain calls without an explicit module
+%% prefix. Unfortunately, this module runs *some* of the code
+%% through erl_expand_records, but not all of it.
+%%
+%% Therefore, we must set up our own list of local and imported functions
+%% that will override a BIF with the same name.
+
+set_up_overridden(Forms) ->
+ Locals = [{Name,Arity} || {function,_,Name,Arity,_} <- Forms],
+ Imports0 = [Fs || {attribute,_,import,Fs} <- Forms],
+ Imports1 = lists:flatten(Imports0),
+ Imports2 = [Fs || {_,Fs} <- Imports1],
+ Imports = lists:flatten(Imports2),
+ Overridden = gb_sets:from_list(Imports ++ Locals),
+ fun(FA) -> gb_sets:is_element(FA, Overridden) end.
+
-ifdef(debug).
display_forms(Forms) ->
io:format("Forms ***~n"),
diff --git a/lib/stdlib/src/rand.erl b/lib/stdlib/src/rand.erl
index 93409d95df..dfd102f9ef 100644
--- a/lib/stdlib/src/rand.erl
+++ b/lib/stdlib/src/rand.erl
@@ -19,7 +19,7 @@
%%
%% =====================================================================
%% Multiple PRNG module for Erlang/OTP
-%% Copyright (c) 2015 Kenji Rikitake
+%% Copyright (c) 2015-2016 Kenji Rikitake
%% =====================================================================
-module(rand).
@@ -27,11 +27,14 @@
-export([seed_s/1, seed_s/2, seed/1, seed/2,
export_seed/0, export_seed_s/1,
uniform/0, uniform/1, uniform_s/1, uniform_s/2,
+ jump/0, jump/1,
normal/0, normal_s/1
]).
-compile({inline, [exs64_next/1, exsplus_next/1,
+ exsplus_jump/1,
exs1024_next/1, exs1024_calc/2,
+ exs1024_jump/1,
get_52/1, normal_kiwi/1]}).
-define(DEFAULT_ALG_HANDLER, exsplus).
@@ -42,19 +45,31 @@
%% =====================================================================
%% This depends on the algorithm handler function
--type alg_seed() :: exs64_state() | exsplus_state() | exs1024_state().
+-type alg_state() ::
+ exs64_state() | exsplus_state() | exs1024_state() | term().
+
%% This is the algorithm handler function within this module
--type alg_handler() :: #{type := alg(),
- max := integer(),
- next := fun(),
- uniform := fun(),
- uniform_n := fun()}.
-
-%% Internal state
--opaque state() :: {alg_handler(), alg_seed()}.
--type alg() :: exs64 | exsplus | exs1024.
--opaque export_state() :: {alg(), alg_seed()}.
--export_type([alg/0, state/0, export_state/0]).
+-type alg_handler() ::
+ #{type := alg(),
+ max := integer() | infinity,
+ next :=
+ fun((alg_state()) -> {non_neg_integer(), alg_state()}),
+ uniform :=
+ fun((state()) -> {float(), state()}),
+ uniform_n :=
+ fun((pos_integer(), state()) -> {pos_integer(), state()}),
+ jump :=
+ fun((state()) -> state())}.
+
+%% Algorithm state
+-type state() :: {alg_handler(), alg_state()}.
+-type builtin_alg() :: exs64 | exsplus | exs1024.
+-type alg() :: builtin_alg() | atom().
+-type export_state() :: {alg(), alg_state()}.
+-export_type(
+ [builtin_alg/0, alg/0, alg_handler/0, alg_state/0,
+ state/0, export_state/0]).
+-export_type([exs64_state/0, exsplus_state/0, exs1024_state/0]).
%% =====================================================================
%% API
@@ -68,7 +83,7 @@ export_seed() ->
_ -> undefined
end.
--spec export_seed_s(state()) -> export_state().
+-spec export_seed_s(State :: state()) -> export_state().
export_seed_s({#{type:=Alg}, Seed}) -> {Alg, Seed}.
%% seed(Alg) seeds RNG with runtime dependent values
@@ -77,31 +92,37 @@ export_seed_s({#{type:=Alg}, Seed}) -> {Alg, Seed}.
%% seed({Alg,Seed}) setup RNG with a previously exported seed
%% and return the NEW state
--spec seed(AlgOrExpState::alg() | export_state()) -> state().
+-spec seed(
+ AlgOrStateOrExpState :: builtin_alg() | state() | export_state()) ->
+ state().
seed(Alg) ->
- R = seed_s(Alg),
- _ = seed_put(R),
- R.
+ seed_put(seed_s(Alg)).
--spec seed_s(AlgOrExpState::alg() | export_state()) -> state().
-seed_s(Alg) when is_atom(Alg) ->
- seed_s(Alg, {erlang:phash2([{node(),self()}]),
- erlang:system_time(),
- erlang:unique_integer()});
+-spec seed_s(
+ AlgOrStateOrExpState :: builtin_alg() | state() | export_state()) ->
+ state().
+seed_s({AlgHandler, _Seed} = State) when is_map(AlgHandler) ->
+ State;
seed_s({Alg0, Seed}) ->
{Alg,_SeedFun} = mk_alg(Alg0),
- {Alg, Seed}.
+ {Alg, Seed};
+seed_s(Alg) ->
+ seed_s(Alg, {erlang:phash2([{node(),self()}]),
+ erlang:system_time(),
+ erlang:unique_integer()}).
%% seed/2: seeds RNG with the algorithm and given values
%% and returns the NEW state.
--spec seed(Alg :: alg(), {integer(), integer(), integer()}) -> state().
+-spec seed(
+ Alg :: builtin_alg(), Seed :: {integer(), integer(), integer()}) ->
+ state().
seed(Alg0, S0) ->
- State = seed_s(Alg0, S0),
- _ = seed_put(State),
- State.
+ seed_put(seed_s(Alg0, S0)).
--spec seed_s(Alg :: alg(), {integer(), integer(), integer()}) -> state().
+-spec seed_s(
+ Alg :: builtin_alg(), Seed :: {integer(), integer(), integer()}) ->
+ state().
seed_s(Alg0, S0 = {_, _, _}) ->
{Alg, Seed} = mk_alg(Alg0),
AS = Seed(S0),
@@ -113,7 +134,7 @@ seed_s(Alg0, S0 = {_, _, _}) ->
%% uniform/0: returns a random float X where 0.0 < X < 1.0,
%% updating the state in the process dictionary.
--spec uniform() -> X::float().
+-spec uniform() -> X :: float().
uniform() ->
{X, Seed} = uniform_s(seed_get()),
_ = seed_put(Seed),
@@ -123,7 +144,7 @@ uniform() ->
%% uniform/1 returns a random integer X where 1 =< X =< N,
%% updating the state in the process dictionary.
--spec uniform(N :: pos_integer()) -> X::pos_integer().
+-spec uniform(N :: pos_integer()) -> X :: pos_integer().
uniform(N) ->
{X, Seed} = uniform_s(N, seed_get()),
_ = seed_put(Seed),
@@ -133,7 +154,7 @@ uniform(N) ->
%% returns a random float X where 0.0 < X < 1.0,
%% and a new state.
--spec uniform_s(state()) -> {X::float(), NewS :: state()}.
+-spec uniform_s(State :: state()) -> {X :: float(), NewState :: state()}.
uniform_s(State = {#{uniform:=Uniform}, _}) ->
Uniform(State).
@@ -141,7 +162,8 @@ uniform_s(State = {#{uniform:=Uniform}, _}) ->
%% uniform_s/2 returns a random integer X where 1 =< X =< N,
%% and a new state.
--spec uniform_s(N::pos_integer(), state()) -> {X::pos_integer(), NewS::state()}.
+-spec uniform_s(N :: pos_integer(), State :: state()) ->
+ {X :: pos_integer(), NewState :: state()}.
uniform_s(N, State = {#{uniform_n:=Uniform, max:=Max}, _})
when 0 < N, N =< Max ->
Uniform(N, State);
@@ -150,6 +172,25 @@ uniform_s(N, State0 = {#{uniform:=Uniform}, _})
{F, State} = Uniform(State0),
{trunc(F * N) + 1, State}.
+%% jump/1: given a state, jump/1
+%% returns a new state which is equivalent to that
+%% after a large number of call defined for each algorithm.
+%% The large number is algorithm dependent.
+
+-spec jump(state()) -> NewState :: state().
+jump(State = {#{jump:=Jump}, _}) ->
+ Jump(State).
+
+%% jump/0: read the internal state and
+%% apply the jump function for the state as in jump/1
+%% and write back the new value to the internal state,
+%% then returns the new value.
+
+-spec jump() -> NewState :: state().
+
+jump() ->
+ seed_put(jump(seed_get())).
+
%% normal/0: returns a random float with standard normal distribution
%% updating the state in the process dictionary.
@@ -163,7 +204,7 @@ normal() ->
%% The Ziggurat Method for generating random variables - Marsaglia and Tsang
%% Paper and reference code: http://www.jstatsoft.org/v05/i08/
--spec normal_s(state()) -> {float(), NewS :: state()}.
+-spec normal_s(State :: state()) -> {float(), NewState :: state()}.
normal_s(State0) ->
{Sign, R, State} = get_52(State0),
Idx = R band 16#FF,
@@ -192,9 +233,10 @@ normal_s(State0) ->
-type uint64() :: 0..16#ffffffffffffffff.
-type uint58() :: 0..16#03ffffffffffffff.
--spec seed_put(state()) -> undefined | state().
+-spec seed_put(state()) -> state().
seed_put(Seed) ->
- put(?SEED_DICT, Seed).
+ put(?SEED_DICT, Seed),
+ Seed.
seed_get() ->
case get(?SEED_DICT) of
@@ -205,15 +247,18 @@ seed_get() ->
%% Setup alg record
mk_alg(exs64) ->
{#{type=>exs64, max=>?UINT64MASK, next=>fun exs64_next/1,
- uniform=>fun exs64_uniform/1, uniform_n=>fun exs64_uniform/2},
+ uniform=>fun exs64_uniform/1, uniform_n=>fun exs64_uniform/2,
+ jump=>fun exs64_jump/1},
fun exs64_seed/1};
mk_alg(exsplus) ->
{#{type=>exsplus, max=>?UINT58MASK, next=>fun exsplus_next/1,
- uniform=>fun exsplus_uniform/1, uniform_n=>fun exsplus_uniform/2},
+ uniform=>fun exsplus_uniform/1, uniform_n=>fun exsplus_uniform/2,
+ jump=>fun exsplus_jump/1},
fun exsplus_seed/1};
mk_alg(exs1024) ->
{#{type=>exs1024, max=>?UINT64MASK, next=>fun exs1024_next/1,
- uniform=>fun exs1024_uniform/1, uniform_n=>fun exs1024_uniform/2},
+ uniform=>fun exs1024_uniform/1, uniform_n=>fun exs1024_uniform/2,
+ jump=>fun exs1024_jump/1},
fun exs1024_seed/1}.
%% =====================================================================
@@ -222,7 +267,7 @@ mk_alg(exs1024) ->
%% Reference URL: http://xorshift.di.unimi.it/
%% =====================================================================
--type exs64_state() :: uint64().
+-opaque exs64_state() :: uint64().
exs64_seed({A1, A2, A3}) ->
{V1, _} = exs64_next(((A1 band ?UINT32MASK) * 4294967197 + 1)),
@@ -246,6 +291,9 @@ exs64_uniform(Max, {Alg, R}) ->
{V, R1} = exs64_next(R),
{(V rem Max) + 1, {Alg, R1}}.
+exs64_jump(_) ->
+ erlang:error(not_implemented).
+
%% =====================================================================
%% exsplus PRNG: Xorshift116+
%% Algorithm by Sebastiano Vigna
@@ -254,7 +302,7 @@ exs64_uniform(Max, {Alg, R}) ->
%% Modification of the original Xorshift128+ algorithm to 116
%% by Sebastiano Vigna, a lot of thanks for his help and work.
%% =====================================================================
--type exsplus_state() :: nonempty_improper_list(uint58(), uint58()).
+-opaque exsplus_state() :: nonempty_improper_list(uint58(), uint58()).
-dialyzer({no_improper_lists, exsplus_seed/1}).
@@ -283,13 +331,47 @@ exsplus_uniform(Max, {Alg, R}) ->
{V, R1} = exsplus_next(R),
{(V rem Max) + 1, {Alg, R1}}.
+%% This is the jump function for the exsplus generator, equivalent
+%% to 2^64 calls to next/1; it can be used to generate 2^52
+%% non-overlapping subsequences for parallel computations.
+%% Note: the jump function takes 116 times of the execution time of
+%% next/1.
+
+%% -define(JUMPCONST, 16#000d174a83e17de2302f8ea6bc32c797).
+%% split into 58-bit chunks
+%% and two iterative executions
+
+-define(JUMPCONST1, 16#02f8ea6bc32c797).
+-define(JUMPCONST2, 16#345d2a0f85f788c).
+-define(JUMPELEMLEN, 58).
+
+-dialyzer({no_improper_lists, exsplus_jump/1}).
+-spec exsplus_jump(state()) -> state().
+exsplus_jump({Alg, S}) ->
+ {S1, AS1} = exsplus_jump(S, [0|0], ?JUMPCONST1, ?JUMPELEMLEN),
+ {_, AS2} = exsplus_jump(S1, AS1, ?JUMPCONST2, ?JUMPELEMLEN),
+ {Alg, AS2}.
+
+-dialyzer({no_improper_lists, exsplus_jump/4}).
+exsplus_jump(S, AS, _, 0) ->
+ {S, AS};
+exsplus_jump(S, [AS0|AS1], J, N) ->
+ {_, NS} = exsplus_next(S),
+ case (J band 1) of
+ 1 ->
+ [S0|S1] = S,
+ exsplus_jump(NS, [(AS0 bxor S0)|(AS1 bxor S1)], J bsr 1, N-1);
+ 0 ->
+ exsplus_jump(NS, [AS0|AS1], J bsr 1, N-1)
+ end.
+
%% =====================================================================
%% exs1024 PRNG: Xorshift1024*
%% Algorithm by Sebastiano Vigna
%% Reference URL: http://xorshift.di.unimi.it/
%% =====================================================================
--type exs1024_state() :: {list(uint64()), list(uint64())}.
+-opaque exs1024_state() :: {list(uint64()), list(uint64())}.
exs1024_seed({A1, A2, A3}) ->
B1 = (((A1 band ?UINT21MASK) + 1) * 2097131) band ?UINT21MASK,
@@ -340,6 +422,60 @@ exs1024_uniform(Max, {Alg, R}) ->
{V, R1} = exs1024_next(R),
{(V rem Max) + 1, {Alg, R1}}.
+%% This is the jump function for the exs1024 generator, equivalent
+%% to 2^512 calls to next(); it can be used to generate 2^512
+%% non-overlapping subsequences for parallel computations.
+%% Note: the jump function takes ~2000 times of the execution time of
+%% next/1.
+
+%% Jump constant here split into 58 bits for speed
+-define(JUMPCONSTHEAD, 16#00242f96eca9c41d).
+-define(JUMPCONSTTAIL,
+ [16#0196e1ddbe5a1561,
+ 16#0239f070b5837a3c,
+ 16#03f393cc68796cd2,
+ 16#0248316f404489af,
+ 16#039a30088bffbac2,
+ 16#02fea70dc2d9891f,
+ 16#032ae0d9644caec4,
+ 16#0313aac17d8efa43,
+ 16#02f132e055642626,
+ 16#01ee975283d71c93,
+ 16#00552321b06f5501,
+ 16#00c41d10a1e6a569,
+ 16#019158ecf8aa1e44,
+ 16#004e9fc949d0b5fc,
+ 16#0363da172811fdda,
+ 16#030e38c3b99181f2,
+ 16#0000000a118038fc]).
+-define(JUMPTOTALLEN, 1024).
+-define(RINGLEN, 16).
+
+-spec exs1024_jump(state()) -> state().
+
+exs1024_jump({Alg, {L, RL}}) ->
+ P = length(RL),
+ AS = exs1024_jump({L, RL},
+ [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0],
+ ?JUMPCONSTTAIL, ?JUMPCONSTHEAD, ?JUMPELEMLEN, ?JUMPTOTALLEN),
+ {ASL, ASR} = lists:split(?RINGLEN - P, AS),
+ {Alg, {ASL, lists:reverse(ASR)}}.
+
+exs1024_jump(_, AS, _, _, _, 0) ->
+ AS;
+exs1024_jump(S, AS, [H|T], _, 0, TN) ->
+ exs1024_jump(S, AS, T, H, ?JUMPELEMLEN, TN);
+exs1024_jump({L, RL}, AS, JL, J, N, TN) ->
+ {_, NS} = exs1024_next({L, RL}),
+ case (J band 1) of
+ 1 ->
+ AS2 = lists:zipwith(fun(X, Y) -> X bxor Y end,
+ AS, L ++ lists:reverse(RL)),
+ exs1024_jump(NS, AS2, JL, J bsr 1, N-1, TN-1);
+ 0 ->
+ exs1024_jump(NS, AS, JL, J bsr 1, N-1, TN-1)
+ end.
+
%% =====================================================================
%% Ziggurat cont
%% =====================================================================
diff --git a/lib/stdlib/src/sets.erl b/lib/stdlib/src/sets.erl
index 3e70450320..c65a13b22e 100644
--- a/lib/stdlib/src/sets.erl
+++ b/lib/stdlib/src/sets.erl
@@ -128,14 +128,14 @@ is_element(E, S) ->
Set2 :: set(Element).
add_element(E, S0) ->
Slot = get_slot(S0, E),
- {S1,Ic} = on_bucket(fun (B0) -> add_bkt_el(E, B0, B0) end, S0, Slot),
- maybe_expand(S1, Ic).
-
--spec add_bkt_el(T, [T], [T]) -> {[T], 0 | 1}.
-add_bkt_el(E, [E|_], Bkt) -> {Bkt,0};
-add_bkt_el(E, [_|B], Bkt) ->
- add_bkt_el(E, B, Bkt);
-add_bkt_el(E, [], Bkt) -> {[E|Bkt],1}.
+ Bkt = get_bucket(S0, Slot),
+ case lists:member(E, Bkt) of
+ true ->
+ S0;
+ false ->
+ S1 = update_bucket(S0, Slot, [E | Bkt]),
+ maybe_expand(S1)
+ end.
%% del_element(Element, Set) -> Set.
%% Return Set but with Element removed.
@@ -144,15 +144,28 @@ add_bkt_el(E, [], Bkt) -> {[E|Bkt],1}.
Set2 :: set(Element).
del_element(E, S0) ->
Slot = get_slot(S0, E),
- {S1,Dc} = on_bucket(fun (B0) -> del_bkt_el(E, B0) end, S0, Slot),
- maybe_contract(S1, Dc).
+ Bkt = get_bucket(S0, Slot),
+ case lists:member(E, Bkt) of
+ false ->
+ S0;
+ true ->
+ S1 = update_bucket(S0, Slot, lists:delete(E, Bkt)),
+ maybe_contract(S1, 1)
+ end.
--spec del_bkt_el(T, [T]) -> {[T], 0 | 1}.
-del_bkt_el(E, [E|Bkt]) -> {Bkt,1};
-del_bkt_el(E, [Other|Bkt0]) ->
- {Bkt1,Dc} = del_bkt_el(E, Bkt0),
- {[Other|Bkt1],Dc};
-del_bkt_el(_, []) -> {[],0}.
+%% update_bucket(Set, Slot, NewBucket) -> UpdatedSet.
+%% Replace bucket in Slot by NewBucket
+-spec update_bucket(Set1, Slot, Bkt) -> Set2 when
+ Set1 :: set(Element),
+ Set2 :: set(Element),
+ Slot :: non_neg_integer(),
+ Bkt :: [Element].
+update_bucket(Set, Slot, NewBucket) ->
+ SegI = ((Slot-1) div ?seg_size) + 1,
+ BktI = ((Slot-1) rem ?seg_size) + 1,
+ Segs = Set#set.segs,
+ Seg = element(SegI, Segs),
+ Set#set{segs = setelement(SegI, Segs, setelement(BktI, Seg, NewBucket))}.
%% union(Set1, Set2) -> Set
%% Return the union of Set1 and Set2.
@@ -272,19 +285,6 @@ get_slot(T, Key) ->
-spec get_bucket(set(), non_neg_integer()) -> term().
get_bucket(T, Slot) -> get_bucket_s(T#set.segs, Slot).
-%% on_bucket(Fun, Hashdb, Slot) -> {NewHashDb,Result}.
-%% Apply Fun to the bucket in Slot and replace the returned bucket.
--spec on_bucket(fun((_) -> {[_], 0 | 1}), set(E), non_neg_integer()) ->
- {set(E), 0 | 1}.
-on_bucket(F, T, Slot) ->
- SegI = ((Slot-1) div ?seg_size) + 1,
- BktI = ((Slot-1) rem ?seg_size) + 1,
- Segs = T#set.segs,
- Seg = element(SegI, Segs),
- B0 = element(BktI, Seg),
- {B1, Res} = F(B0), %Op on the bucket.
- {T#set{segs = setelement(SegI, Segs, setelement(BktI, Seg, B1))},Res}.
-
%% fold_set(Fun, Acc, Dictionary) -> Dictionary.
%% filter_set(Fun, Dictionary) -> Dictionary.
@@ -349,8 +349,8 @@ put_bucket_s(Segs, Slot, Bkt) ->
Seg = setelement(BktI, element(SegI, Segs), Bkt),
setelement(SegI, Segs, Seg).
--spec maybe_expand(set(E), 0 | 1) -> set(E).
-maybe_expand(T0, Ic) when T0#set.size + Ic > T0#set.exp_size ->
+-spec maybe_expand(set(E)) -> set(E).
+maybe_expand(T0) when T0#set.size + 1 > T0#set.exp_size ->
T = maybe_expand_segs(T0), %Do we need more segments.
N = T#set.n + 1, %Next slot to expand into
Segs0 = T#set.segs,
@@ -360,12 +360,12 @@ maybe_expand(T0, Ic) when T0#set.size + Ic > T0#set.exp_size ->
{B1,B2} = rehash(B, Slot1, Slot2, T#set.maxn),
Segs1 = put_bucket_s(Segs0, Slot1, B1),
Segs2 = put_bucket_s(Segs1, Slot2, B2),
- T#set{size = T#set.size + Ic,
+ T#set{size = T#set.size + 1,
n = N,
exp_size = N * ?expand_load,
con_size = N * ?contract_load,
segs = Segs2};
-maybe_expand(T, Ic) -> T#set{size = T#set.size + Ic}.
+maybe_expand(T) -> T#set{size = T#set.size + 1}.
-spec maybe_expand_segs(set(E)) -> set(E).
maybe_expand_segs(T) when T#set.n =:= T#set.maxn ->
diff --git a/lib/stdlib/src/shell.erl b/lib/stdlib/src/shell.erl
index 28f37ef8bf..394f4f2fa4 100644
--- a/lib/stdlib/src/shell.erl
+++ b/lib/stdlib/src/shell.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1996-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -349,10 +349,16 @@ default_prompt(N) ->
%% Don't bother flattening the list irrespective of what the
%% I/O-protocol states.
case is_alive() of
- true -> io_lib:format(<<"(~s)~w> ">>, [node(), N]);
+ true -> io_lib:format(<<"(~ts)~w> ">>, [node_string(), N]);
false -> io_lib:format(<<"~w> ">>, [N])
end.
+node_string() ->
+ case encoding() of
+ latin1 -> io_lib:write_atom_as_latin1(node());
+ _ -> io_lib:write_atom(node())
+ end.
+
%% expand_hist(Expressions, CommandNumber)
%% Preprocess the expression list replacing all history list commands
%% with their expansions.
@@ -967,10 +973,11 @@ local_func(f, [{var,_,Name}], Bs, _Shell, _RT, _Lf, _Ef) ->
{value,ok,erl_eval:del_binding(Name, Bs)};
local_func(f, [_Other], _Bs, _Shell, _RT, _Lf, _Ef) ->
erlang:raise(error, function_clause, [{shell,f,1}]);
-local_func(rd, [{atom,_,RecName},RecDef0], Bs, _Shell, RT, _Lf, _Ef) ->
+local_func(rd, [{atom,_,RecName0},RecDef0], Bs, _Shell, RT, _Lf, _Ef) ->
RecDef = expand_value(RecDef0),
RDs = lists:flatten(erl_pp:expr(RecDef)),
- Attr = lists:concat(["-record('", RecName, "',", RDs, ")."]),
+ RecName = io_lib:write_atom_as_latin1(RecName0),
+ Attr = lists:concat(["-record(", RecName, ",", RDs, ")."]),
{ok, Tokens, _} = erl_scan:string(Attr),
case erl_parse:parse_form(Tokens) of
{ok,AttrForm} ->
@@ -1417,9 +1424,11 @@ columns() ->
{ok,N} -> N;
_ -> 80
end.
+
encoding() ->
[{encoding, Encoding}] = enc(),
Encoding.
+
enc() ->
case lists:keyfind(encoding, 1, io:getopts()) of
false -> [{encoding,latin1}]; % should never happen
diff --git a/lib/stdlib/src/shell_default.erl b/lib/stdlib/src/shell_default.erl
index 6947cf181b..a0c1d98513 100644
--- a/lib/stdlib/src/shell_default.erl
+++ b/lib/stdlib/src/shell_default.erl
@@ -23,7 +23,7 @@
-module(shell_default).
--export([help/0,lc/1,c/1,c/2,nc/1,nl/1,l/1,i/0,pid/3,i/3,m/0,m/1,
+-export([help/0,lc/1,c/1,c/2,c/3,nc/1,nl/1,l/1,i/0,pid/3,i/3,m/0,m/1,lm/0,mm/0,
memory/0,memory/1,uptime/0,
erlangrc/1,bi/1, regs/0, flush/0,pwd/0,ls/0,ls/1,cd/1,
y/1, y/2,
@@ -72,6 +72,7 @@ bi(I) -> c:bi(I).
bt(Pid) -> c:bt(Pid).
c(File) -> c:c(File).
c(File, Opt) -> c:c(File, Opt).
+c(File, Opt, Filter) -> c:c(File, Opt, Filter).
cd(D) -> c:cd(D).
erlangrc(X) -> c:erlangrc(X).
flush() -> c:flush().
@@ -83,6 +84,8 @@ ls() -> c:ls().
ls(S) -> c:ls(S).
m() -> c:m().
m(Mod) -> c:m(Mod).
+lm() -> c:lm().
+mm() -> c:mm().
memory() -> c:memory().
memory(Type) -> c:memory(Type).
nc(X) -> c:nc(X).
diff --git a/lib/stdlib/src/sofs.erl b/lib/stdlib/src/sofs.erl
index c244e06ca4..cc50e1b52c 100644
--- a/lib/stdlib/src/sofs.erl
+++ b/lib/stdlib/src/sofs.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -76,7 +76,7 @@
%%
%% See also "Naive Set Theory" by Paul R. Halmos.
%%
-%% By convention, erlang:error/2 is called from exported functions.
+%% By convention, erlang:error/1 is called from exported functions.
-define(TAG, 'Set').
-define(ORDTAG, 'OrdSet').
@@ -87,12 +87,6 @@
-define(LIST(S), (S)#?TAG.data).
-define(TYPE(S), (S)#?TAG.type).
-%%-define(SET(L, T),
-%% case is_type(T) of
-%% true -> #?TAG{data = L, type = T};
-%% false -> erlang:error(badtype, [T])
-%% end
-%% ).
-define(SET(L, T), #?TAG{data = L, type = T}).
-define(IS_SET(S), is_record(S, ?TAG)).
-define(IS_UNTYPED_SET(S), ?TYPE(S) =:= ?ANYTYPE).
@@ -154,11 +148,8 @@ from_term(T) ->
_ when is_list(T) -> [?ANYTYPE];
_ -> ?ANYTYPE
end,
- case catch setify(T, Type) of
- {'EXIT', _} ->
- erlang:error(badarg, [T]);
- Set ->
- Set
+ try setify(T, Type)
+ catch _:_ -> erlang:error(badarg)
end.
-spec(from_term(Term, Type) -> AnySet when
@@ -168,14 +159,11 @@ from_term(T) ->
from_term(L, T) ->
case is_type(T) of
true ->
- case catch setify(L, T) of
- {'EXIT', _} ->
- erlang:error(badarg, [L, T]);
- Set ->
- Set
+ try setify(L, T)
+ catch _:_ -> erlang:error(badarg)
end;
false ->
- erlang:error(badarg, [L, T])
+ erlang:error(badarg)
end.
-spec(from_external(ExternalSet, Type) -> AnySet when
@@ -208,33 +196,26 @@ is_type(_T) ->
Set :: a_set(),
Terms :: [term()]).
set(L) ->
- case catch usort(L) of
- {'EXIT', _} ->
- erlang:error(badarg, [L]);
- SL ->
- ?SET(SL, ?ATOM_TYPE)
+ try usort(L) of
+ SL -> ?SET(SL, ?ATOM_TYPE)
+ catch _:_ -> erlang:error(badarg)
end.
-spec(set(Terms, Type) -> Set when
Set :: a_set(),
Terms :: [term()],
Type :: type()).
-set(L, ?SET_OF(Type) = T) when ?IS_ATOM_TYPE(Type), Type =/= ?ANYTYPE ->
- case catch usort(L) of
- {'EXIT', _} ->
- erlang:error(badarg, [L, T]);
- SL ->
- ?SET(SL, Type)
+set(L, ?SET_OF(Type)) when ?IS_ATOM_TYPE(Type), Type =/= ?ANYTYPE ->
+ try usort(L) of
+ SL -> ?SET(SL, Type)
+ catch _:_ -> erlang:error(badarg)
end;
set(L, ?SET_OF(_) = T) ->
- case catch setify(L, T) of
- {'EXIT', _} ->
- erlang:error(badarg, [L, T]);
- Set ->
- Set
+ try setify(L, T)
+ catch _:_ -> erlang:error(badarg)
end;
-set(L, T) ->
- erlang:error(badarg, [L, T]).
+set(_, _) ->
+ erlang:error(badarg).
-spec(from_sets(ListOfSets) -> Set when
Set :: a_set(),
@@ -245,19 +226,19 @@ set(L, T) ->
from_sets(Ss) when is_list(Ss) ->
case set_of_sets(Ss, [], ?ANYTYPE) of
{error, Error} ->
- erlang:error(Error, [Ss]);
+ erlang:error(Error);
Set ->
Set
end;
from_sets(Tuple) when is_tuple(Tuple) ->
case ordset_of_sets(tuple_to_list(Tuple), [], []) of
error ->
- erlang:error(badarg, [Tuple]);
+ erlang:error(badarg);
Set ->
Set
end;
-from_sets(T) ->
- erlang:error(badarg, [T]).
+from_sets(_) ->
+ erlang:error(badarg).
-spec(relation(Tuples) -> Relation when
Relation :: relation(),
@@ -265,14 +246,11 @@ from_sets(T) ->
relation([]) ->
?SET([], ?BINREL(?ATOM_TYPE, ?ATOM_TYPE));
relation(Ts = [T | _]) when is_tuple(T) ->
- case catch rel(Ts, tuple_size(T)) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts]);
- Set ->
- Set
+ try rel(Ts, tuple_size(T))
+ catch _:_ -> erlang:error(badarg)
end;
-relation(E) ->
- erlang:error(badarg, [E]).
+relation(_) ->
+ erlang:error(badarg).
-spec(relation(Tuples, Type) -> Relation when
N :: integer(),
@@ -280,24 +258,20 @@ relation(E) ->
Relation :: relation(),
Tuples :: [tuple()]).
relation(Ts, TS) ->
- case catch rel(Ts, TS) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts, TS]);
- Set ->
- Set
+ try rel(Ts, TS)
+ catch _:_ -> erlang:error(badarg)
end.
-spec(a_function(Tuples) -> Function when
Function :: a_function(),
Tuples :: [tuple()]).
a_function(Ts) ->
- case catch func(Ts, ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts]);
+ try func(Ts, ?BINREL(?ATOM_TYPE, ?ATOM_TYPE)) of
Bad when is_atom(Bad) ->
- erlang:error(Bad, [Ts]);
- Set ->
- Set
+ erlang:error(Bad);
+ Set ->
+ Set
+ catch _:_ -> erlang:error(badarg)
end.
-spec(a_function(Tuples, Type) -> Function when
@@ -305,26 +279,24 @@ a_function(Ts) ->
Tuples :: [tuple()],
Type :: type()).
a_function(Ts, T) ->
- case catch a_func(Ts, T) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts, T]);
+ try a_func(Ts, T) of
Bad when is_atom(Bad) ->
- erlang:error(Bad, [Ts, T]);
+ erlang:error(Bad);
Set ->
Set
+ catch _:_ -> erlang:error(badarg)
end.
-spec(family(Tuples) -> Family when
Family :: family(),
Tuples :: [tuple()]).
family(Ts) ->
- case catch fam2(Ts, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts]);
+ try fam2(Ts, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE)) of
Bad when is_atom(Bad) ->
- erlang:error(Bad, [Ts]);
+ erlang:error(Bad);
Set ->
Set
+ catch _:_ -> erlang:error(badarg)
end.
-spec(family(Tuples, Type) -> Family when
@@ -332,13 +304,12 @@ family(Ts) ->
Tuples :: [tuple()],
Type :: type()).
family(Ts, T) ->
- case catch fam(Ts, T) of
- {'EXIT', _} ->
- erlang:error(badarg, [Ts, T]);
+ try fam(Ts, T) of
Bad when is_atom(Bad) ->
- erlang:error(Bad, [Ts, T]);
+ erlang:error(Bad);
Set ->
Set
+ catch _:_ -> erlang:error(badarg)
end.
%%%
@@ -373,7 +344,7 @@ to_sets(S) when ?IS_SET(S) ->
to_sets(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) ->
tuple_of_sets(tuple_to_list(?ORDDATA(S)), tuple_to_list(?ORDTYPE(S)), []);
to_sets(S) when ?IS_ORDSET(S) ->
- erlang:error(badarg, [S]).
+ erlang:error(badarg).
-spec(no_elements(ASet) -> NoElements when
ASet :: a_set() | ordset(),
@@ -383,7 +354,7 @@ no_elements(S) when ?IS_SET(S) ->
no_elements(S) when ?IS_ORDSET(S), is_tuple(?ORDTYPE(S)) ->
tuple_size(?ORDDATA(S));
no_elements(S) when ?IS_ORDSET(S) ->
- erlang:error(badarg, [S]).
+ erlang:error(badarg).
-spec(specification(Fun, Set1) -> Set2 when
Fun :: spec_fun(),
@@ -401,7 +372,7 @@ specification(Fun, S) when ?IS_SET(S) ->
SL when is_list(SL) ->
?SET(SL, Type);
Bad ->
- erlang:error(Bad, [Fun, S])
+ erlang:error(Bad)
end.
-spec(union(Set1, Set2) -> Set3 when
@@ -410,7 +381,7 @@ specification(Fun, S) when ?IS_SET(S) ->
Set3 :: a_set()).
union(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> ?SET(umerge(?LIST(S1), ?LIST(S2)), Type)
end.
@@ -420,7 +391,7 @@ union(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
Set3 :: a_set()).
intersection(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> ?SET(intersection(?LIST(S1), ?LIST(S2), []), Type)
end.
@@ -430,7 +401,7 @@ intersection(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
Set3 :: a_set()).
difference(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> ?SET(difference(?LIST(S1), ?LIST(S2), []), Type)
end.
@@ -440,7 +411,7 @@ difference(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
Set3 :: a_set()).
symdiff(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> ?SET(symdiff(?LIST(S1), ?LIST(S2), []), Type)
end.
@@ -452,7 +423,7 @@ symdiff(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
Set5 :: a_set()).
symmetric_partition(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case unify_types(?TYPE(S1), ?TYPE(S2)) of
- [] -> erlang:error(type_mismatch, [S1, S2]);
+ [] -> erlang:error(type_mismatch);
Type -> sympart(?LIST(S1), ?LIST(S2), [], [], [], Type)
end.
@@ -477,11 +448,9 @@ product({S1, S2}) ->
product(S1, S2);
product(T) when is_tuple(T) ->
Ss = tuple_to_list(T),
- case catch sets_to_list(Ss) of
- {'EXIT', _} ->
- erlang:error(badarg, [T]);
+ try sets_to_list(Ss) of
[] ->
- erlang:error(badarg, [T]);
+ erlang:error(badarg);
L ->
Type = types(Ss, []),
case member([], L) of
@@ -490,6 +459,7 @@ product(T) when is_tuple(T) ->
false ->
?SET(reverse(prod(L, [], [])), Type)
end
+ catch _:_ -> erlang:error(badarg)
end.
-spec(constant_function(Set, AnySet) -> Function when
@@ -502,10 +472,10 @@ constant_function(S, E) when ?IS_SET(S) ->
{Type, true} ->
NType = ?BINREL(Type, type(E)),
?SET(constant_function(?LIST(S), to_external(E), []), NType);
- _ -> erlang:error(badarg, [S, E])
+ _ -> erlang:error(badarg)
end;
-constant_function(S, E) when ?IS_ORDSET(S) ->
- erlang:error(badarg, [S, E]).
+constant_function(S, _) when ?IS_ORDSET(S) ->
+ erlang:error(badarg).
-spec(is_equal(AnySet1, AnySet2) -> Bool when
AnySet1 :: anyset(),
@@ -514,17 +484,17 @@ constant_function(S, E) when ?IS_ORDSET(S) ->
is_equal(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case match_types(?TYPE(S1), ?TYPE(S2)) of
true -> ?LIST(S1) == ?LIST(S2);
- false -> erlang:error(type_mismatch, [S1, S2])
+ false -> erlang:error(type_mismatch)
end;
is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_ORDSET(S2) ->
case match_types(?ORDTYPE(S1), ?ORDTYPE(S2)) of
true -> ?ORDDATA(S1) == ?ORDDATA(S2);
- false -> erlang:error(type_mismatch, [S1, S2])
+ false -> erlang:error(type_mismatch)
end;
is_equal(S1, S2) when ?IS_SET(S1), ?IS_ORDSET(S2) ->
- erlang:error(type_mismatch, [S1, S2]);
+ erlang:error(type_mismatch);
is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_SET(S2) ->
- erlang:error(type_mismatch, [S1, S2]).
+ erlang:error(type_mismatch).
-spec(is_subset(Set1, Set2) -> Bool when
Bool :: boolean(),
@@ -533,7 +503,7 @@ is_equal(S1, S2) when ?IS_ORDSET(S1), ?IS_SET(S2) ->
is_subset(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
case match_types(?TYPE(S1), ?TYPE(S2)) of
true -> subset(?LIST(S1), ?LIST(S2));
- false -> erlang:error(type_mismatch, [S1, S2])
+ false -> erlang:error(type_mismatch)
end.
-spec(is_sofs_set(Term) -> Bool when
@@ -573,7 +543,7 @@ is_disjoint(S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
[] -> true;
[A | As] -> disjoint(?LIST(S2), A, As)
end;
- false -> erlang:error(type_mismatch, [S1, S2])
+ false -> erlang:error(type_mismatch)
end.
%%%
@@ -587,7 +557,7 @@ union(Sets) when ?IS_SET(Sets) ->
case ?TYPE(Sets) of
?SET_OF(Type) -> ?SET(lunion(?LIST(Sets)), Type);
?ANYTYPE -> Sets;
- _ -> erlang:error(badarg, [Sets])
+ _ -> erlang:error(badarg)
end.
-spec(intersection(SetOfSets) -> Set when
@@ -595,12 +565,12 @@ union(Sets) when ?IS_SET(Sets) ->
SetOfSets :: set_of_sets()).
intersection(Sets) when ?IS_SET(Sets) ->
case ?LIST(Sets) of
- [] -> erlang:error(badarg, [Sets]);
+ [] -> erlang:error(badarg);
[L | Ls] ->
case ?TYPE(Sets) of
?SET_OF(Type) ->
?SET(lintersection(Ls, L), Type);
- _ -> erlang:error(badarg, [Sets])
+ _ -> erlang:error(badarg)
end
end.
@@ -614,7 +584,7 @@ canonical_relation(Sets) when ?IS_SET(Sets) ->
?SET_OF(Type) ->
?SET(can_rel(?LIST(Sets), []), ?BINREL(Type, ST));
?ANYTYPE -> Sets;
- _ -> erlang:error(badarg, [Sets])
+ _ -> erlang:error(badarg)
end.
%%%
@@ -636,7 +606,7 @@ relation_to_family(R) when ?IS_SET(R) ->
?BINREL(DT, RT) ->
?SET(rel2family(?LIST(R)), ?FAMILY(DT, RT));
?ANYTYPE -> R;
- _Else -> erlang:error(badarg, [R])
+ _Else -> erlang:error(badarg)
end.
-spec(domain(BinRel) -> Set when
@@ -646,7 +616,7 @@ domain(R) when ?IS_SET(R) ->
case ?TYPE(R) of
?BINREL(DT, _) -> ?SET(dom(?LIST(R)), DT);
?ANYTYPE -> R;
- _Else -> erlang:error(badarg, [R])
+ _Else -> erlang:error(badarg)
end.
-spec(range(BinRel) -> Set when
@@ -656,7 +626,7 @@ range(R) when ?IS_SET(R) ->
case ?TYPE(R) of
?BINREL(_, RT) -> ?SET(ran(?LIST(R), []), RT);
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(field(BinRel) -> Set when
@@ -679,7 +649,7 @@ relative_product(RT) when is_tuple(RT) ->
relative_product(RL) when is_list(RL) ->
case relprod_n(RL, foo, false, false) of
{error, Reason} ->
- erlang:error(Reason, [RL]);
+ erlang:error(Reason);
Reply ->
Reply
end.
@@ -703,11 +673,11 @@ relative_product(RL, R) when is_list(RL), ?IS_SET(R) ->
EmptyR = case ?TYPE(R) of
?BINREL(_, _) -> ?LIST(R) =:= [];
?ANYTYPE -> true;
- _ -> erlang:error(badarg, [RL, R])
+ _ -> erlang:error(badarg)
end,
case relprod_n(RL, R, EmptyR, true) of
{error, Reason} ->
- erlang:error(Reason, [RL, R]);
+ erlang:error(Reason);
Reply ->
Reply
end.
@@ -720,18 +690,18 @@ relative_product1(R1, R2) when ?IS_SET(R1), ?IS_SET(R2) ->
{DTR1, RTR1} = case ?TYPE(R1) of
?BINREL(_, _) = R1T -> R1T;
?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
- _ -> erlang:error(badarg, [R1, R2])
+ _ -> erlang:error(badarg)
end,
{DTR2, RTR2} = case ?TYPE(R2) of
?BINREL(_, _) = R2T -> R2T;
?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
- _ -> erlang:error(badarg, [R1, R2])
+ _ -> erlang:error(badarg)
end,
case match_types(DTR1, DTR2) of
true when DTR1 =:= ?ANYTYPE -> R1;
true when DTR2 =:= ?ANYTYPE -> R2;
true -> ?SET(relprod(?LIST(R1), ?LIST(R2)), ?BINREL(RTR1, RTR2));
- false -> erlang:error(type_mismatch, [R1, R2])
+ false -> erlang:error(type_mismatch)
end.
-spec(converse(BinRel1) -> BinRel2 when
@@ -741,7 +711,7 @@ converse(R) when ?IS_SET(R) ->
case ?TYPE(R) of
?BINREL(DT, RT) -> ?SET(converse(?LIST(R), []), ?BINREL(RT, DT));
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(image(BinRel, Set1) -> Set2 when
@@ -755,10 +725,10 @@ image(R, S) when ?IS_SET(R), ?IS_SET(S) ->
true ->
?SET(usort(restrict(?LIST(S), ?LIST(R))), RT);
false ->
- erlang:error(type_mismatch, [R, S])
+ erlang:error(type_mismatch)
end;
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R, S])
+ _ -> erlang:error(badarg)
end.
-spec(inverse_image(BinRel, Set1) -> Set2 when
@@ -773,10 +743,10 @@ inverse_image(R, S) when ?IS_SET(R), ?IS_SET(S) ->
NL = restrict(?LIST(S), converse(?LIST(R), [])),
?SET(usort(NL), DT);
false ->
- erlang:error(type_mismatch, [R, S])
+ erlang:error(type_mismatch)
end;
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R, S])
+ _ -> erlang:error(badarg)
end.
-spec(strict_relation(BinRel1) -> BinRel2 when
@@ -787,7 +757,7 @@ strict_relation(R) when ?IS_SET(R) ->
Type = ?BINREL(_, _) ->
?SET(strict(?LIST(R), []), Type);
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(weak_relation(BinRel1) -> BinRel2 when
@@ -798,12 +768,12 @@ weak_relation(R) when ?IS_SET(R) ->
?BINREL(DT, RT) ->
case unify_types(DT, RT) of
[] ->
- erlang:error(badarg, [R]);
+ erlang:error(badarg);
Type ->
?SET(weak(?LIST(R)), ?BINREL(Type, Type))
end;
?ANYTYPE -> R;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(extension(BinRel1, Set, AnySet) -> BinRel2 when
@@ -816,7 +786,7 @@ extension(R, S, E) when ?IS_SET(R), ?IS_SET(S) ->
{T=?BINREL(DT, RT), ST, true} ->
case match_types(DT, ST) and match_types(RT, type(E)) of
false ->
- erlang:error(type_mismatch, [R, S, E]);
+ erlang:error(type_mismatch);
true ->
RL = ?LIST(R),
case extc([], ?LIST(S), to_external(E), RL) of
@@ -836,7 +806,7 @@ extension(R, S, E) when ?IS_SET(R), ?IS_SET(S) ->
?SET([], ?BINREL(ST, ET))
end;
{_, _, true} ->
- erlang:error(badarg, [R, S, E])
+ erlang:error(badarg)
end.
-spec(is_a_function(BinRel) -> Bool when
@@ -850,7 +820,7 @@ is_a_function(R) when ?IS_SET(R) ->
[{V,_} | Es] -> is_a_func(Es, V)
end;
?ANYTYPE -> true;
- _ -> erlang:error(badarg, [R])
+ _ -> erlang:error(badarg)
end.
-spec(restriction(BinRel1, Set) -> BinRel2 when
@@ -879,12 +849,12 @@ composite(Fn1, Fn2) when ?IS_SET(Fn1), ?IS_SET(Fn2) ->
?BINREL(DTF1, RTF1) = case ?TYPE(Fn1)of
?BINREL(_, _) = F1T -> F1T;
?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
- _ -> erlang:error(badarg, [Fn1, Fn2])
+ _ -> erlang:error(badarg)
end,
?BINREL(DTF2, RTF2) = case ?TYPE(Fn2) of
?BINREL(_, _) = F2T -> F2T;
?ANYTYPE -> {?ANYTYPE, ?ANYTYPE};
- _ -> erlang:error(badarg, [Fn1, Fn2])
+ _ -> erlang:error(badarg)
end,
case match_types(RTF1, DTF2) of
true when DTF1 =:= ?ANYTYPE -> Fn1;
@@ -894,9 +864,9 @@ composite(Fn1, Fn2) when ?IS_SET(Fn1), ?IS_SET(Fn2) ->
SL when is_list(SL) ->
?SET(sort(SL), ?BINREL(DTF1, RTF2));
Bad ->
- erlang:error(Bad, [Fn1, Fn2])
+ erlang:error(Bad)
end;
- false -> erlang:error(type_mismatch, [Fn1, Fn2])
+ false -> erlang:error(type_mismatch)
end.
-spec(inverse(Function1) -> Function2 when
@@ -909,10 +879,10 @@ inverse(Fn) when ?IS_SET(Fn) ->
SL when is_list(SL) ->
?SET(SL, ?BINREL(RT, DT));
Bad ->
- erlang:error(Bad, [Fn])
+ erlang:error(Bad)
end;
?ANYTYPE -> Fn;
- _ -> erlang:error(badarg, [Fn])
+ _ -> erlang:error(badarg)
end.
%%%
@@ -932,7 +902,7 @@ restriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
empty ->
R;
error ->
- erlang:error(badarg, [I, R, S]);
+ erlang:error(badarg);
Sort ->
RL = ?LIST(R),
case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of
@@ -945,7 +915,7 @@ restriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
{true, [E | Es]} ->
?SET(sort(restrict_n(I, keysort(I, RL), E, Es, [])), RT);
{false, _SL} ->
- erlang:error(type_mismatch, [I, R, S])
+ erlang:error(type_mismatch)
end
end;
restriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
@@ -963,28 +933,27 @@ restriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
NL = sort(restrict(?LIST(S2), converse(NSL, []))),
?SET(NL, Type1);
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end;
Bad ->
- erlang:error(Bad, [SetFun, S1, S2])
+ erlang:error(Bad)
end;
_ when Type1 =:= ?ANYTYPE ->
S1;
_XFun when ?IS_SET_OF(Type1) ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ erlang:error(badarg);
XFun ->
FunT = XFun(Type1),
- case catch check_fun(Type1, XFun, FunT) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ try check_fun(Type1, XFun, FunT) of
Sort ->
case match_types(FunT, Type2) of
true ->
R1 = inverse_substitution(SL1, XFun, Sort),
?SET(sort(Sort, restrict(?LIST(S2), R1)), Type1);
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1000,7 +969,7 @@ drestriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
empty ->
R;
error ->
- erlang:error(badarg, [I, R, S]);
+ erlang:error(badarg);
Sort ->
RL = ?LIST(R),
case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of
@@ -1013,7 +982,7 @@ drestriction(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
{true, [E | Es]} ->
?SET(diff_restrict_n(I, keysort(I, RL), E, Es, []), RT);
{false, _SL} ->
- erlang:error(type_mismatch, [I, R, S])
+ erlang:error(type_mismatch)
end
end;
drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
@@ -1032,20 +1001,18 @@ drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
NL = sort(diff_restrict(SL2, converse(NSL, []))),
?SET(NL, Type1);
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end;
Bad ->
- erlang:error(Bad, [SetFun, S1, S2])
+ erlang:error(Bad)
end;
_ when Type1 =:= ?ANYTYPE ->
S1;
_XFun when ?IS_SET_OF(Type1) ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ erlang:error(badarg);
XFun ->
FunT = XFun(Type1),
- case catch check_fun(Type1, XFun, FunT) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ try check_fun(Type1, XFun, FunT) of
Sort ->
case match_types(FunT, Type2) of
true ->
@@ -1053,8 +1020,9 @@ drestriction(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
SL2 = ?LIST(S2),
?SET(sort(Sort, diff_restrict(SL2, R1)), Type1);
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1068,7 +1036,7 @@ projection(I, Set) when is_integer(I), ?IS_SET(Set) ->
empty ->
Set;
error ->
- erlang:error(badarg, [I, Set]);
+ erlang:error(badarg);
_ when I =:= 1 ->
?SET(projection1(?LIST(Set)), ?REL_TYPE(I, Type));
_ ->
@@ -1087,7 +1055,7 @@ substitution(I, Set) when is_integer(I), ?IS_SET(Set) ->
empty ->
Set;
error ->
- erlang:error(badarg, [I, Set]);
+ erlang:error(badarg);
_Sort ->
NType = ?REL_TYPE(I, Type),
NSL = substitute_element(?LIST(Set), I, []),
@@ -1102,22 +1070,21 @@ substitution(SetFun, Set) when ?IS_SET(Set) ->
{SL, NewType} ->
?SET(reverse(SL), ?BINREL(Type, NewType));
Bad ->
- erlang:error(Bad, [SetFun, Set])
+ erlang:error(Bad)
end;
false ->
empty_set();
_ when Type =:= ?ANYTYPE ->
empty_set();
_XFun when ?IS_SET_OF(Type) ->
- erlang:error(badarg, [SetFun, Set]);
+ erlang:error(badarg);
XFun ->
FunT = XFun(Type),
- case catch check_fun(Type, XFun, FunT) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, Set]);
+ try check_fun(Type, XFun, FunT) of
_Sort ->
SL = substitute(L, XFun, []),
?SET(SL, ?BINREL(Type, FunT))
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1139,7 +1106,7 @@ partition(I, Set) when is_integer(I), ?IS_SET(Set) ->
empty ->
Set;
error ->
- erlang:error(badarg, [I, Set]);
+ erlang:error(badarg);
false -> % I =:= 1
?SET(partition_n(I, ?LIST(Set)), ?SET_OF(Type));
true ->
@@ -1161,7 +1128,7 @@ partition(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
empty ->
{R, R};
error ->
- erlang:error(badarg, [I, R, S]);
+ erlang:error(badarg);
Sort ->
RL = ?LIST(R),
case {match_types(?REL_TYPE(I, RT), ST), ?LIST(S)} of
@@ -1176,7 +1143,7 @@ partition(I, R, S) when is_integer(I), ?IS_SET(R), ?IS_SET(S) ->
[L1 | L2] = partition3_n(I, keysort(I,RL), E, Es, [], []),
{?SET(L1, RT), ?SET(L2, RT)};
{false, _SL} ->
- erlang:error(type_mismatch, [I, R, S])
+ erlang:error(type_mismatch)
end
end;
partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
@@ -1195,20 +1162,18 @@ partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
[L1 | L2] = partition3(?LIST(S2), R1),
{?SET(sort(L1), Type1), ?SET(sort(L2), Type1)};
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end;
Bad ->
- erlang:error(Bad, [SetFun, S1, S2])
+ erlang:error(Bad)
end;
_ when Type1 =:= ?ANYTYPE ->
{S1, S1};
_XFun when ?IS_SET_OF(Type1) ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ erlang:error(badarg);
XFun ->
FunT = XFun(Type1),
- case catch check_fun(Type1, XFun, FunT) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, S1, S2]);
+ try check_fun(Type1, XFun, FunT) of
Sort ->
case match_types(FunT, Type2) of
true ->
@@ -1216,8 +1181,9 @@ partition(SetFun, S1, S2) when ?IS_SET(S1), ?IS_SET(S2) ->
[L1 | L2] = partition3(?LIST(S2), R1),
{?SET(sort(L1), Type1), ?SET(sort(L2), Type1)};
false ->
- erlang:error(type_mismatch, [SetFun, S1, S2])
+ erlang:error(type_mismatch)
end
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1234,7 +1200,7 @@ multiple_relative_product(T, R) when is_tuple(T), ?IS_SET(R) ->
MProd = mul_relprod(tuple_to_list(T), 1, R),
relative_product(MProd);
false ->
- erlang:error(badarg, [T, R])
+ erlang:error(badarg)
end.
-spec(join(Relation1, I, Relation2, J) -> Relation3 when
@@ -1246,8 +1212,7 @@ multiple_relative_product(T, R) when is_tuple(T), ?IS_SET(R) ->
join(R1, I1, R2, I2)
when ?IS_SET(R1), ?IS_SET(R2), is_integer(I1), is_integer(I2) ->
case test_rel(R1, I1, lte) and test_rel(R2, I2, lte) of
- false ->
- erlang:error(badarg, [R1, I1, R2, I2]);
+ false -> erlang:error(badarg);
true when ?TYPE(R1) =:= ?ANYTYPE -> R1;
true when ?TYPE(R2) =:= ?ANYTYPE -> R2;
true ->
@@ -1294,7 +1259,7 @@ family_to_relation(F) when ?IS_SET(F) ->
?FAMILY(DT, RT) ->
?SET(family2rel(?LIST(F), []), ?BINREL(DT, RT));
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_specification(Fun, Family1) -> Family2 when
@@ -1314,10 +1279,10 @@ family_specification(Fun, F) when ?IS_SET(F) ->
SL when is_list(SL) ->
?SET(SL, FType);
Bad ->
- erlang:error(Bad, [Fun, F])
+ erlang:error(Bad)
end;
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [Fun, F])
+ _ -> erlang:error(badarg)
end.
-spec(union_of_family(Family) -> Set when
@@ -1328,7 +1293,7 @@ union_of_family(F) when ?IS_SET(F) ->
?FAMILY(_DT, Type) ->
?SET(un_of_fam(?LIST(F), []), Type);
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(intersection_of_family(Family) -> Set when
@@ -1341,9 +1306,9 @@ intersection_of_family(F) when ?IS_SET(F) ->
FU when is_list(FU) ->
?SET(FU, Type);
Bad ->
- erlang:error(Bad, [F])
+ erlang:error(Bad)
end;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_union(Family1) -> Family2 when
@@ -1354,7 +1319,7 @@ family_union(F) when ?IS_SET(F) ->
?FAMILY(DT, ?SET_OF(Type)) ->
?SET(fam_un(?LIST(F), []), ?FAMILY(DT, Type));
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_intersection(Family1) -> Family2 when
@@ -1367,10 +1332,10 @@ family_intersection(F) when ?IS_SET(F) ->
FU when is_list(FU) ->
?SET(FU, ?FAMILY(DT, Type));
Bad ->
- erlang:error(Bad, [F])
+ erlang:error(Bad)
end;
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_domain(Family1) -> Family2 when
@@ -1382,7 +1347,7 @@ family_domain(F) when ?IS_SET(F) ->
?SET(fam_dom(?LIST(F), []), ?FAMILY(FDT, DT));
?ANYTYPE -> F;
?FAMILY(_, ?ANYTYPE) -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_range(Family1) -> Family2 when
@@ -1394,7 +1359,7 @@ family_range(F) when ?IS_SET(F) ->
?SET(fam_ran(?LIST(F), []), ?FAMILY(DT, RT));
?ANYTYPE -> F;
?FAMILY(_, ?ANYTYPE) -> F;
- _ -> erlang:error(badarg, [F])
+ _ -> erlang:error(badarg)
end.
-spec(family_field(Family1) -> Family2 when
@@ -1428,12 +1393,12 @@ family_difference(F1, F2) ->
fam_binop(F1, F2, FF) when ?IS_SET(F1), ?IS_SET(F2) ->
case unify_types(?TYPE(F1), ?TYPE(F2)) of
[] ->
- erlang:error(type_mismatch, [F1, F2]);
+ erlang:error(type_mismatch);
?ANYTYPE ->
F1;
Type = ?FAMILY(_, _) ->
?SET(FF(?LIST(F1), ?LIST(F2), []), Type);
- _ -> erlang:error(badarg, [F1, F2])
+ _ -> erlang:error(badarg)
end.
-spec(partition_family(SetFun, Set) -> Family when
@@ -1446,7 +1411,7 @@ partition_family(I, Set) when is_integer(I), ?IS_SET(Set) ->
empty ->
Set;
error ->
- erlang:error(badarg, [I, Set]);
+ erlang:error(badarg);
false -> % when I =:= 1
?SET(fam_partition_n(I, ?LIST(Set)),
?BINREL(?REL_TYPE(I, Type), ?SET_OF(Type)));
@@ -1464,23 +1429,22 @@ partition_family(SetFun, Set) when ?IS_SET(Set) ->
P = fam_partition(converse(NSL, []), true),
?SET(reverse(P), ?BINREL(NewType, ?SET_OF(Type)));
Bad ->
- erlang:error(Bad, [SetFun, Set])
+ erlang:error(Bad)
end;
false ->
empty_set();
_ when Type =:= ?ANYTYPE ->
empty_set();
_XFun when ?IS_SET_OF(Type) ->
- erlang:error(badarg, [SetFun, Set]);
+ erlang:error(badarg);
XFun ->
DType = XFun(Type),
- case catch check_fun(Type, XFun, DType) of
- {'EXIT', _} ->
- erlang:error(badarg, [SetFun, Set]);
+ try check_fun(Type, XFun, DType) of
Sort ->
Ts = inverse_substitution(?LIST(Set), XFun, Sort),
P = fam_partition(Ts, Sort),
?SET(reverse(P), ?BINREL(DType, ?SET_OF(Type)))
+ catch _:_ -> erlang:error(badarg)
end
end.
@@ -1499,13 +1463,13 @@ family_projection(SetFun, F) when ?IS_SET(F) ->
{SL, NewType} ->
?SET(SL, ?BINREL(DT, NewType));
Bad ->
- erlang:error(Bad, [SetFun, F])
+ erlang:error(Bad)
end;
_ ->
- erlang:error(badarg, [SetFun, F])
+ erlang:error(badarg)
end;
?ANYTYPE -> F;
- _ -> erlang:error(badarg, [SetFun, F])
+ _ -> erlang:error(badarg)
end.
%%%
@@ -1519,7 +1483,7 @@ family_to_digraph(F) when ?IS_SET(F) ->
case ?TYPE(F) of
?FAMILY(_, _) -> fam2digraph(F, digraph:new());
?ANYTYPE -> digraph:new();
- _Else -> erlang:error(badarg, [F])
+ _Else -> erlang:error(badarg)
end.
-spec(family_to_digraph(Family, GraphType) -> Graph when
@@ -1530,27 +1494,27 @@ family_to_digraph(F, Type) when ?IS_SET(F) ->
case ?TYPE(F) of
?FAMILY(_, _) -> ok;
?ANYTYPE -> ok;
- _Else -> erlang:error(badarg, [F, Type])
+ _Else -> erlang:error(badarg)
end,
try digraph:new(Type) of
G -> case catch fam2digraph(F, G) of
{error, Reason} ->
true = digraph:delete(G),
- erlang:error(Reason, [F, Type]);
+ erlang:error(Reason);
_ ->
G
end
catch
- error:badarg -> erlang:error(badarg, [F, Type])
+ error:badarg -> erlang:error(badarg)
end.
-spec(digraph_to_family(Graph) -> Family when
Graph :: digraph:graph(),
Family :: family()).
digraph_to_family(G) ->
- case catch digraph_family(G) of
- {'EXIT', _} -> erlang:error(badarg, [G]);
+ try digraph_family(G) of
L -> ?SET(L, ?FAMILY(?ATOM_TYPE, ?ATOM_TYPE))
+ catch _:_ -> erlang:error(badarg)
end.
-spec(digraph_to_family(Graph, Type) -> Family when
@@ -1560,12 +1524,12 @@ digraph_to_family(G) ->
digraph_to_family(G, T) ->
case {is_type(T), T} of
{true, ?SET_OF(?FAMILY(_,_) = Type)} ->
- case catch digraph_family(G) of
- {'EXIT', _} -> erlang:error(badarg, [G, T]);
+ try digraph_family(G) of
L -> ?SET(L, Type)
+ catch _:_ -> erlang:error(badarg)
end;
_ ->
- erlang:error(badarg, [G, T])
+ erlang:error(badarg)
end.
%%
@@ -1713,14 +1677,15 @@ func_type([], SL, Type, F) ->
setify(L, ?SET_OF(Atom)) when ?IS_ATOM_TYPE(Atom), Atom =/= ?ANYTYPE ->
?SET(usort(L), Atom);
setify(L, ?SET_OF(Type0)) ->
- case catch is_no_lists(Type0) of
- {'EXIT', _} ->
- {?SET_OF(Type), Set} = create(L, Type0, Type0, []),
- ?SET(Set, Type);
+ try is_no_lists(Type0) of
N when is_integer(N) ->
- rel(L, N, Type0);
+ rel(L, N, Type0);
Sizes ->
make_oset(L, Sizes, L, Type0)
+ catch
+ _:_ ->
+ {?SET_OF(Type), Set} = create(L, Type0, Type0, []),
+ ?SET(Set, Type)
end;
setify(E, Type0) ->
{Type, OrdSet} = make_element(E, Type0, Type0),
diff --git a/lib/stdlib/src/stdlib.app.src b/lib/stdlib/src/stdlib.app.src
index 09176d2ca0..82ab484ea6 100644
--- a/lib/stdlib/src/stdlib.app.src
+++ b/lib/stdlib/src/stdlib.app.src
@@ -31,7 +31,6 @@
dets_server,
dets_sup,
dets_utils,
- dets_v8,
dets_v9,
dict,
digraph,
@@ -106,7 +105,7 @@
dets]},
{applications, [kernel]},
{env, []},
- {runtime_dependencies, ["sasl-3.0","kernel-5.0","erts-8.0","crypto-3.3",
+ {runtime_dependencies, ["sasl-3.0","kernel-5.0","erts-9.0","crypto-3.3",
"compiler-5.0"]}
]}.
diff --git a/lib/stdlib/src/stdlib.appup.src b/lib/stdlib/src/stdlib.appup.src
index 3aa4ec6dab..3c9e95e3a9 100644
--- a/lib/stdlib/src/stdlib.appup.src
+++ b/lib/stdlib/src/stdlib.appup.src
@@ -1,7 +1,7 @@
%% -*- erlang -*-
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -18,9 +18,7 @@
%% %CopyrightEnd%
{"%VSN%",
%% Up from - max one major revision back
- [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*
- {<<"2\\.[5-8](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-18.*
+ [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.*
%% Down to - max one major revision back
- [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}, % OTP-19.*
- {<<"2\\.[5-8](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-18.*
+ [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.*
}.
diff --git a/lib/stdlib/src/timer.erl b/lib/stdlib/src/timer.erl
index ca868627a9..df10790ea0 100644
--- a/lib/stdlib/src/timer.erl
+++ b/lib/stdlib/src/timer.erl
@@ -165,7 +165,7 @@ tc(F) ->
T1 = erlang:monotonic_time(),
Val = F(),
T2 = erlang:monotonic_time(),
- Time = erlang:convert_time_unit(T2 - T1, native, micro_seconds),
+ Time = erlang:convert_time_unit(T2 - T1, native, microsecond),
{Time, Val}.
%%
@@ -180,7 +180,7 @@ tc(F, A) ->
T1 = erlang:monotonic_time(),
Val = apply(F, A),
T2 = erlang:monotonic_time(),
- Time = erlang:convert_time_unit(T2 - T1, native, micro_seconds),
+ Time = erlang:convert_time_unit(T2 - T1, native, microsecond),
{Time, Val}.
%%
@@ -196,7 +196,7 @@ tc(M, F, A) ->
T1 = erlang:monotonic_time(),
Val = apply(M, F, A),
T2 = erlang:monotonic_time(),
- Time = erlang:convert_time_unit(T2 - T1, native, micro_seconds),
+ Time = erlang:convert_time_unit(T2 - T1, native, microsecond),
{Time, Val}.
%%
diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl
index 81f927f399..fadf96146e 100644
--- a/lib/stdlib/src/zip.erl
+++ b/lib/stdlib/src/zip.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
diff --git a/lib/stdlib/test/Makefile b/lib/stdlib/test/Makefile
index 28c35aed55..deac04aa66 100644
--- a/lib/stdlib/test/Makefile
+++ b/lib/stdlib/test/Makefile
@@ -52,6 +52,7 @@ MODULES= \
io_proto_SUITE \
lists_SUITE \
log_mf_h_SUITE \
+ math_SUITE \
ms_transform_SUITE \
proc_lib_SUITE \
qlc_SUITE \
diff --git a/lib/stdlib/test/base64_SUITE.erl b/lib/stdlib/test/base64_SUITE.erl
index d0abe5c961..6ddc67464c 100644
--- a/lib/stdlib/test/base64_SUITE.erl
+++ b/lib/stdlib/test/base64_SUITE.erl
@@ -82,7 +82,7 @@ base64_decode(Config) when is_list(Config) ->
Alphabet = list_to_binary(lists:seq(0, 255)),
Alphabet = base64:decode(base64:encode(Alphabet)),
- %% Encoded base 64 strings may be devided by non base 64 chars.
+ %% Encoded base 64 strings may be divided by non base 64 chars.
%% In this cases whitespaces.
"0123456789!@#0^&*();:<>,. []{}" =
base64:decode_to_string(
diff --git a/lib/stdlib/test/beam_lib_SUITE.erl b/lib/stdlib/test/beam_lib_SUITE.erl
index 4521ecc0ef..279e15f703 100644
--- a/lib/stdlib/test/beam_lib_SUITE.erl
+++ b/lib/stdlib/test/beam_lib_SUITE.erl
@@ -81,12 +81,8 @@ normal(Conf) when is_list(Conf) ->
NoOfTables = length(ets:all()),
P0 = pps(),
- CompileFlags = [{outdir,PrivDir}, debug_info],
- {ok,_} = compile:file(Source, CompileFlags),
- {ok, Binary} = file:read_file(BeamFile),
-
- do_normal(BeamFile),
- do_normal(Binary),
+ do_normal(Source, PrivDir, BeamFile, []),
+ do_normal(Source, PrivDir, BeamFile, [no_utf8_atoms]),
{ok,_} = compile:file(Source, [{outdir,PrivDir}, no_debug_info]),
{ok, {simple, [{abstract_code, no_abstract_code}]}} =
@@ -101,7 +97,15 @@ normal(Conf) when is_list(Conf) ->
true = (P0 == pps()),
ok.
-do_normal(BeamFile) ->
+do_normal(Source, PrivDir, BeamFile, Opts) ->
+ CompileFlags = [{outdir,PrivDir}, debug_info | Opts],
+ {ok,_} = compile:file(Source, CompileFlags),
+ {ok, Binary} = file:read_file(BeamFile),
+
+ do_normal(BeamFile, Opts),
+ do_normal(Binary, Opts).
+
+do_normal(BeamFile, Opts) ->
Imports = {imports, [{erlang, get_module_info, 1},
{erlang, get_module_info, 2},
{lists, member, 2}]},
@@ -130,20 +134,31 @@ do_normal(BeamFile) ->
beam_lib:chunks(BeamFile, [abstract_code]),
%% Test reading optional chunks.
- All = ["Atom", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT"],
+ All = ["Atom", "Code", "StrT", "ImpT", "ExpT", "FunT", "LitT", "AtU8"],
{ok,{simple,Chunks}} = beam_lib:chunks(BeamFile, All, [allow_missing_chunks]),
- verify_simple(Chunks).
+ case {verify_simple(Chunks),Opts} of
+ {{missing_chunk, AtomBin}, []} when is_binary(AtomBin) -> ok;
+ {{AtomBin, missing_chunk}, [no_utf8_atoms]} when is_binary(AtomBin) -> ok
+ end,
-verify_simple([{"Atom", AtomBin},
+ %% Make sure that reading the atom chunk works when the 'allow_missing_chunks'
+ %% option is used.
+ Some = ["Code",atoms,"ExpT","LitT"],
+ {ok,{simple,SomeChunks}} = beam_lib:chunks(BeamFile, Some, [allow_missing_chunks]),
+ [{"Code",<<_/binary>>},{atoms,[_|_]},{"ExpT",<<_/binary>>},{"LitT",missing_chunk}] =
+ SomeChunks.
+
+verify_simple([{"Atom", PlainAtomChunk},
{"Code", CodeBin},
{"StrT", StrBin},
{"ImpT", ImpBin},
{"ExpT", ExpBin},
{"FunT", missing_chunk},
- {"LitT", missing_chunk}])
- when is_binary(AtomBin), is_binary(CodeBin), is_binary(StrBin),
+ {"LitT", missing_chunk},
+ {"AtU8", AtU8Chunk}])
+ when is_binary(CodeBin), is_binary(StrBin),
is_binary(ImpBin), is_binary(ExpBin) ->
- ok.
+ {PlainAtomChunk, AtU8Chunk}.
%% Read invalid beam files.
error(Conf) when is_list(Conf) ->
@@ -211,7 +226,7 @@ last_chunk(Bin) ->
do_error(BeamFile, ACopy) ->
%% evil tests
Chunks = chunk_info(BeamFile),
- {value, {_, AtomStart, _}} = lists:keysearch("Atom", 1, Chunks),
+ {value, {_, AtomStart, _}} = lists:keysearch("AtU8", 1, Chunks),
{value, {_, ImportStart, _}} = lists:keysearch("ImpT", 1, Chunks),
{value, {_, AbstractStart, _}} = lists:keysearch("Abst", 1, Chunks),
{value, {_, AttributesStart, _}} =
@@ -234,7 +249,7 @@ do_error(BeamFile, ACopy) ->
verify(not_a_beam_file, beam_lib:info(BF7)),
BF8 = set_byte(ACopy, BeamFile, 13, 17),
- verify(missing_chunk, beam_lib:chunks(BF8, ["Atom"])),
+ verify(missing_chunk, beam_lib:chunks(BF8, ["AtU8"])),
BF9 = set_byte(ACopy, BeamFile, CompileInfoStart+10, 17),
verify(invalid_chunk, beam_lib:chunks(BF9, [compile_info])).
diff --git a/lib/stdlib/test/dets_SUITE.erl b/lib/stdlib/test/dets_SUITE.erl
index 8948f496c4..95c9b47465 100644
--- a/lib/stdlib/test/dets_SUITE.erl
+++ b/lib/stdlib/test/dets_SUITE.erl
@@ -35,26 +35,18 @@
-endif.
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,
- newly_started/1, basic_v8/1, basic_v9/1,
- open_v8/1, open_v9/1, sets_v8/1, sets_v9/1, bags_v8/1,
- bags_v9/1, duplicate_bags_v8/1, duplicate_bags_v9/1,
- access_v8/1, access_v9/1, dirty_mark/1, dirty_mark2/1,
- bag_next_v8/1, bag_next_v9/1, oldbugs_v8/1, oldbugs_v9/1,
- unsafe_assumptions/1, truncated_segment_array_v8/1,
- truncated_segment_array_v9/1, open_file_v8/1, open_file_v9/1,
- init_table_v8/1, init_table_v9/1, repair_v8/1, repair_v9/1,
- hash_v8b_v8c/1, phash/1, fold_v8/1, fold_v9/1, fixtable_v8/1,
- fixtable_v9/1, match_v8/1, match_v9/1, select_v8/1,
- select_v9/1, update_counter/1, badarg/1, cache_sets_v8/1,
- cache_sets_v9/1, cache_bags_v8/1, cache_bags_v9/1,
- cache_duplicate_bags_v8/1, cache_duplicate_bags_v9/1,
+ init_per_group/2,end_per_group/2, newly_started/1, basic/1,
+ open/1, sets/1, bags/1, duplicate_bags/1, access/1, dirty_mark/1,
+ dirty_mark2/1, bag_next/1, oldbugs/1,
+ truncated_segment_array/1, open_file/1, init_table/1, repair/1,
+ phash/1, fold/1, fixtable/1, match/1, select/1, update_counter/1,
+ badarg/1, cache_sets/1, cache_bags/1, cache_duplicate_bags/1,
otp_4208/1, otp_4989/1, many_clients/1, otp_4906/1, otp_5402/1,
simultaneous_open/1, insert_new/1, repair_continuation/1,
otp_5487/1, otp_6206/1, otp_6359/1, otp_4738/1, otp_7146/1,
otp_8070/1, otp_8856/1, otp_8898/1, otp_8899/1, otp_8903/1,
otp_8923/1, otp_9282/1, otp_11245/1, otp_11709/1, otp_13229/1,
- otp_13260/1]).
+ otp_13260/1, otp_13830/1]).
-export([dets_dirty_loop/0]).
@@ -73,8 +65,7 @@
-define(DETS_SERVER, dets).
-%% HEADSZ taken from dets_v8.erl and dets_v9.erl.
--define(HEADSZ_v8, 40).
+%% HEADSZ taken from dets_v9.erl.
-define(HEADSZ_v9, (56+28*4+16)).
-define(NO_KEYS_POS_v9, 36).
-define(CLOSED_PROPERLY_POS, 8).
@@ -94,24 +85,16 @@ suite() ->
all() ->
[
- basic_v8, basic_v9, open_v8, open_v9, sets_v8, sets_v9,
- bags_v8, bags_v9, duplicate_bags_v8, duplicate_bags_v9,
- newly_started, open_file_v8, open_file_v9,
- init_table_v8, init_table_v9, repair_v8, repair_v9,
- access_v8, access_v9, oldbugs_v8, oldbugs_v9,
- unsafe_assumptions, truncated_segment_array_v8,
- truncated_segment_array_v9, dirty_mark, dirty_mark2,
- bag_next_v8, bag_next_v9, hash_v8b_v8c, phash, fold_v8,
- fold_v9, fixtable_v8, fixtable_v9, match_v8, match_v9,
- select_v8, select_v9, update_counter, badarg,
- cache_sets_v8, cache_sets_v9, cache_bags_v8,
- cache_bags_v9, cache_duplicate_bags_v8,
- cache_duplicate_bags_v9, otp_4208, otp_4989,
+ basic, open, sets, bags, duplicate_bags, newly_started, open_file,
+ init_table, repair, access, oldbugs,
+ truncated_segment_array, dirty_mark, dirty_mark2, bag_next,
+ phash, fold, fixtable, match, select, update_counter, badarg,
+ cache_sets, cache_bags, cache_duplicate_bags, otp_4208, otp_4989,
many_clients, otp_4906, otp_5402, simultaneous_open,
insert_new, repair_continuation, otp_5487, otp_6206,
otp_6359, otp_4738, otp_7146, otp_8070, otp_8856, otp_8898,
otp_8899, otp_8903, otp_8923, otp_9282, otp_11245, otp_11709,
- otp_13229, otp_13260
+ otp_13229, otp_13260, otp_13830
].
groups() ->
@@ -137,20 +120,12 @@ newly_started(Config) when is_list(Config) ->
test_server:stop_node(Node),
ok.
-%% Basic test case.
-basic_v8(Config) when is_list(Config) ->
- basic(Config, 8).
-
-%% Basic test case.
-basic_v9(Config) when is_list(Config) ->
- basic(Config, 9).
-
-basic(Config, Version) ->
+basic(Config) when is_list(Config) ->
Tab = dets_basic_test,
FName = filename(Tab, Config),
P0 = pps(),
- {ok, _} = dets:open_file(Tab,[{file, FName},{version,Version}]),
+ {ok, _} = dets:open_file(Tab,[{file, FName}]),
ok = dets:insert(Tab,{mazda,japan}),
ok = dets:insert(Tab,{toyota,japan}),
ok = dets:insert(Tab,{suzuki,japan}),
@@ -174,13 +149,7 @@ basic(Config, Version) ->
ok.
-open_v8(Config) when is_list(Config) ->
- open(Config, 8).
-
-open_v9(Config) when is_list(Config) ->
- open(Config, 9).
-
-open(Config, Version) ->
+open(Config) when is_list(Config) ->
%% Running this test twice means that the Dets server is restarted
%% twice. dets_sup specifies a maximum of 4 restarts in an hour.
%% If this becomes a problem, one should consider running this
@@ -194,14 +163,14 @@ open(Config, Version) ->
Data = make_data(1),
P0 = pps(),
- Tabs = open_files(1, All, Version),
+ Tabs = open_files(1, All),
initialize(Tabs, Data),
check(Tabs, Data),
foreach(fun(Tab) -> ok = dets:close(Tab) end, Tabs),
%% Now reopen the files
?format("Reopening closed files \n", []),
- Tabs = open_files(1, All, Version),
+ Tabs = open_files(1, All),
?format("Checking contents of reopened files \n", []),
check(Tabs, Data),
%% crash the dets server
@@ -216,7 +185,7 @@ open(Config, Version) ->
%% Now reopen the files again
?format("Reopening crashed files \n", []),
- open_files(1, All, Version),
+ open_files(1, All),
?format("Checking contents of repaired files \n", []),
check(Tabs, Data),
@@ -266,20 +235,13 @@ bad(_Tab, _Item) ->
exit(badtab).
%% Perform traversal and match testing on set type dets tables.
-sets_v8(Config) when is_list(Config) ->
- sets(Config, 8).
-
-%% Perform traversal and match testing on set type dets tables.
-sets_v9(Config) when is_list(Config) ->
- sets(Config, 9).
-
-sets(Config, Version) ->
+sets(Config) when is_list(Config) ->
{Sets, _, _} = args(Config),
Data = make_data(1),
delete_files(Sets),
P0 = pps(),
- Tabs = open_files(1, Sets, Version),
+ Tabs = open_files(1, Sets),
Bigger = [{17,q,w,w}, {48,q,w,w,w,w,w,w}], % 48 requires a bigger buddy
initialize(Tabs, Data++Bigger++Data), % overwrite
Len = length(Data),
@@ -302,19 +264,12 @@ sets(Config, Version) ->
ok.
%% Perform traversal and match testing on bag type dets tables.
-bags_v8(Config) when is_list(Config) ->
- bags(Config, 8).
-
-%% Perform traversal and match testing on bag type dets tables.
-bags_v9(Config) when is_list(Config) ->
- bags(Config, 9).
-
-bags(Config, Version) ->
+bags(Config) when is_list(Config) ->
{_, Bags, _} = args(Config),
Data = make_data(1, bag), %% gives twice as many objects
delete_files(Bags),
P0 = pps(),
- Tabs = open_files(1, Bags, Version),
+ Tabs = open_files(1, Bags),
initialize(Tabs, Data++Data),
Len = length(Data),
foreach(fun(Tab) -> trav_test(Data, Len, Tab) end, Tabs),
@@ -336,19 +291,12 @@ bags(Config, Version) ->
%% Perform traversal and match testing on duplicate_bag type dets tables.
-duplicate_bags_v8(Config) when is_list(Config) ->
- duplicate_bags(Config, 8).
-
-%% Perform traversal and match testing on duplicate_bag type dets tables.
-duplicate_bags_v9(Config) when is_list(Config) ->
- duplicate_bags(Config, 9).
-
-duplicate_bags(Config, Version) when is_list(Config) ->
+duplicate_bags(Config) when is_list(Config) ->
{_, _, Dups} = args(Config),
Data = make_data(1, duplicate_bag), %% gives twice as many objects
delete_files(Dups),
P0 = pps(),
- Tabs = open_files(1, Dups, Version),
+ Tabs = open_files(1, Dups),
initialize(Tabs, Data),
Len = length(Data),
foreach(fun(Tab) -> trav_test(Data, Len, Tab) end, Tabs),
@@ -369,13 +317,7 @@ duplicate_bags(Config, Version) when is_list(Config) ->
ok.
-access_v8(Config) when is_list(Config) ->
- access(Config, 8).
-
-access_v9(Config) when is_list(Config) ->
- access(Config, 9).
-
-access(Config, Version) ->
+access(Config) when is_list(Config) ->
Args_acc = [[{ram_file, true}, {access, read}],
[{access, read}]],
Args = [[{ram_file, true}],
@@ -388,9 +330,9 @@ access(Config, Version) ->
P0 = pps(),
{error, {file_error,_,enoent}} = dets:open_file('1', hd(Args_acc_1)),
- Tabs = open_files(1, Args_1, Version),
+ Tabs = open_files(1, Args_1),
close_all(Tabs),
- Tabs = open_files(1, Args_acc_1, Version),
+ Tabs = open_files(1, Args_acc_1),
foreach(fun(Tab) ->
{error, {access_mode,_}} = dets:insert(Tab, {1,2}),
@@ -522,16 +464,12 @@ dets_dirty_loop() ->
%% Check that bags and next work as expected.
-bag_next_v8(Config) when is_list(Config) ->
- bag_next(Config, 8).
-
-%% Check that bags and next work as expected.
-bag_next_v9(Config) when is_list(Config) ->
+bag_next(Config) when is_list(Config) ->
Tab = dets_bag_next_test,
FName = filename(Tab, Config),
%% first and next crash upon error
- dets:open_file(Tab,[{file, FName}, {type, bag},{version,9}]),
+ dets:open_file(Tab,[{file, FName}, {type, bag}]),
ok = dets:insert(Tab, [{1,1},{2,2},{3,3},{4,4}]),
FirstKey = dets:first(Tab),
NextKey = dets:next(Tab, FirstKey),
@@ -548,13 +486,8 @@ bag_next_v9(Config) when is_list(Config) ->
dets:close(Tab),
file:delete(FName),
- bag_next(Config, 9).
-
-bag_next(Config, Version) ->
- Tab = dets_bag_next_test,
- FName = filename(Tab, Config),
P0 = pps(),
- dets:open_file(Tab,[{file, FName}, {type, bag},{version,Version}]),
+ dets:open_file(Tab,[{file, FName}, {type, bag}]),
dets:insert(Tab,{698,hopp}),
dets:insert(Tab,{186,hopp}),
dets:insert(Tab,{hej,hopp}),
@@ -578,17 +511,10 @@ bag_next(Config, Version) ->
check_pps(P0),
ok.
-oldbugs_v8(Config) when is_list(Config) ->
- oldbugs(Config, 8).
-
-oldbugs_v9(Config) when is_list(Config) ->
- oldbugs(Config, 9).
-
-oldbugs(Config, Version) ->
+oldbugs(Config) when is_list(Config) ->
FName = filename(dets_suite_oldbugs_test, Config),
P0 = pps(),
- {ok, ob} = dets:open_file(ob, [{version, Version},
- {type, bag}, {file, FName}]),
+ {ok, ob} = dets:open_file(ob, [{type, bag}, {file, FName}]),
ok = dets:insert(ob, {1, 2}),
ok = dets:insert(ob, {1,3}),
ok = dets:insert(ob, {1, 2}),
@@ -598,56 +524,19 @@ oldbugs(Config, Version) ->
check_pps(P0),
ok.
-%% Test that shrinking an object and then expanding it works.
-unsafe_assumptions(Config) when is_list(Config) ->
- FName = filename(dets_suite_unsafe_assumptions_test, Config),
- file:delete(FName),
- P0 = pps(),
- {ok, a} = dets:open_file(a, [{version,8},{file, FName}]),
- O0 = {2,false},
- O1 = {1, false},
- O2 = {1, true},
- O3 = {1, duplicate(20,false)},
- O4 = {1, duplicate(25,false)}, % same 2-log as O3
- ok = dets:insert(a, O1),
- ok = dets:insert(a, O0),
- true = [O1,O0] =:= sort(get_all_objects(a)),
- true = [O1,O0] =:= sort(get_all_objects_fast(a)),
- ok = dets:insert(a, O2),
- true = [O2,O0] =:= sort(get_all_objects(a)),
- true = [O2,O0] =:= sort(get_all_objects_fast(a)),
- ok = dets:insert(a, O3),
- true = [O3,O0] =:= sort(get_all_objects(a)),
- true = [O3,O0] =:= sort(get_all_objects_fast(a)),
- ok = dets:insert(a, O4),
- true = [O4,O0] =:= sort(get_all_objects(a)),
- true = [O4,O0] =:= sort(get_all_objects_fast(a)),
- ok = dets:close(a),
- file:delete(FName),
- check_pps(P0),
- ok.
-
-%% Test that a file where the segment array has been truncated
-%% is possible to repair.
-truncated_segment_array_v8(Config) when is_list(Config) ->
- trunc_seg_array(Config, 8).
-
%% Test that a file where the segment array has been truncated
%% is possible to repair.
-truncated_segment_array_v9(Config) when is_list(Config) ->
- trunc_seg_array(Config, 9).
-
-trunc_seg_array(Config, V) ->
+truncated_segment_array(Config) when is_list(Config) ->
TabRef = dets_suite_truncated_segment_array_test,
Fname = filename(TabRef, Config),
%% Create file that needs to be repaired
file:delete(Fname),
P0 = pps(),
- {ok, TabRef} = dets:open_file(TabRef, [{file, Fname},{version,V}]),
+ {ok, TabRef} = dets:open_file(TabRef, [{file, Fname}]),
ok = dets:close(TabRef),
%% Truncate the file
- HeadSize = headsz(V),
+ HeadSize = headsz(),
truncate(Fname, HeadSize + 10),
%% Open the truncated file
@@ -660,19 +549,13 @@ trunc_seg_array(Config, V) ->
ok.
%% Test open_file/1.
-open_file_v8(Config) when is_list(Config) ->
- open_1(Config, 8).
-
-%% Test open_file/1.
-open_file_v9(Config) when is_list(Config) ->
+open_file(Config) when is_list(Config) ->
T = open_v9,
Fname = filename(T, Config),
- {ok, _} = dets:open_file(T, [{file,Fname},{version,9}]),
- 9 = dets:info(T, version),
+ {ok, _} = dets:open_file(T, [{file,Fname}]),
+ 9 = dets:info(T, version), % Backwards compatibility.
true = [self()] =:= dets:info(T, users),
- {ok, _} = dets:open_file(T, [{file,Fname},{version,9}]),
- {error,incompatible_arguments} =
- dets:open_file(T, [{file,Fname},{version,8}]),
+ {ok, _} = dets:open_file(T, [{file,Fname}]),
true = [self(),self()] =:= dets:info(T, users),
ok = dets:close(T),
true = [self()] =:= dets:info(T, users),
@@ -680,9 +563,9 @@ open_file_v9(Config) when is_list(Config) ->
undefined = ets:info(T, users),
file:delete(Fname),
- open_1(Config, 9).
+ open_1(Config).
-open_1(Config, V) ->
+open_1(Config) ->
TabRef = open_file_1_test,
Fname = filename(TabRef, Config),
file:delete(Fname),
@@ -694,8 +577,8 @@ open_1(Config, V) ->
{error,{not_a_dets_file,Fname}} = dets:open_file(Fname),
file:delete(Fname),
- HeadSize = headsz(V),
- {ok, TabRef} = dets:open_file(TabRef, [{file, Fname},{version,V}]),
+ HeadSize = headsz(),
+ {ok, TabRef} = dets:open_file(TabRef, [{file, Fname}]),
ok = dets:close(TabRef),
truncate(Fname, HeadSize + 10),
true = dets:is_dets_file(Fname),
@@ -705,7 +588,7 @@ open_1(Config, V) ->
file:delete(Fname),
%% truncated file header, invalid type
- {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]),
+ {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]),
ok = ins(TabRef, 3000),
ok = dets:close(TabRef),
TypePos = 12,
@@ -714,7 +597,7 @@ open_1(Config, V) ->
truncate(Fname, HeadSize - 10),
{error,{not_a_dets_file,Fname}} = dets:open_file(Fname),
{error,{not_a_dets_file,Fname}} =
- dets:open_file(TabRef, [{file,Fname},{version,V}]),
+ dets:open_file(TabRef, [{file,Fname}]),
file:delete(Fname),
{error,{file_error,{foo,bar},_}} = dets:is_dets_file({foo,bar}),
@@ -722,35 +605,30 @@ open_1(Config, V) ->
ok.
%% Test initialize_table/2 and from_ets/2.
-init_table_v8(Config) when is_list(Config) ->
- init_table(Config, 8).
-
-%% Test initialize_table/2 and from_ets/2.
-init_table_v9(Config) when is_list(Config) ->
+init_table(Config) when is_list(Config) ->
%% Objects are returned in "time order".
T = init_table_v9,
Fname = filename(T, Config),
file:delete(Fname),
L = [{1,a},{2,b},{1,c},{2,c},{1,c},{2,a},{1,b}],
Input = init([L]),
- {ok, _} = dets:open_file(T, [{file,Fname},{version,9},
- {type,duplicate_bag}]),
+ {ok, _} = dets:open_file(T, [{file,Fname},{type,duplicate_bag}]),
ok = dets:init_table(T, Input),
[{1,a},{1,c},{1,c},{1,b}] = dets:lookup(T, 1),
[{2,b},{2,c},{2,a}] = dets:lookup(T, 2),
ok = dets:close(T),
file:delete(Fname),
- init_table(Config, 9),
+ init_table_1(Config),
fast_init_table(Config).
-init_table(Config, V) ->
+init_table_1(Config) ->
TabRef = init_table_test,
Fname = filename(TabRef, Config),
file:delete(Fname),
P0 = pps(),
- Args = [{file,Fname},{version,V},{auto_save,120000}],
+ Args = [{file,Fname},{auto_save,120000}],
{ok, _} = dets:open_file(TabRef, Args),
{'EXIT', _} =
(catch dets:init_table(TabRef, fun(foo) -> bar end)),
@@ -800,13 +678,13 @@ init_table(Config, V) ->
file:delete(Fname),
L1 = [[{1,a},{2,b}],[],[{3,c}],[{4,d}],[]],
- bulk_init(L1, set, 4, Config, V),
+ bulk_init(L1, set, 4, Config),
L2 = [[{1,a},{2,b}],[],[{2,q},{3,c}],[{4,d}],[{4,e},{2,q}]],
- bulk_init(L2, set, 4, Config, V),
- bulk_init(L2, bag, 6, Config, V),
- bulk_init(L2, duplicate_bag, 7, Config, V),
- bulk_init(L1, set, 4, 512, Config, V),
- bulk_init([], set, 0, 10000, Config, V),
+ bulk_init(L2, set, 4, Config),
+ bulk_init(L2, bag, 6, Config),
+ bulk_init(L2, duplicate_bag, 7, Config),
+ bulk_init(L1, set, 4, 512, Config),
+ bulk_init([], set, 0, 10000, Config),
file:delete(Fname),
%% Initiate a file that contains a lot of objects.
@@ -834,16 +712,16 @@ init_table(Config, V) ->
check_pps(P0),
ok.
-bulk_init(Ls, Type, N, Config, V) ->
- bulk_init(Ls, Type, N, 256, Config, V).
+bulk_init(Ls, Type, N, Config) ->
+ bulk_init(Ls, Type, N, 256, Config).
-bulk_init(Ls, Type, N, Est, Config, V) ->
+bulk_init(Ls, Type, N, Est, Config) ->
T = init_table_test,
Fname = filename(T, Config),
file:delete(Fname),
Input = init(Ls),
Args = [{ram_file,false}, {type,Type},{keypos,1},{file,Fname},
- {estimated_no_objects, Est},{version,V}],
+ {estimated_no_objects, Est}],
{ok, T} = dets:open_file(T, Args),
ok = dets:init_table(T, Input),
All = sort(get_all_objects(T)),
@@ -882,18 +760,17 @@ init_fun(I, N) ->
end.
fast_init_table(Config) ->
- V = 9,
TabRef = init_table_test,
Fname = filename(TabRef, Config),
file:delete(Fname),
P0 = pps(),
- Args = [{file,Fname},{version,V},{auto_save,120000}],
+ Args = [{file,Fname},{auto_save,120000}],
Source = init_table_test_source,
SourceFname = filename(Source, Config),
file:delete(SourceFname),
- SourceArgs = [{file,SourceFname},{version,V},{auto_save,120000}],
+ SourceArgs = [{file,SourceFname},{auto_save,120000}],
{ok, Source} = dets:open_file(Source, SourceArgs),
@@ -1015,13 +892,13 @@ fast_init_table(Config) ->
file:delete(SourceFname),
L1 = [{1,a},{2,b},{3,c},{4,d}],
- fast_bulk_init(L1, set, 4, 4, Config, V),
+ fast_bulk_init(L1, set, 4, 4, Config),
L2 = [{1,a},{2,b},{2,q},{3,c},{4,d},{4,e},{2,q}],
- fast_bulk_init(L2, set, 4, 4, Config, V),
- fast_bulk_init(L2, bag, 6, 4, Config, V),
- fast_bulk_init(L2, duplicate_bag, 7, 4, Config, V),
- fast_bulk_init(L1, set, 4, 4, 512, Config, V),
- fast_bulk_init([], set, 0, 0, 10000, Config, V),
+ fast_bulk_init(L2, set, 4, 4, Config),
+ fast_bulk_init(L2, bag, 6, 4, Config),
+ fast_bulk_init(L2, duplicate_bag, 7, 4, Config),
+ fast_bulk_init(L1, set, 4, 4, 512, Config),
+ fast_bulk_init([], set, 0, 0, 10000, Config),
file:delete(Fname),
%% Initiate a file that contains a lot of objects.
@@ -1112,16 +989,16 @@ fast_init_table(Config) ->
check_pps(P0),
ok.
-fast_bulk_init(L, Type, N, NoKeys, Config, V) ->
- fast_bulk_init(L, Type, N, NoKeys, 256, Config, V).
+fast_bulk_init(L, Type, N, NoKeys, Config) ->
+ fast_bulk_init(L, Type, N, NoKeys, 256, Config).
-fast_bulk_init(L, Type, N, NoKeys, Est, Config, V) ->
+fast_bulk_init(L, Type, N, NoKeys, Est, Config) ->
T = init_table_test,
Fname = filename(T, Config),
file:delete(Fname),
Args0 = [{ram_file,false}, {type,Type},{keypos,1},
- {estimated_no_objects, Est},{version,V}],
+ {estimated_no_objects, Est}],
Args = [{file,Fname} | Args0],
S = init_table_test_source,
SFname = filename(S, Config),
@@ -1189,35 +1066,7 @@ items(I, N, C, L) ->
items(I+1, N, C-1, [{I, item(I)} | L]).
%% Test open_file and repair.
-repair_v8(Config) when is_list(Config) ->
- repair(Config, 8).
-
-%% Test open_file and repair.
-repair_v9(Config) when is_list(Config) ->
- %% Convert from format 9 to format 8.
- T = convert_98,
- Fname = filename(T, Config),
- file:delete(Fname),
- {ok, _} = dets:open_file(T, [{file,Fname},{version,9},
- {type,duplicate_bag}]),
- 9 = dets:info(T, version),
- true = is_binary(dets:info(T, bchunk_format)),
- ok = dets:insert(T, [{1,a},{2,b},{1,c},{2,c},{1,c},{2,a},{1,b}]),
- dets:close(T),
- {error, {version_mismatch, _}} =
- dets:open_file(T, [{file,Fname},{version,8},{type,duplicate_bag}]),
- {ok, _} = dets:open_file(T, [{file,Fname},{version,8},
- {type,duplicate_bag},{repair,force}]),
- 8 = dets:info(T, version),
- true = undefined =:= dets:info(T, bchunk_format),
- [{1,a},{1,b},{1,c},{1,c}] = sort(dets:lookup(T, 1)),
- [{2,a},{2,b},{2,c}] = sort(dets:lookup(T, 2)),
- 7 = dets:info(T, no_objects),
- no_keys_test(T),
- _ = histogram(T, silent),
- ok = dets:close(T),
- file:delete(Fname),
-
+repair(Config) when is_list(Config) ->
%% The short lived format 9(a).
%% Not very throughly tested here.
A9 = a9,
@@ -1238,13 +1087,13 @@ repair_v9(Config) when is_list(Config) ->
ok = dets:close(A9),
file:delete(Version9aT),
- repair(Config, 9).
+ repair_1(Config).
-repair(Config, V) ->
+repair_1(Config) ->
TabRef = repair_test,
Fname = filename(TabRef, Config),
file:delete(Fname),
- HeadSize = headsz(V),
+ HeadSize = headsz(),
P0 = pps(),
{'EXIT', {badarg, _}} =
@@ -1255,7 +1104,7 @@ repair(Config, V) ->
dets:open_file(TabRef, [{file, Fname}, {access, read}]),
%% compacting, and some kind of test that free lists are saved OK on file
- {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]),
+ {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]),
0 = dets:info(TabRef, size),
ok = ins(TabRef, 30000),
ok = del(TabRef, 30000, 3),
@@ -1268,38 +1117,20 @@ repair(Config, V) ->
20000 = count_objects_quite_fast(Ref3), % actually a test of match
no_keys_test(Ref3),
ok = dets:close(Ref3),
- if
- V =:= 8 ->
- {ok, TabRef} = dets:open_file(TabRef,
- [{file, Fname},{version,V},{access,read}]),
- ok = dets:close(TabRef),
- io:format("Expect compacting repair:~n"),
- {ok, TabRef} = dets:open_file(TabRef,
- [{file, Fname},{version,V}]),
- 20000 = dets:info(TabRef, size),
- _ = histogram(TabRef, silent),
- ok = dets:close(TabRef);
- true ->
- ok
- end,
{error,{keypos_mismatch,Fname}} =
dets:open_file(TabRef, [{file, Fname},{keypos,17}]),
{error,{type_mismatch,Fname}} =
dets:open_file(TabRef, [{file, Fname},{type,duplicate_bag}]),
%% make one of the temporary files unwritable
- TmpFile = if
- V =:= 8 ->
- Fname ++ ".TMP.10000";
- true -> Fname ++ ".TMP.1"
- end,
+ TmpFile = Fname ++ ".TMP.1",
file:delete(TmpFile),
{ok, TmpFd} = file:open(TmpFile, [read,write]),
ok = file:close(TmpFd),
unwritable(TmpFile),
- {error,{file_error,TmpFile,eacces}} = dets:fsck(Fname, V),
+ {error,{file_error,TmpFile,eacces}} = dets:fsck(Fname),
{ok, _} = dets:open_file(TabRef,
- [{repair,false},{file, Fname},{version,V}]),
+ [{repair,false},{file, Fname}]),
20000 = length(get_all_objects(TabRef)),
_ = histogram(TabRef, silent),
20000 = length(get_all_objects_fast(TabRef)),
@@ -1318,68 +1149,15 @@ repair(Config, V) ->
file:delete(Fname),
%% truncated file header
- {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]),
+ {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]),
ok = ins(TabRef, 100),
ok = dets:close(TabRef),
file:delete(Fname),
- %% version bump (v8)
- Version7S = filename:join(?datadir(Config), "version_r2d.dets"),
- Version7T = filename('v2.dets', Config),
- {ok, _} = file:copy(Version7S, Version7T),
- {error,{version_bump, Version7T}} = dets:open_file(Version7T),
- {error,{version_bump, Version7T}} =
- dets:open_file(Version7T, [{file,Version7T},{repair,false}]),
- {error,{version_bump, Version7T}} =
- dets:open_file(Version7T, [{file, Version7T}, {access, read}]),
- io:format("Expect upgrade:~n"),
- {ok, _} = dets:open_file(Version7T,
- [{file, Version7T},{version, V}]),
- [{1,a},{2,b}] = sort(get_all_objects(Version7T)),
- [{1,a},{2,b}] = sort(get_all_objects_fast(Version7T)),
- Phash = if
- V =:= 8 -> phash;
- true -> phash2
- end,
- Phash = dets:info(Version7T, hash),
- _ = histogram(Version7T, silent),
- ok = dets:close(Version7T),
- {ok, _} = dets:open_file(Version7T, [{file, Version7T}]),
- Phash = dets:info(Version7T, hash),
- ok = dets:close(Version7T),
- file:delete(Version7T),
-
- %% converting free lists
- Version8aS = filename:join(?datadir(Config), "version_r3b02.dets"),
- Version8aT = filename('v3.dets', Config),
- {ok, _} = file:copy(Version8aS, Version8aT),
- %% min_no_slots and max_no_slots are ignored - no repair is taking place
- {ok, _} = dets:open_file(version_8a,
- [{file, Version8aT},{min_no_slots,1000},
- {max_no_slots,100000}]),
- [{1,b},{2,a},{a,1},{b,2}] = sort(get_all_objects(version_8a)),
- [{1,b},{2,a},{a,1},{b,2}] = sort(get_all_objects_fast(version_8a)),
- ok = ins(version_8a, 1000),
- 1002 = dets:info(version_8a, size),
- no_keys_test(version_8a),
- All8a = sort(get_all_objects(version_8a)),
- 1002 = length(All8a),
- FAll8a = sort(get_all_objects_fast(version_8a)),
- true = sort(All8a) =:= sort(FAll8a),
- ok = del(version_8a, 300, 3),
- 902 = dets:info(version_8a, size),
- no_keys_test(version_8a),
- All8a2 = sort(get_all_objects(version_8a)),
- 902 = length(All8a2),
- FAll8a2 = sort(get_all_objects_fast(version_8a)),
- true = sort(All8a2) =:= sort(FAll8a2),
- _ = histogram(version_8a, silent),
- ok = dets:close(version_8a),
- file:delete(Version8aT),
-
+ %% FIXME.
%% will fail unless the slots are properly sorted when repairing (v8)
BArgs = [{file, Fname},{type,duplicate_bag},
- {delayed_write,{3000,10000}},{version,V}],
+ {delayed_write,{3000,10000}}],
{ok, TabRef} = dets:open_file(TabRef, BArgs),
Seq = seq(1, 500),
Small = map(fun(X) -> {X,X} end, Seq),
@@ -1393,18 +1171,14 @@ repair(Config, V) ->
io:format("Expect forced repair:~n"),
{ok, _} =
dets:open_file(TabRef, [{repair,force},{min_no_slots,2000} | BArgs]),
- if
- V =:= 9 ->
- {MinNoSlots,_,MaxNoSlots} = dets:info(TabRef, no_slots),
- ok = dets:close(TabRef),
- io:format("Expect compaction:~n"),
- {ok, _} =
- dets:open_file(TabRef, [{repair,force},
- {min_no_slots,MinNoSlots},
- {max_no_slots,MaxNoSlots} | BArgs]);
- true ->
- ok
- end,
+
+ {MinNoSlots,_,MaxNoSlots} = dets:info(TabRef, no_slots),
+ ok = dets:close(TabRef),
+ io:format("Expect compaction:~n"),
+ {ok, _} =
+ dets:open_file(TabRef, [{repair,force},
+ {min_no_slots,MinNoSlots},
+ {max_no_slots,MaxNoSlots} | BArgs]),
All2 = get_all_objects(TabRef),
true = All =:= sort(All2),
FAll2 = get_all_objects_fast(TabRef),
@@ -1418,35 +1192,15 @@ repair(Config, V) ->
file:delete(Fname),
%% object bigger than segments, the "hole" is taken care of
- {ok, TabRef} = dets:open_file(TabRef, [{file, Fname},{version,V}]),
+ {ok, TabRef} = dets:open_file(TabRef, [{file, Fname}]),
Tuple = erlang:make_tuple(1000, foobar), % > 2 kB
ok = dets:insert(TabRef, Tuple),
%% at least one full segment (objects smaller than 2 kB):
ins(TabRef, 2000),
ok = dets:close(TabRef),
- if
- V =:= 8 ->
- %% first estimated number of objects is wrong, repair once more
- {ok, Fd} = file:open(Fname, [read,write]),
- NoPos = HeadSize - 8, % no_objects
- file:pwrite(Fd, NoPos, <<0:32>>), % NoItems
- ok = file:close(Fd),
- dets:fsck(Fname, V),
- {ok, _} =
- dets:open_file(TabRef,
- [{repair,false},{file, Fname},{version,V}]),
- 2001 = length(get_all_objects(TabRef)),
- _ = histogram(TabRef, silent),
- 2001 = length(get_all_objects_fast(TabRef)),
- ok = dets:close(TabRef);
- true ->
- ok
- end,
-
{ok, _} =
- dets:open_file(TabRef,
- [{repair,false},{file, Fname},{version,V}]),
+ dets:open_file(TabRef, [{repair,false},{file, Fname}]),
{ok, ObjPos} = dets:where(TabRef, {66,{item,number,66}}),
ok = dets:close(TabRef),
%% Damaged object.
@@ -1454,25 +1208,24 @@ repair(Config, V) ->
crash(Fname, ObjPos+Pos),
io:format(
"Expect forced repair (possibly after attempted compaction):~n"),
- {ok, _} =
- dets:open_file(TabRef, [{repair,force},{file, Fname},{version,V}]),
+ {ok, _} = dets:open_file(TabRef, [{repair,force},{file, Fname}]),
true = dets:info(TabRef, size) < 2001,
ok = dets:close(TabRef),
file:delete(Fname),
%% The file is smaller than the padded object.
- {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]),
+ {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]),
ok = dets:insert(TabRef, Tuple),
ok = dets:close(TabRef),
io:format("Expect forced repair or compaction:~n"),
{ok, _} =
- dets:open_file(TabRef, [{repair,force},{file, Fname},{version,V}]),
+ dets:open_file(TabRef, [{repair,force},{file, Fname}]),
true = 1 =:= dets:info(TabRef, size),
ok = dets:close(TabRef),
file:delete(Fname),
%% Damaged free lists.
- {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]),
+ {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]),
ok = ins(TabRef, 300),
ok = dets:sync(TabRef),
ok = del(TabRef, 300, 3),
@@ -1481,48 +1234,42 @@ repair(Config, V) ->
ok = dets:close(TabRef),
crash(Fname, FileSize+20),
%% Used to return bad_freelists, but that changed in OTP-9622
- {ok, TabRef} =
- dets:open_file(TabRef, [{file,Fname},{version,V}]),
+ {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]),
ok = dets:close(TabRef),
file:delete(Fname),
%% File not closed, opening with read and read_write access tried.
- {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]),
+ {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]),
ok = ins(TabRef, 300),
ok = dets:close(TabRef),
crash(Fname, ?CLOSED_PROPERLY_POS+3, ?NOT_PROPERLY_CLOSED),
{error, {not_closed, Fname}} =
- dets:open_file(foo, [{file,Fname},{version,V},{repair,force},
+ dets:open_file(foo, [{file,Fname},{repair,force},
{access,read}]),
{error, {not_closed, Fname}} =
- dets:open_file(foo, [{file,Fname},{version,V},{repair,true},
+ dets:open_file(foo, [{file,Fname},{repair,true},
{access,read}]),
io:format("Expect repair:~n"),
{ok, TabRef} =
- dets:open_file(TabRef, [{file,Fname},{version,V},{repair,true},
+ dets:open_file(TabRef, [{file,Fname},{repair,true},
{access,read_write}]),
ok = dets:close(TabRef),
crash(Fname, ?CLOSED_PROPERLY_POS+3, ?NOT_PROPERLY_CLOSED),
io:format("Expect forced repair:~n"),
{ok, TabRef} =
- dets:open_file(TabRef, [{file,Fname},{version,V},{repair,force},
+ dets:open_file(TabRef, [{file,Fname},{repair,force},
{access,read_write}]),
ok = dets:close(TabRef),
file:delete(Fname),
%% The size of an object is huge.
- {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{version,V}]),
+ {ok, TabRef} = dets:open_file(TabRef, [{file,Fname}]),
ok = dets:insert(TabRef, [{1,2,3},{2,3,4}]),
{ok, ObjPos2} = dets:where(TabRef, {1,2,3}),
ok = dets:close(TabRef),
- ObjPos3 = if
- V =:= 8 -> ObjPos2 + 4;
- V =:= 9 -> ObjPos2
- end,
- crash(Fname, ObjPos3, 255),
+ crash(Fname, ObjPos2, 255),
io:format("Expect forced repair:~n"),
- {ok, TabRef} =
- dets:open_file(TabRef, [{file,Fname},{version,V},{repair,force}]),
+ {ok, TabRef} = dets:open_file(TabRef, [{file,Fname},{repair,force}]),
ok = dets:close(TabRef),
file:delete(Fname),
@@ -1530,82 +1277,6 @@ repair(Config, V) ->
ok.
-%% Test the use of different hashing algorithms in v8b and v8c of the
-%% Dets file format.
-hash_v8b_v8c(Config) when is_list(Config) ->
- Source =
- filename:join(?datadir(Config), "dets_test_v8b.dets"),
- %% Little endian version of old file (there is an endianess bug in
- %% the old hash). This is all about version 8 of the dets file format.
-
- P0 = pps(),
- SourceLE =
- filename:join(?datadir(Config),
- "dets_test_v8b_little_endian.dets"),
- Target1 = filename('oldhash1.dets', Config),
- Target1LE = filename('oldhash1le.dets', Config),
- Target2 = filename('oldhash2.dets', Config),
- {ok, Bin} = file:read_file(Source),
- {ok, BinLE} = file:read_file(SourceLE),
- ok = file:write_file(Target1,Bin),
- ok = file:write_file(Target1LE,BinLE),
- ok = file:write_file(Target2,Bin),
- {ok, d1} = dets:open_file(d1,[{file,Target1}]),
- {ok, d1le} = dets:open_file(d1le,[{file,Target1LE}]),
- {ok, d2} = dets:open_file(d2,[{file,Target2},{repair,force},
- {version,8}]),
- FF = fun(N,_F,_T) when N > 16#FFFFFFFFFFFFFFFF ->
- ok;
- (N,F,T) ->
- V = integer_to_list(N),
- case dets:lookup(T,N) of
- [{N,V}] ->
- F(N*2,F,T);
- _Error ->
- exit({failed,{lookup,T,N}})
- end
- end,
- Mess = case (catch FF(1,FF,d1)) of
- {'EXIT', {failed, {lookup,_,_}}} ->
- ok = dets:close(d1),
- FF(1,FF,d1le),
- hash = dets:info(d1le,hash),
- dets:insert(d1le,{33333333333,hejsan}),
- [{33333333333,hejsan}] =
- dets:lookup(d1le,33333333333),
- ok = dets:close(d1le),
- {ok, d1le} = dets:open_file(d1le,
- [{file,Target1LE}]),
- [{33333333333,hejsan}] =
- dets:lookup(d1le,33333333333),
- FF(1,FF,d1le),
- ok = dets:close(d1le),
- "Seems to be a little endian machine";
- {'EXIT', Fault} ->
- exit(Fault);
- _ ->
- ok = dets:close(d1le),
- hash = dets:info(d1,hash),
- dets:insert(d1,{33333333333,hejsan}),
- [{33333333333,hejsan}] =
- dets:lookup(d1,33333333333),
- ok = dets:close(d1),
- {ok, d1} = dets:open_file(d1,[{file,Target1}]),
- [{33333333333,hejsan}] =
- dets:lookup(d1,33333333333),
- FF(1,FF,d1),
- ok = dets:close(d1),
- "Seems to be a big endian machine"
- end,
- FF(1,FF,d2),
- phash = dets:info(d2,hash),
- ok = dets:close(d2),
- file:delete(Target1),
- file:delete(Target1LE),
- file:delete(Target2),
- check_pps(P0),
- {comment, Mess}.
-
%% Test version 9(b) with erlang:phash/2 as hash function.
phash(Config) when is_list(Config) ->
T = phash,
@@ -1643,9 +1314,10 @@ phash(Config) when is_list(Config) ->
ok = dets:close(T),
%% One cannot use the bchunk format when copying between a phash
- %% table and a phash2 table. (There is no test for the case an R9
- %% (or later) node (using phash2) copies a table to an R8 node
- %% (using phash).) See also the comment on HASH_PARMS in dets_v9.erl.
+ %% table and a phash2 table. (There is no test for the case an
+ %% Erlang/OTP R9 (or later) node (using phash2) copies a table to
+ %% an Erlang/OTP R8 node (using phash).) See also the comment on
+ %% HASH_PARMS in dets_v9.erl.
{ok, _} = file:copy(Phash_v9bS, Fname),
{ok, T} = dets:open_file(T, [{file, Fname}]),
Type = dets:info(T, type),
@@ -1653,7 +1325,7 @@ phash(Config) when is_list(Config) ->
Input = init_bchunk(T),
T2 = phash_table,
Fname2 = filename(T2, Config),
- Args = [{type,Type},{keypos,KeyPos},{version,9},{file,Fname2}],
+ Args = [{type,Type},{keypos,KeyPos},{file,Fname2}],
{ok, T2} = dets:open_file(T2, Args),
{error, {init_fun, _}} =
dets:init_table(T2, Input, {format,bchunk}),
@@ -1665,21 +1337,14 @@ phash(Config) when is_list(Config) ->
ok.
%% Test foldl, foldr, to_ets.
-fold_v8(Config) when is_list(Config) ->
- fold(Config, 8).
-
-%% Test foldl, foldr, to_ets.
-fold_v9(Config) when is_list(Config) ->
- fold(Config, 9).
-
-fold(Config, Version) ->
+fold(Config) when is_list(Config) ->
T = test_table,
N = 100,
Fname = filename(T, Config),
file:delete(Fname),
P0 = pps(),
- Args = [{version, Version}, {file,Fname}, {estimated_no_objects, N}],
+ Args = [{file,Fname}, {estimated_no_objects, N}],
{ok, _} = dets:open_file(T, Args),
ok = ins(T, N),
@@ -1721,10 +1386,7 @@ fold(Config, Version) ->
ok = dets:close(T),
%% Damaged object.
- Pos = if
- Version =:= 8 -> 12;
- Version =:= 9 -> 8
- end,
+ Pos = 8,
crash(Fname, ObjPos+Pos),
{ok, _} = dets:open_file(T, Args),
io:format("Expect corrupt table:~n"),
@@ -1738,18 +1400,11 @@ fold(Config, Version) ->
ok.
%% Add objects to a fixed table.
-fixtable_v8(Config) when is_list(Config) ->
- fixtable(Config, 8).
-
-%% Add objects to a fixed table.
-fixtable_v9(Config) when is_list(Config) ->
- fixtable(Config, 9).
-
-fixtable(Config, Version) when is_list(Config) ->
+fixtable(Config) when is_list(Config) ->
T = fixtable,
Fname = filename(fixtable, Config),
file:delete(Fname),
- Args = [{version,Version},{file,Fname}],
+ Args = [{file,Fname}],
P0 = pps(),
{ok, _} = dets:open_file(T, Args),
@@ -1832,21 +1487,13 @@ fixtable(Config, Version) when is_list(Config) ->
ok.
%% Matching objects of a fixed table.
-match_v8(Config) when is_list(Config) ->
- match(Config, 8).
-
-%% Matching objects of a fixed table.
-match_v9(Config) when is_list(Config) ->
- match(Config, 9).
-
-match(Config, Version) ->
+match(Config) when is_list(Config) ->
T = match,
Fname = filename(match, Config),
file:delete(Fname),
P0 = pps(),
- Args = [{version, Version}, {file,Fname}, {type, duplicate_bag},
- {estimated_no_objects,550}],
+ Args = [{file,Fname}, {type, duplicate_bag}, {estimated_no_objects,550}],
{ok, _} = dets:open_file(T, Args),
ok = dets:insert(T, {1, a, b}),
ok = dets:insert(T, {1, b, a}),
@@ -1901,7 +1548,7 @@ match(Config, Version) ->
{_, TmpCont} = dets:match_object(T, '_', 200),
{_, TmpCont1} = dets:match_object(TmpCont),
{TTL, _} = dets:match_object(TmpCont1),
- DI = if Version =:= 8 -> last(TTL); Version =:= 9 -> hd(TTL) end,
+ DI = hd(TTL),
dets:safe_fixtable(T, true),
{L1, C20} = dets:match_object(T, '_', 200),
true = 200 =< length(L1),
@@ -1957,8 +1604,7 @@ match(Config, Version) ->
ok = dets:close(T),
%% Damaged size of object.
- %% In v8, there is a next pointer before the size.
- CrashPos = if Version =:= 8 -> 5; Version =:= 9 -> 1 end,
+ CrashPos = 1,
crash(Fname, ObjPos2+CrashPos),
{ok, _} = dets:open_file(T, Args),
case dets:insert_new(T, Obj) of % OTP-12024
@@ -1986,7 +1632,7 @@ match(Config, Version) ->
ok = dets:close(T),
%% match_delete finds an error
- CrashPos3 = if Version =:= 8 -> 12; Version =:= 9 -> 16 end,
+ CrashPos3 = 16,
crash(Fname, ObjPos3+CrashPos3),
{ok, _} = dets:open_file(T, Args),
bad_object(dets:match_delete(T, Spec), Fname),
@@ -2008,21 +1654,13 @@ match(Config, Version) ->
ok.
%% Selecting objects of a fixed table.
-select_v8(Config) when is_list(Config) ->
- select(Config, 8).
-
-%% Selecting objects of a fixed table.
-select_v9(Config) when is_list(Config) ->
- select(Config, 9).
-
-select(Config, Version) ->
+select(Config) when is_list(Config) ->
T = select,
Fname = filename(select, Config),
file:delete(Fname),
P0 = pps(),
- Args = [{version,Version}, {file,Fname}, {type, duplicate_bag},
- {estimated_no_objects,550}],
+ Args = [{file,Fname}, {type, duplicate_bag},{estimated_no_objects,550}],
{ok, _} = dets:open_file(T, Args),
ok = dets:insert(T, {1, a, b}),
ok = dets:insert(T, {1, b, a}),
@@ -2074,7 +1712,7 @@ select(Config, Version) ->
{_, TmpCont} = dets:match_object(T, '_', 200),
{_, TmpCont1} = dets:match_object(TmpCont),
{TTL, _} = dets:match_object(TmpCont1),
- DI = if Version =:= 8 -> last(TTL); Version =:= 9 -> hd(TTL) end,
+ DI = hd(TTL),
dets:safe_fixtable(T, true),
{L1, C20} = dets:select(T, AllSpec, 200),
true = 200 =< length(L1),
@@ -2281,28 +1919,21 @@ badarg(Config) when is_list(Config) ->
ok.
%% Test the write cache for sets.
-cache_sets_v8(Config) when is_list(Config) ->
- cache_sets(Config, 8).
-
-%% Test the write cache for sets.
-cache_sets_v9(Config) when is_list(Config) ->
- cache_sets(Config, 9).
-
-cache_sets(Config, Version) ->
+cache_sets(Config) when is_list(Config) ->
Small = 2,
- cache_sets(Config, {0,0}, false, Small, Version),
- cache_sets(Config, {0,0}, true, Small, Version),
- cache_sets(Config, {5000,5000}, false, Small, Version),
- cache_sets(Config, {5000,5000}, true, Small, Version),
+ cache_sets(Config, {0,0}, false, Small),
+ cache_sets(Config, {0,0}, true, Small),
+ cache_sets(Config, {5000,5000}, false, Small),
+ cache_sets(Config, {5000,5000}, true, Small),
%% Objects of size greater than 2 kB.
Big = 1200,
- cache_sets(Config, {0,0}, false, Big, Version),
- cache_sets(Config, {0,0}, true, Big, Version),
- cache_sets(Config, {5000,5000}, false, Big, Version),
- cache_sets(Config, {5000,5000}, true, Big, Version),
+ cache_sets(Config, {0,0}, false, Big),
+ cache_sets(Config, {0,0}, true, Big),
+ cache_sets(Config, {5000,5000}, false, Big),
+ cache_sets(Config, {5000,5000}, true, Big),
ok.
-cache_sets(Config, DelayedWrite, Extra, Sz, Version) ->
+cache_sets(Config, DelayedWrite, Extra, Sz) ->
%% Extra = bool(). Insert tuples until the tested key is not alone.
%% Sz = integer(). Size of the inserted tuples.
@@ -2311,9 +1942,8 @@ cache_sets(Config, DelayedWrite, Extra, Sz, Version) ->
file:delete(Fname),
P0 = pps(),
- {ok, _} =
- dets:open_file(T,[{version, Version}, {file,Fname}, {type,set},
- {delayed_write, DelayedWrite}]),
+ {ok, _} = dets:open_file(T,[{file,Fname}, {type,set},
+ {delayed_write, DelayedWrite}]),
Dups = 1,
{Key, OtherKeys} =
@@ -2430,28 +2060,21 @@ cache_sets(Config, DelayedWrite, Extra, Sz, Version) ->
ok.
%% Test the write cache for bags.
-cache_bags_v8(Config) when is_list(Config) ->
- cache_bags(Config, 8).
-
-%% Test the write cache for bags.
-cache_bags_v9(Config) when is_list(Config) ->
- cache_bags(Config, 9).
-
-cache_bags(Config, Version) ->
+cache_bags(Config) when is_list(Config) ->
Small = 2,
- cache_bags(Config, {0,0}, false, Small, Version),
- cache_bags(Config, {0,0}, true, Small, Version),
- cache_bags(Config, {5000,5000}, false, Small, Version),
- cache_bags(Config, {5000,5000}, true, Small, Version),
+ cache_bags(Config, {0,0}, false, Small),
+ cache_bags(Config, {0,0}, true, Small),
+ cache_bags(Config, {5000,5000}, false, Small),
+ cache_bags(Config, {5000,5000}, true, Small),
%% Objects of size greater than 2 kB.
Big = 1200,
- cache_bags(Config, {0,0}, false, Big, Version),
- cache_bags(Config, {0,0}, true, Big, Version),
- cache_bags(Config, {5000,5000}, false, Big, Version),
- cache_bags(Config, {5000,5000}, true, Big, Version),
+ cache_bags(Config, {0,0}, false, Big),
+ cache_bags(Config, {0,0}, true, Big),
+ cache_bags(Config, {5000,5000}, false, Big),
+ cache_bags(Config, {5000,5000}, true, Big),
ok.
-cache_bags(Config, DelayedWrite, Extra, Sz, Version) ->
+cache_bags(Config, DelayedWrite, Extra, Sz) ->
%% Extra = bool(). Insert tuples until the tested key is not alone.
%% Sz = integer(). Size of the inserted tuples.
@@ -2460,9 +2083,8 @@ cache_bags(Config, DelayedWrite, Extra, Sz, Version) ->
file:delete(Fname),
P0 = pps(),
- {ok, _} =
- dets:open_file(T,[{version, Version}, {file,Fname}, {type,bag},
- {delayed_write, DelayedWrite}]),
+ {ok, _} = dets:open_file(T,[{file,Fname}, {type,bag},
+ {delayed_write, DelayedWrite}]),
Dups = 1,
{Key, OtherKeys} =
@@ -2588,8 +2210,7 @@ cache_bags(Config, DelayedWrite, Extra, Sz, Version) ->
R1 = {index_test,1,2,3,4},
R2 = {index_test,2,2,13,14},
R3 = {index_test,1,12,13,14},
- {ok, _} = dets:open_file(T,[{version,Version},{type,bag},
- {keypos,2},{file,Fname}]),
+ {ok, _} = dets:open_file(T,[{type,bag}, {keypos,2},{file,Fname}]),
ok = dets:insert(T,R1),
ok = dets:sync(T),
ok = dets:insert(T,R2),
@@ -2606,27 +2227,20 @@ cache_bags(Config, DelayedWrite, Extra, Sz, Version) ->
ok.
%% Test the write cache for duplicate bags.
-cache_duplicate_bags_v8(Config) when is_list(Config) ->
- cache_duplicate_bags(Config, 8).
-
-%% Test the write cache for duplicate bags.
-cache_duplicate_bags_v9(Config) when is_list(Config) ->
- cache_duplicate_bags(Config, 9).
-
-cache_duplicate_bags(Config, Version) ->
+cache_duplicate_bags(Config) when is_list(Config) ->
Small = 2,
- cache_dup_bags(Config, {0,0}, false, Small, Version),
- cache_dup_bags(Config, {0,0}, true, Small, Version),
- cache_dup_bags(Config, {5000,5000}, false, Small, Version),
- cache_dup_bags(Config, {5000,5000}, true, Small, Version),
+ cache_dup_bags(Config, {0,0}, false, Small),
+ cache_dup_bags(Config, {0,0}, true, Small),
+ cache_dup_bags(Config, {5000,5000}, false, Small),
+ cache_dup_bags(Config, {5000,5000}, true, Small),
%% Objects of size greater than 2 kB.
Big = 1200,
- cache_dup_bags(Config, {0,0}, false, Big, Version),
- cache_dup_bags(Config, {0,0}, true, Big, Version),
- cache_dup_bags(Config, {5000,5000}, false, Big, Version),
- cache_dup_bags(Config, {5000,5000}, true, Big, Version).
+ cache_dup_bags(Config, {0,0}, false, Big),
+ cache_dup_bags(Config, {0,0}, true, Big),
+ cache_dup_bags(Config, {5000,5000}, false, Big),
+ cache_dup_bags(Config, {5000,5000}, true, Big).
-cache_dup_bags(Config, DelayedWrite, Extra, Sz, Version) ->
+cache_dup_bags(Config, DelayedWrite, Extra, Sz) ->
%% Extra = bool(). Insert tuples until the tested key is not alone.
%% Sz = integer(). Size of the inserted tuples.
@@ -2635,10 +2249,8 @@ cache_dup_bags(Config, DelayedWrite, Extra, Sz, Version) ->
file:delete(Fname),
P0 = pps(),
- {ok, _} =
- dets:open_file(T,[{version, Version}, {file,Fname},
- {type,duplicate_bag},
- {delayed_write, DelayedWrite}]),
+ {ok, _} = dets:open_file(T,[{file,Fname}, {type,duplicate_bag},
+ {delayed_write, DelayedWrite}]),
Dups = 2,
{Key, OtherKeys} =
@@ -2869,7 +2481,7 @@ otp_8899(Config) when is_list(Config) ->
Server = self(),
file:delete(FName),
- {ok, _} = dets:open_file(Tab,[{file, FName},{version,9}]),
+ {ok, _} = dets:open_file(Tab,[{file, FName}]),
[P1,P2,P3,P4] = new_clients(4, Tab),
MC = [Tab],
@@ -2895,7 +2507,7 @@ many_clients(Config) when is_list(Config) ->
file:delete(FName),
P0 = pps(),
- {ok, _} = dets:open_file(Tab,[{file, FName},{version,9}]),
+ {ok, _} = dets:open_file(Tab,[{file, FName}]),
[P1,P2,P3,P4] = new_clients(4, Tab),
%% dets:init_table/2 is used for making sure that all processes
@@ -2954,14 +2566,14 @@ many_clients(Config) when is_list(Config) ->
file:delete(FName),
%% Check that errors are handled correctly by the streaming operators.
- {ok, _} = dets:open_file(Tab,[{file, FName},{version,9}]),
+ {ok, _} = dets:open_file(Tab,[{file, FName}]),
ok = ins(Tab, 100),
Obj = {66,{item,number,66}},
{ok, ObjPos} = dets:where(Tab, Obj),
ok = dets:close(Tab),
%% Damaged object.
crash(FName, ObjPos+12),
- {ok, _} = dets:open_file(Tab,[{file, FName},{version,9}]),
+ {ok, _} = dets:open_file(Tab,[{file, FName}]),
BadObject1 = dets:lookup_keys(Tab, [65,66,67,68,69]),
bad_object(BadObject1, FName),
_Error = dets:close(Tab),
@@ -3400,8 +3012,13 @@ repair_continuation(Config) ->
MS = [{'_',[],[true]}],
- {[true], C1} = dets:select(Tab, MS, 1),
- C2 = binary_to_term(term_to_binary(C1)),
+ SRes = term_to_binary(dets:select(Tab, MS, 1)),
+ %% Get rid of compiled match spec
+ lists:foreach(fun (P) ->
+ garbage_collect(P)
+ end, processes()),
+ {[true], C2} = binary_to_term(SRes),
+
{'EXIT', {badarg, _}} = (catch dets:select(C2)),
C3 = dets:repair_continuation(C2, MS),
{[true], C4} = dets:select(C3),
@@ -3415,18 +3032,13 @@ repair_continuation(Config) ->
%% OTP-5487. Growth of read-only table (again).
otp_5487(Config) ->
- otp_5487(Config, 9),
- otp_5487(Config, 8),
- ok.
-
-otp_5487(Config, Version) ->
Tab = otp_5487,
Fname = filename(otp_5487, Config),
file:delete(Fname),
Ets = ets:new(otp_5487, [public, set]),
lists:foreach(fun(I) -> ets:insert(Ets, {I,I+1}) end,
lists:seq(0,1000)),
- {ok, _} = dets:open_file(Tab, [{file,Fname},{version,Version}]),
+ {ok, _} = dets:open_file(Tab, [{file,Fname}]),
ok = dets:from_ets(Tab, Ets),
ok = dets:sync(Tab),
ok = dets:close(Tab),
@@ -3470,14 +3082,12 @@ otp_6359(Config) ->
%% OTP-4738. ==/2 and =:=/2.
otp_4738(Config) ->
- %% Version 8 has not been corrected.
- %% (The constant -12857447 is for version 9 only.)
- otp_4738_set(9, Config),
- otp_4738_bag(9, Config),
- otp_4738_dupbag(9, Config),
+ otp_4738_set(Config),
+ otp_4738_bag(Config),
+ otp_4738_dupbag(Config),
ok.
-otp_4738_dupbag(Version, Config) ->
+otp_4738_dupbag(Config) ->
Tab = otp_4738,
File = filename(Tab, Config),
file:delete(File),
@@ -3485,7 +3095,7 @@ otp_4738_dupbag(Version, Config) ->
F = float(I),
One = 1,
FOne = float(One),
- Args = [{file,File},{type,duplicate_bag},{version,Version}],
+ Args = [{file,File},{type,duplicate_bag}],
{ok, Tab} = dets:open_file(Tab, Args),
ok = dets:insert(Tab, [{I,One},{F,One},{I,FOne},{F,FOne}]),
ok = dets:sync(Tab),
@@ -3530,7 +3140,7 @@ otp_4738_dupbag(Version, Config) ->
file:delete(File),
ok.
-otp_4738_bag(Version, Config) ->
+otp_4738_bag(Config) ->
Tab = otp_4738,
File = filename(Tab, Config),
file:delete(File),
@@ -3538,7 +3148,7 @@ otp_4738_bag(Version, Config) ->
F = float(I),
One = 1,
FOne = float(One),
- Args = [{file,File},{type,bag},{version,Version}],
+ Args = [{file,File},{type,bag}],
{ok, Tab} = dets:open_file(Tab, Args),
ok = dets:insert(Tab, [{I,One},{F,One},{I,FOne},{F,FOne}]),
ok = dets:sync(Tab),
@@ -3561,11 +3171,11 @@ otp_4738_bag(Version, Config) ->
ok = dets:close(Tab),
file:delete(File).
-otp_4738_set(Version, Config) ->
+otp_4738_set(Config) ->
Tab = otp_4738,
File = filename(Tab, Config),
file:delete(File),
- Args = [{file,File},{type,set},{version,Version}],
+ Args = [{file,File},{type,set}],
%% I and F share the same slot.
I = -12857447,
@@ -3864,6 +3474,19 @@ wait_for_close(Tab) ->
wait_for_close(Tab)
end.
+%% OTP-13830. Format 8 is no longer supported.
+otp_13830(Config) ->
+ Tab = otp_13830,
+ File8 = filename:join(?datadir(Config), "version_8.dets"),
+ {error,{format_8_no_longer_supported,_}} =
+ dets:open_file(Tab, [{file, File8}]),
+ File = filename(Tab, Config),
+ %% Check the 'version' option, for backwards compatibility:
+ {ok, Tab} = dets:open_file(Tab, [{file, File}, {version, 9}]),
+ ok = dets:close(Tab),
+ {ok, Tab} = dets:open_file(Tab, [{file, File}, {version, default}]),
+ ok = dets:close(Tab).
+
%%
%% Parts common to several test cases
%%
@@ -4000,9 +3623,7 @@ match_test(Data, Tab) ->
%% Utilities
%%
-headsz(8) ->
- ?HEADSZ_v8;
-headsz(_) ->
+headsz() ->
?HEADSZ_v9.
unwritable(Fname) ->
@@ -4030,13 +3651,13 @@ filename(Name, Config) when is_atom(Name) ->
filename(Name, _Config) ->
filename:join(?privdir(_Config), Name).
-open_files(_Name, [], _Version) ->
+open_files(_Name, []) ->
[];
-open_files(Name0, [Args | Tail], Version) ->
+open_files(Name0, [Args | Tail]) ->
?format("init ~p~n", [Args]),
Name = list_to_atom(integer_to_list(Name0)),
- {ok, Name} = dets:open_file(Name, [{version,Version} | Args]),
- [Name | open_files(Name0+1, Tail, Version)].
+ {ok, Name} = dets:open_file(Name, Args),
+ [Name | open_files(Name0+1, Tail)].
close_all(Tabs) -> foreach(fun(Tab) -> ok = dets:close(Tab) end, Tabs).
@@ -4137,20 +3758,15 @@ no_keys_test([T | Ts]) ->
no_keys_test([]) ->
ok;
no_keys_test(T) ->
- case dets:info(T, version) of
- 8 ->
- ok;
- 9 ->
- Kp = dets:info(T, keypos),
- All = dets:match_object(T, '_'),
- L = lists:map(fun(X) -> element(Kp, X) end, All),
- NoKeys = length(lists:usort(L)),
- case {dets:info(T, no_keys), NoKeys} of
- {N, N} ->
- ok;
- {N1, N2} ->
- exit({no_keys_test, N1, N2})
- end
+ Kp = dets:info(T, keypos),
+ All = dets:match_object(T, '_'),
+ L = lists:map(fun(X) -> element(Kp, X) end, All),
+ NoKeys = length(lists:usort(L)),
+ case {dets:info(T, no_keys), NoKeys} of
+ {N, N} ->
+ ok;
+ {N1, N2} ->
+ exit({no_keys_test, N1, N2})
end.
safe_get_all_objects(Tab) ->
@@ -4182,7 +3798,6 @@ count_objs_1({Ts,C}, N) when is_list(Ts) ->
get_all_objects_fast(Tab) ->
dets:match_object(Tab, '_').
-%% Relevant for version 8.
histogram(Tab) ->
OnePercent = case dets:info(Tab, no_slots) of
undefined -> undefined;
@@ -4244,10 +3859,6 @@ ave_histogram([{S,N1} | H], N) ->
ave_histogram([], N) ->
N.
-bad_object({error,{bad_object,FileName}}, FileName) ->
- ok; % Version 8, no debug.
-bad_object({error,{{bad_object,_,_},FileName}}, FileName) ->
- ok; % Version 8, debug...
bad_object({error,{{bad_object,_}, FileName}}, FileName) ->
ok; % No debug.
bad_object({error,{{{bad_object,_,_},_,_,_}, FileName}}, FileName) ->
diff --git a/lib/stdlib/test/dets_SUITE_data/version_r2d.dets b/lib/stdlib/test/dets_SUITE_data/version_8.dets
index 327072f99e..278187e85c 100644
--- a/lib/stdlib/test/dets_SUITE_data/version_r2d.dets
+++ b/lib/stdlib/test/dets_SUITE_data/version_8.dets
Binary files differ
diff --git a/lib/stdlib/test/dict_SUITE.erl b/lib/stdlib/test/dict_SUITE.erl
index 47358d729f..e99af9ad42 100644
--- a/lib/stdlib/test/dict_SUITE.erl
+++ b/lib/stdlib/test/dict_SUITE.erl
@@ -23,10 +23,10 @@
-module(dict_SUITE).
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/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,
- create/1,store/1,iterate/1]).
+ create/1,store/1,iterate/1,remove/1]).
-include_lib("common_test/include/ct.hrl").
@@ -37,7 +37,7 @@ suite() ->
{timetrap,{minutes,5}}].
all() ->
- [create, store, iterate].
+ [create, store, remove, iterate].
groups() ->
[].
@@ -92,6 +92,27 @@ store_1(List, M) ->
end,
D0.
+remove(_Config) ->
+ test_all([{0,87}], fun remove_1/2).
+
+remove_1(List0, M) ->
+ %% Make sure that keys are unique. Randomize key order.
+ List1 = orddict:from_list(List0),
+ List2 = lists:sort([{rand:uniform(),E} || E <- List1]),
+ List = [E || {_,E} <- List2],
+ D0 = M(from_list, List),
+ remove_2(List, D0, M).
+
+remove_2([{Key,Val}|T], D0, M) ->
+ {Val,D1} = M(take, {Key,D0}),
+ error = M(take, {Key,D1}),
+ D2 = M(erase, {Key,D0}),
+ true = M(equal, {D1,D2}),
+ remove_2(T, D1, M);
+remove_2([], D, M) ->
+ true = M(is_empty, D),
+ D.
+
%%%
%%% Test specifics for gb_trees.
%%%
diff --git a/lib/stdlib/test/dict_test_lib.erl b/lib/stdlib/test/dict_test_lib.erl
index 7c4c3572ae..f6fef7bdf4 100644
--- a/lib/stdlib/test/dict_test_lib.erl
+++ b/lib/stdlib/test/dict_test_lib.erl
@@ -33,7 +33,9 @@ new(Mod, Eq) ->
(iterator, S) -> Mod:iterator(S);
(iterator_from, {Start, S}) -> Mod:iterator_from(Start, S);
(next, I) -> Mod:next(I);
- (to_list, D) -> to_list(Mod, D)
+ (to_list, D) -> to_list(Mod, D);
+ (erase, {K,D}) -> erase(Mod, K, D);
+ (take, {K,D}) -> take(Mod, K, D)
end.
empty(Mod) ->
@@ -67,3 +69,19 @@ enter(Mod, Key, Val, Dict) ->
true ->
Mod:store(Key, Val, Dict)
end.
+
+erase(Mod, Key, Val) when Mod =:= dict; Mod =:= orddict ->
+ Mod:erase(Key, Val);
+erase(gb_trees, Key, Val) ->
+ gb_trees:delete_any(Key, Val).
+
+take(gb_trees, Key, Val) ->
+ Res = try
+ gb_trees:take(Key, Val)
+ catch
+ error:_ ->
+ error
+ end,
+ Res = gb_trees:take_any(Key, Val);
+take(Mod, Key, Val) ->
+ Mod:take(Key, Val).
diff --git a/lib/stdlib/test/epp_SUITE.erl b/lib/stdlib/test/epp_SUITE.erl
index 4078513e38..71d6820c47 100644
--- a/lib/stdlib/test/epp_SUITE.erl
+++ b/lib/stdlib/test/epp_SUITE.erl
@@ -306,7 +306,7 @@ otp_5362(Config) when is_list(Config) ->
File_Back_hrl = filename:join(Dir, "back_5362.hrl"),
Back = <<"-module(back_5362).
- -compile(export_all).
+ -export([foo/1]).
-file(?FILE, 1).
-include(\"back_5362.hrl\").
@@ -334,7 +334,7 @@ otp_5362(Config) when is_list(Config) ->
-file(?FILE, 100).
- -compile(export_all).
+ -export([foo/1,bar/1]).
-file(\"other.file\", ?LINE). % like an included file...
foo(A) -> % line 105
@@ -362,7 +362,7 @@ otp_5362(Config) when is_list(Config) ->
Blank = <<"-module(blank_5362).
- -compile(export_all).
+ -export([q/1,a/1,b/1,c/1]).
-
file(?FILE, 18). q(Q) -> foo. % line 18
@@ -1258,7 +1258,7 @@ do_otp_8911(Config) ->
File = "i.erl",
Cont = <<"-module(i).
- -compile(export_all).
+ -export([t/0]).
-file(\"fil1\", 100).
-include(\"i1.erl\").
t() ->
@@ -1391,7 +1391,7 @@ otp_11728(Config) when is_list(Config) ->
HrlFile = filename:join(Dir, "otp_11728.hrl"),
ok = file:write_file(HrlFile, H),
C = <<"-module(otp_11728).
- -compile(export_all).
+ -export([function_name/0]).
-include(\"otp_11728.hrl\").
@@ -1599,12 +1599,12 @@ check_test(Config, Test) ->
end.
compile_test(Config, Test0) ->
- Test = [<<"-module(epp_test). -compile(export_all). ">>, Test0],
+ Test = [<<"-module(epp_test). ">>, Test0],
Filename = "epp_test.erl",
PrivDir = proplists:get_value(priv_dir, Config),
File = filename:join(PrivDir, Filename),
ok = file:write_file(File, Test),
- Opts = [export_all,return,nowarn_unused_record,{outdir,PrivDir}],
+ Opts = [export_all,nowarn_export_all,return,nowarn_unused_record,{outdir,PrivDir}],
case compile_file(File, Opts) of
{ok, Ws} -> warnings(File, Ws);
Else -> Else
@@ -1653,7 +1653,7 @@ unopaque_forms(Forms) ->
[erl_parse:anno_to_term(Form) || Form <- Forms].
run_test(Config, Test0) ->
- Test = [<<"-module(epp_test). -compile(export_all). ">>, Test0],
+ Test = [<<"-module(epp_test). -export([t/0]). ">>, Test0],
Filename = "epp_test.erl",
PrivDir = proplists:get_value(priv_dir, Config),
File = filename:join(PrivDir, Filename),
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index d916eb3eef..fd7de65302 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1999-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -64,7 +64,8 @@
predef/1,
maps/1,maps_type/1,maps_parallel_match/1,
otp_11851/1,otp_11879/1,otp_13230/1,
- record_errors/1]).
+ record_errors/1, otp_xxxxx/1,
+ non_latin1_module/1]).
suite() ->
[{ct_hooks,[ts_install_cth]},
@@ -84,7 +85,7 @@ all() ->
too_many_arguments, basic_errors, bin_syntax_errors, predef,
maps, maps_type, maps_parallel_match,
otp_11851, otp_11879, otp_13230,
- record_errors].
+ record_errors, otp_xxxxx, non_latin1_module].
groups() ->
[{unused_vars_warn, [],
@@ -1554,7 +1555,15 @@ guard(Config) when is_list(Config) ->
[],
{errors,[{1,erl_lint,illegal_guard_expr},
{2,erl_lint,illegal_guard_expr}],
- []}}
+ []}},
+ {guard10,
+ <<"is_port(_) -> false.
+ t(P) when port(P) -> ok.
+ ">>,
+ [],
+ {error,
+ [{2,erl_lint,{obsolete_guard_overridden,port}}],
+ [{2,erl_lint,{obsolete_guard,{port,1}}}]}}
],
[] = run(Config, Ts1),
ok.
@@ -1855,7 +1864,7 @@ otp_5276(Config) when is_list(Config) ->
%% OTP-5917. Check the 'deprecated' attributed.
otp_5917(Config) when is_list(Config) ->
Ts = [{otp_5917_1,
- <<"-compile(export_all).
+ <<"-export([t/0]).
-deprecated({t,0}).
@@ -1870,7 +1879,7 @@ otp_5917(Config) when is_list(Config) ->
%% OTP-6585. Check the deprecated guards list/1, pid/1, ....
otp_6585(Config) when is_list(Config) ->
Ts = [{otp_6585_1,
- <<"-compile(export_all).
+ <<"-export([t/0]).
-record(r, {}).
@@ -1994,22 +2003,22 @@ otp_5362(Config) when is_list(Config) ->
<<"-compile(nowarn_deprecated_function).
-compile(nowarn_bif_clash).
spawn(A) ->
- erlang:hash(A, 3000),
+ erlang:now(),
spawn(A).
">>,
- {[nowarn_unused_function,
+ {[nowarn_unused_function,
warn_deprecated_function,
warn_bif_clash]},
{error,
[{5,erl_lint,{call_to_redefined_old_bif,{spawn,1}}}],
- [{4,erl_lint,{deprecated,{erlang,hash,2},{erlang,phash2,2},
- "a future release"}}]}},
-
+ [{4,erl_lint,{deprecated,{erlang,now,0},
+ "Deprecated BIF. See the \"Time and Time Correction in Erlang\" "
+ "chapter of the ERTS User's Guide for more information."}}]}},
{otp_5362_5,
<<"-compile(nowarn_deprecated_function).
-compile(nowarn_bif_clash).
spawn(A) ->
- erlang:hash(A, 3000),
+ erlang:now(),
spawn(A).
">>,
{[nowarn_unused_function]},
@@ -2018,37 +2027,37 @@ otp_5362(Config) when is_list(Config) ->
%% The special nowarn_X are not affected by general warn_X.
{otp_5362_6,
- <<"-compile({nowarn_deprecated_function,{erlang,hash,2}}).
+ <<"-compile({nowarn_deprecated_function,{erlang,now,0}}).
-compile({nowarn_bif_clash,{spawn,1}}).
spawn(A) ->
- erlang:hash(A, 3000),
+ erlang:now(),
spawn(A).
">>,
- {[nowarn_unused_function,
- warn_deprecated_function,
+ {[nowarn_unused_function,
+ warn_deprecated_function,
warn_bif_clash]},
{errors,
[{2,erl_lint,disallowed_nowarn_bif_clash}],[]}},
{otp_5362_7,
<<"-export([spawn/1]).
- -compile({nowarn_deprecated_function,{erlang,hash,2}}).
+ -compile({nowarn_deprecated_function,{erlang,now,0}}).
-compile({nowarn_bif_clash,{spawn,1}}).
-compile({nowarn_bif_clash,{spawn,2}}). % bad
-compile([{nowarn_deprecated_function,
- [{erlang,hash,-1},{3,hash,-1}]}, % 2 bad
- {nowarn_deprecated_function, {{a,b,c},hash,-1}}]). % bad
+ [{erlang,now,-1},{3,now,-1}]}, % 2 bad
+ {nowarn_deprecated_function, {{a,b,c},now,-1}}]). % bad
spawn(A) ->
- erlang:hash(A, 3000),
+ erlang:now(),
spawn(A).
">>,
{[nowarn_unused_function]},
{error,[{3,erl_lint,disallowed_nowarn_bif_clash},
{4,erl_lint,disallowed_nowarn_bif_clash},
{4,erl_lint,{bad_nowarn_bif_clash,{spawn,2}}}],
- [{5,erl_lint,{bad_nowarn_deprecated_function,{3,hash,-1}}},
- {5,erl_lint,{bad_nowarn_deprecated_function,{erlang,hash,-1}}},
- {5,erl_lint,{bad_nowarn_deprecated_function,{{a,b,c},hash,-1}}}]}
+ [{5,erl_lint,{bad_nowarn_deprecated_function,{3,now,-1}}},
+ {5,erl_lint,{bad_nowarn_deprecated_function,{erlang,now,-1}}},
+ {5,erl_lint,{bad_nowarn_deprecated_function,{{a,b,c},now,-1}}}]}
},
{otp_5362_8,
@@ -2056,14 +2065,15 @@ otp_5362(Config) when is_list(Config) ->
-compile(warn_deprecated_function).
-compile(warn_bif_clash).
spawn(A) ->
- erlang:hash(A, 3000),
+ erlang:now(),
spawn(A).
">>,
{[nowarn_unused_function,
{nowarn_bif_clash,{spawn,1}}]}, % has no effect
{warnings,
- [{5,erl_lint,{deprecated,{erlang,hash,2},{erlang,phash2,2},
- "a future release"}}]}},
+ [{5,erl_lint,{deprecated,{erlang,now,0},
+ "Deprecated BIF. See the \"Time and Time Correction in Erlang\" "
+ "chapter of the ERTS User's Guide for more information."}}]}},
{otp_5362_9,
<<"-include_lib(\"stdlib/include/qlc.hrl\").
@@ -2075,11 +2085,11 @@ otp_5362(Config) when is_list(Config) ->
[]},
{otp_5362_10,
- <<"-compile({nowarn_deprecated_function,{erlang,hash,2}}).
+ <<"-compile({nowarn_deprecated_function,{erlang,now,0}}).
-compile({nowarn_bif_clash,{spawn,1}}).
-import(x,[spawn/1]).
spin(A) ->
- erlang:hash(A, 3000),
+ erlang:now(),
spawn(A).
">>,
{[nowarn_unused_function,
@@ -2089,11 +2099,11 @@ otp_5362(Config) when is_list(Config) ->
[{2,erl_lint,disallowed_nowarn_bif_clash}],[]}},
{call_deprecated_function,
- <<"t(X) -> erlang:hash(X, 2000).">>,
+ <<"t(X) -> calendar:local_time_to_universal_time(X).">>,
[],
{warnings,
- [{1,erl_lint,{deprecated,{erlang,hash,2},
- {erlang,phash2,2},"a future release"}}]}},
+ [{1,erl_lint,{deprecated,{calendar,local_time_to_universal_time,1},
+ {calendar,local_time_to_universal_time_dst,1}, "a future release"}}]}},
{call_removed_function,
<<"t(X) -> regexp:match(X).">>,
@@ -2540,7 +2550,7 @@ otp_5878(Config) when is_list(Config) ->
{function,9,t,0,[{clause,9,[],[],[{record,10,r,[]}]}]},
{eof,11}],
{error,[{"rec.erl",[{7,erl_lint,old_abstract_code}]}],[]} =
- compile:forms(OldAbstract, [return, report]),
+ compile_forms(OldAbstract, [return, report]),
ok.
@@ -2619,7 +2629,7 @@ otp_11772(Config) when is_list(Config) ->
Ts = <<"
-module(newly).
- -compile(export_all).
+ -export([t/0]).
%% Built-in:
-type node() :: node().
@@ -2644,7 +2654,7 @@ otp_11771(Config) when is_list(Config) ->
Ts = <<"
-module(newly).
- -compile(export_all).
+ -export([t/0]).
%% No longer allowed in 17.0:
-type arity() :: atom().
@@ -2671,7 +2681,7 @@ otp_11872(Config) when is_list(Config) ->
Ts = <<"
-module(map).
- -compile(export_all).
+ -export([t/0]).
-export_type([map/0, product/0]).
@@ -2694,9 +2704,9 @@ export_all(Config) when is_list(Config) ->
id(I) -> I.
">>,
- [] = run_test2(Config, Ts, []),
+ [] = run_test2(Config, Ts, [nowarn_export_all]),
{warnings,[{2,erl_lint,export_all}]} =
- run_test2(Config, Ts, [warn_export_all]),
+ run_test2(Config, Ts, []),
ok.
%% Test warnings for functions that clash with BIFs.
@@ -2997,7 +3007,7 @@ behaviour_basic(Config) when is_list(Config) ->
{behaviour4,
<<"-behavior(application). %% Test callbacks with export_all
- -compile(export_all).
+ -compile([export_all, nowarn_export_all]).
stop(_) -> ok.
">>,
[],
@@ -3839,9 +3849,13 @@ otp_11879(_Config) ->
[{1,erl_lint,{spec_fun_undefined,{f,1}}},
{2,erl_lint,spec_wrong_arity},
{22,erl_lint,callback_wrong_arity}]}],
- []} = compile:forms(Fs, [return,report]),
+ []} = compile_forms(Fs, [return,report]),
ok.
+compile_forms(Terms, Opts) ->
+ Forms = [erl_parse:anno_from_term(Term) || Term <- Terms],
+ compile:forms(Forms, Opts).
+
%% OTP-13230: -deprecated without -module.
otp_13230(Config) when is_list(Config) ->
Abstr = <<"-deprecated([{frutt,0,next_version}]).">>,
@@ -3861,6 +3875,73 @@ record_errors(Config) when is_list(Config) ->
{3,erl_lint,{redefine_field,r,a}}],[]}}],
run(Config, Ts).
+otp_xxxxx(Config) ->
+ Ts = [{constraint1,
+ <<"-export([t/1]).
+ -spec t(X) -> X when is_subtype(integer()).
+ t(a) -> foo:bar().
+ ">>,
+ [],
+ {errors,
+ [{2,erl_parse,"unsupported constraint " ++ ["is_subtype"]}],
+ []}},
+ {constraint2,
+ <<"-export([t/1]).
+ -spec t(X) -> X when bad_atom(X, integer()).
+ t(a) -> foo:bar().
+ ">>,
+ [],
+ {errors,
+ [{2,erl_parse,"unsupported constraint " ++ ["bad_atom"]}],
+ []}},
+ {constraint3,
+ <<"-export([t/1]).
+ -spec t(X) -> X when is_subtype(bad_variable, integer()).
+ t(a) -> foo:bar().
+ ">>,
+ [],
+ {errors,[{2,erl_parse,"bad type variable"}],[]}},
+ {constraint4,
+ <<"-export([t/1]).
+ -spec t(X) -> X when is_subtype(atom(), integer()).
+ t(a) -> foo:bar().
+ ">>,
+ [],
+ {errors,[{2,erl_parse,"bad type variable"}],[]}},
+ {constraint5,
+ <<"-export([t/1]).
+ -spec t(X) -> X when is_subtype(X, integer()).
+ t(a) -> foo:bar().
+ ">>,
+ [],
+ []},
+ {constraint6,
+ <<"-export([t/1]).
+ -spec t(X) -> X when X :: integer().
+ t(a) -> foo:bar().
+ ">>,
+ [],
+ []}],
+ run(Config, Ts).
+
+%% OTP-14285: We currently don't support non-latin1 module names.
+
+non_latin1_module(_Config) ->
+ do_non_latin1_module('юникод'),
+ do_non_latin1_module(list_to_atom([256,$a,$b,$c])),
+ do_non_latin1_module(list_to_atom([$a,$b,256,$c])),
+ ok.
+
+do_non_latin1_module(Mod) ->
+ File = atom_to_list(Mod) ++ ".erl",
+ Forms = [{attribute,1,file,{File,1}},
+ {attribute,1,module,Mod},
+ {eof,2}],
+ error = compile:forms(Forms),
+ {error,_,[]} = compile:forms(Forms, [return]),
+ ok.
+
+
run(Config, Tests) ->
F = fun({N,P,Ws,E}, BadL) ->
case catch run_test(Config, P, Ws) of
diff --git a/lib/stdlib/test/erl_pp_SUITE.erl b/lib/stdlib/test/erl_pp_SUITE.erl
index a103f6dc53..808ba9b4c1 100644
--- a/lib/stdlib/test/erl_pp_SUITE.erl
+++ b/lib/stdlib/test/erl_pp_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -51,7 +51,7 @@
otp_6321/1, otp_6911/1, otp_6914/1, otp_8150/1, otp_8238/1,
otp_8473/1, otp_8522/1, otp_8567/1, otp_8664/1, otp_9147/1,
otp_10302/1, otp_10820/1, otp_11100/1, otp_11861/1, pr_1014/1,
- otp_13662/1]).
+ otp_13662/1, otp_14285/1]).
%% Internal export.
-export([ehook/6]).
@@ -80,7 +80,8 @@ groups() ->
{tickets, [],
[otp_6321, otp_6911, otp_6914, otp_8150, otp_8238,
otp_8473, otp_8522, otp_8567, otp_8664, otp_9147,
- otp_10302, otp_10820, otp_11100, otp_11861, pr_1014, otp_13662]}].
+ otp_10302, otp_10820, otp_11100, otp_11861, pr_1014, otp_13662,
+ otp_14285]}].
init_per_suite(Config) ->
Config.
@@ -627,11 +628,6 @@ do_hook(HookFun) ->
true =
"{some,value}" =:= lists:flatten(erl_pp:expr({value,A0,{some,value}})),
- %% Silly...
- true =
- "if true -> 0 end" =:=
- flat_expr({'if',0,[{clause,0,[],[],[{atom,0,0}]}]}),
-
%% More compatibility: before R6
OldIf = {'if',A0,[{clause,A0,[],[{atom,A0,true}],[{atom,A0,b}]}]},
NewIf = {'if',A0,[{clause,A0,[],[[{atom,A0,true}]],[{atom,A0,b}]}]},
@@ -825,12 +821,13 @@ type_examples() ->
%% is_subtype(V, T) syntax, we need a few examples of the syntax.
{ex31,<<"-spec t1(FooBar :: t99()) -> t99();"
"(t2()) -> t2();"
- "('\\'t::4'()) -> '\\'t::4'() when is_subtype('\\'t::4'(), t24);"
- "(t23()) -> t23() when is_subtype(t23(), atom()),"
- " is_subtype(t23(), t14());"
- "(t24()) -> t24() when is_subtype(t24(), atom()),"
- " is_subtype(t24(), t14()),"
- " is_subtype(t24(), '\\'t::4'()).">>},
+ "('\\'t::4'()) -> {'\\'t::4'(), B}"
+ " when is_subtype(B, '\\'t::4'());"
+ "(t23()) -> C when is_subtype(C, atom()),"
+ " is_subtype(C, t14());"
+ "(t24()) -> D when is_subtype(D, atom()),"
+ " is_subtype(D, t14()),"
+ " is_subtype(D, '\\'t::4'()).">>},
{ex32,<<"-spec mod:t2() -> any(). ">>},
{ex33,<<"-opaque attributes_data() :: "
"[{'column', column()} | {'line', info_line()} |"
@@ -1067,9 +1064,6 @@ otp_11100(Config) when is_list(Config) ->
%% There are a few places where the added code ("options(none)")
%% doesn't make a difference (pp:bit_elem_type/1 is an example).
- %% Cannot trigger the use of the hook function with export/import.
- "-export([{fy,a}/b]).\n" =
- pf({attribute,1,export,[{{fy,a},b}]}),
A1 = erl_anno:new(1),
"-type foo() :: integer(INVALID-FORM:{foo,bar}:).\n" =
pf({attribute,A1,type,{foo,{type,A1,integer,[{foo,bar}]},[]}}),
@@ -1099,10 +1093,11 @@ otp_11100(Config) when is_list(Config) ->
%% OTP-11861. behaviour_info() and -callback.
otp_11861(Config) when is_list(Config) ->
+ A3 = erl_anno:new(3),
"-optional_callbacks([bar/0]).\n" =
- pf({attribute,3,optional_callbacks,[{bar,0}]}),
+ pf({attribute,A3,optional_callbacks,[{bar,0}]}),
"-optional_callbacks([{bar,1,bad}]).\n" =
- pf({attribute,4,optional_callbacks,[{bar,1,bad}]}),
+ pf({attribute,A3,optional_callbacks,[{bar,1,bad}]}),
ok.
pf(Form) ->
@@ -1144,6 +1139,34 @@ otp_13662(Config) ->
],
compile(Config, Ts).
+otp_14285(_Config) ->
+ pp_forms(<<"-export([t/0, '\\x{400}\\''/0]).">>),
+ pp_forms(<<"-import(lists, [append/2]).">>),
+ pp_forms(<<"-optional_callbacks([]).">>),
+ pp_forms(<<"-optional_callbacks(['\\x{400}\\''/1]).">>),
+ pp_forms(<<"-'\\x{400}\\''('\\x{400}\\'').">>),
+ pp_forms(<<"-type '\\x{400}\\''() :: '\\x{400}\\''.">>),
+ pp_forms(<<"-record('\\x{400}\\'', {'\\x{400}\\''}).">>),
+ pp_forms(<<"-callback '\\x{400}\\''(_) -> '\\x{400}\\''.">>),
+ pp_forms(<<"t() -> '\\x{400}\\''('\\x{400}\\'').">>),
+ pp_forms(<<"'\\x{400}\\''(_) -> '\\x{400}\\''.">>),
+ pp_forms(<<"-spec '\\x{400}'() -> "
+ "#'\\x{400}'{'\\x{400}' :: '\\x{400}'}.">>),
+ pp_forms(<<"'\\x{400}\\''() ->"
+ "R = #'\\x{400}\\''{},"
+ "#'\\x{400}\\''{'\\x{400}\\'' ="
+ "{'\\x{400}\\'',"
+ "fun '\\x{400}\\''/0,"
+ "R#'\\x{400}\\''.'\\x{400}\\'',"
+ "#'\\x{400}\\''.'\\x{400}\\''}}.">>),
+
+ %% Special...
+ true =
+ "{some,'\\x{400}\\''}" =:=
+ lists:flatten(erl_pp:expr({value,erl_anno:new(0),{some,'\x{400}\''}},
+ [{encoding,latin1}])),
+ ok.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
compile(Config, Tests) ->
@@ -1166,19 +1189,21 @@ compile(Config, Tests) ->
lists:foldl(F, [], Tests).
compile_file(Config, Test0) ->
- case compile_file(Config, Test0, ['E']) of
+ Test = ["-module(erl_pp_test).\n",
+ "-compile(export_all).\n",
+ Test0],
+ case compile_file(Config, Test, ['E']) of
{ok, RootFile} ->
File = RootFile ++ ".E",
{ok, Bin0} = file:read_file(File),
- Bin = strip_module_info(Bin0),
%% A very simple check: just try to compile the output.
- case compile_file(Config, Bin, []) of
+ case compile_file(Config, Bin0, []) of
{ok, RootFile2} ->
File2 = RootFile2 ++ ".E",
{ok, Bin1} = file:read_file(File2),
case Bin0 =:= Bin1 of
true ->
- test_max_line(binary_to_list(Bin));
+ test_max_line(binary_to_list(Bin0));
false ->
{error, file_contents_modified, {Bin0, Bin1}}
end;
@@ -1189,11 +1214,8 @@ compile_file(Config, Test0) ->
Error
end.
-compile_file(Config, Test0, Opts0) ->
+compile_file(Config, Test, Opts0) ->
FileName = filename('erl_pp_test.erl', Config),
- Test = list_to_binary(["-module(erl_pp_test). "
- "-compile(export_all). ",
- Test0]),
Opts = [export_all,return,nowarn_unused_record,{outdir,?privdir} | Opts0],
ok = file:write_file(FileName, Test),
case compile:file(FileName, Opts) of
@@ -1202,11 +1224,6 @@ compile_file(Config, Test0, Opts0) ->
Error -> Error
end.
-strip_module_info(Bin) ->
- {match, [{Start,_Len}|_]} = re:run(Bin, "module_info"),
- <<R:Start/binary,_/binary>> = Bin,
- R.
-
flat_expr1(Expr0) ->
Expr = erl_parse:new_anno(Expr0),
lists:flatten(erl_pp:expr(Expr)).
diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl
index 4ae734eb65..aca5b1e54f 100644
--- a/lib/stdlib/test/erl_scan_SUITE.erl
+++ b/lib/stdlib/test/erl_scan_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1998-2016. All Rights Reserved.
+%% Copyright Ericsson AB 1998-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -772,10 +772,9 @@ unicode() ->
erl_scan:string([1089]),
{error,{{1,1},erl_scan,{illegal,character}},{1,2}} =
erl_scan:string([1089], {1,1}),
- {error,{1,erl_scan,{illegal,atom}},1} =
- erl_scan:string("'a"++[1089]++"b'", 1),
- {error,{{1,1},erl_scan,{illegal,atom}},{1,6}} =
- erl_scan:string("'a"++[1089]++"b'", {1,1}),
+ {error,{{1,3},erl_scan,{illegal,character}},{1,4}} =
+ erl_scan:string("'a" ++ [999999999] ++ "c'", {1,1}),
+
test("\"a"++[1089]++"b\""),
{ok,[{char,1,1}],1} =
erl_scan_string([$$,$\\,$^,1089], 1),
@@ -786,8 +785,8 @@ unicode() ->
erl_scan:format_error(Error),
{error,{{1,1},erl_scan,_},{1,11}} =
erl_scan:string("\"qa\\x{aaa}",{1,1}),
- {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} =
- erl_scan:string("'qa\\x{aaa}'",{1,1}),
+ {error,{{1,1},erl_scan,_},{1,11}} =
+ erl_scan:string("'qa\\x{aaa}",{1,1}),
{ok,[{char,1,1089}],1} =
erl_scan_string([$$,1089], 1),
@@ -904,10 +903,10 @@ more_chars() ->
%% OTP-10302. Unicode characters scanner/parser.
otp_10302(Config) when is_list(Config) ->
%% From unicode():
- {error,{1,erl_scan,{illegal,atom}},1} =
- erl_scan:string("'a"++[1089]++"b'", 1),
- {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} =
- erl_scan:string("'qa\\x{aaa}'",{1,1}),
+ {ok,[{atom,1,'aсb'}],1} =
+ erl_scan_string("'a"++[1089]++"b'", 1),
+ {ok,[{atom,{1,1},'qaપ'}],{1,12}} =
+ erl_scan_string("'qa\\x{aaa}'",{1,1}),
{ok,[{char,1,1089}],1} = erl_scan_string([$$,1089], 1),
{ok,[{char,1,1089}],1} = erl_scan_string([$$,$\\,1089],1),
diff --git a/lib/stdlib/test/error_logger_h_SUITE.erl b/lib/stdlib/test/error_logger_h_SUITE.erl
index 2a34c7764f..30f96e0522 100644
--- a/lib/stdlib/test/error_logger_h_SUITE.erl
+++ b/lib/stdlib/test/error_logger_h_SUITE.erl
@@ -297,13 +297,13 @@ match_format(Tag, [Format,Args], [Head|Lines], AtNode, Depth) ->
iolist_to_binary(S)
end,
Expected0 = binary:split(Bin, <<"\n">>, [global,trim]),
- Expected = Expected0 ++ AtNode,
+ Expected = AtNode ++ Expected0,
match_term_lines(Expected, Lines).
match_term(Tag, [Arg], [Head|Lines], AtNode, Depth) ->
match_head(Tag, Head),
Expected0 = match_term_get_expected(Arg, Depth),
- Expected = Expected0 ++ AtNode,
+ Expected = AtNode ++ Expected0,
match_term_lines(Expected, Lines).
match_term_get_expected(List, Depth) when is_list(List) ->
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index 00e02a06cc..2dfd481665 100644
--- a/lib/stdlib/test/ets_SUITE.erl
+++ b/lib/stdlib/test/ets_SUITE.erl
@@ -22,7 +22,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2]).
-export([default/1,setbag/1,badnew/1,verybadnew/1,named/1,keypos2/1,
- privacy/1,privacy_owner/2]).
+ privacy/1]).
-export([empty/1,badinsert/1]).
-export([time_lookup/1,badlookup/1,lookup_order/1]).
-export([delete_elem/1,delete_tab/1,delete_large_tab/1,
@@ -39,8 +39,9 @@
-export([lookup_element_mult/1]).
-export([foldl_ordered/1, foldr_ordered/1, foldl/1, foldr/1, fold_empty/1]).
-export([t_delete_object/1, t_init_table/1, t_whitebox/1,
+ select_bound_chunk/1,
t_delete_all_objects/1, t_insert_list/1, t_test_ms/1,
- t_select_delete/1,t_ets_dets/1]).
+ t_select_delete/1,t_select_replace/1,t_ets_dets/1]).
-export([ordered/1, ordered_match/1, interface_equality/1,
fixtable_next/1, fixtable_insert/1, rename/1, rename_unnamed/1, evil_rename/1,
@@ -64,7 +65,7 @@
meta_lookup_named_read/1, meta_lookup_named_write/1,
meta_newdel_unnamed/1, meta_newdel_named/1]).
-export([smp_insert/1, smp_fixed_delete/1, smp_unfix_fix/1, smp_select_delete/1,
- otp_8166/1, otp_8732/1]).
+ smp_select_replace/1, otp_8166/1, otp_8732/1]).
-export([exit_large_table_owner/1,
exit_many_large_table_owner/1,
exit_many_tables_owner/1,
@@ -75,46 +76,25 @@
-export([otp_9423/1]).
-export([otp_10182/1]).
-export([ets_all/1]).
--export([memory_check_summary/1]).
+-export([massive_ets_all/1]).
-export([take/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
%% Convenience for manual testing
-export([random_test/0]).
-%% internal exports
--export([dont_make_worse_sub/0, make_better_sub1/0, make_better_sub2/0]).
--export([t_repair_continuation_do/1, t_bucket_disappears_do/1,
- select_fail_do/1, whitebox_1/1, whitebox_2/1, t_delete_all_objects_do/1,
- t_delete_object_do/1, t_init_table_do/1, t_insert_list_do/1,
- update_element_opts/1, update_element_opts/4, update_element/4, update_element_do/4,
- update_element_neg/1, update_element_neg_do/1, update_counter_do/1, update_counter_neg/1,
- evil_update_counter_do/1, fixtable_next_do/1, heir_do/1, give_away_do/1, setopts_do/1,
- rename_do/1, rename_unnamed_do/1, interface_equality_do/1, ordered_match_do/1,
- ordered_do/1, privacy_do/1, empty_do/1, badinsert_do/1, time_lookup_do/1,
- lookup_order_do/1, lookup_element_mult_do/1, delete_tab_do/1, delete_elem_do/1,
- match_delete_do/1, match_delete3_do/1, firstnext_do/1,
- slot_do/1, match1_do/1, match2_do/1, match_object_do/1, match_object2_do/1,
- misc1_do/1, safe_fixtable_do/1, info_do/1, dups_do/1, heavy_lookup_do/1,
- heavy_lookup_element_do/1, member_do/1, otp_5340_do/1, otp_7665_do/1, meta_wb_do/1,
- do_heavy_concurrent/1, tab2file2_do/2, exit_large_table_owner_do/2,
- types_do/1, sleeper/0, memory_do/1, update_counter_with_default_do/1,
- update_counter_table_growth_do/1,
- ms_tracee_dummy/1, ms_tracee_dummy/2, ms_tracee_dummy/3, ms_tracee_dummy/4
- ]).
-
-export([t_select_reverse/1]).
-include_lib("common_test/include/ct.hrl").
-define(m(A,B), assert_eq(A,B)).
+-define(heap_binary_size, 64).
init_per_testcase(Case, Config) ->
rand:seed(exsplus),
io:format("*** SEED: ~p ***\n", [rand:export_seed()]),
start_spawn_logger(),
wait_for_test_procs(), %% Ensure previous case cleaned up
- put('__ETS_TEST_CASE__', Case),
[{test_case, Case} | Config].
end_per_testcase(_Func, _Config) ->
@@ -139,15 +119,16 @@ all() ->
update_counter_with_default, partly_bound,
update_counter_table_growth,
match_heavy, {group, fold}, member, t_delete_object,
+ select_bound_chunk,
t_init_table, t_whitebox, t_delete_all_objects,
- t_insert_list, t_test_ms, t_select_delete, t_ets_dets,
- memory, t_select_reverse, t_bucket_disappears,
+ t_insert_list, t_test_ms, t_select_delete, t_select_replace,
+ t_ets_dets, memory, t_select_reverse, t_bucket_disappears,
select_fail, t_insert_new, t_repair_continuation,
otp_5340, otp_6338, otp_6842_select_1000, otp_7665,
otp_8732, meta_wb, grow_shrink, grow_pseudo_deleted,
shrink_pseudo_deleted, {group, meta_smp}, smp_insert,
- smp_fixed_delete, smp_unfix_fix, smp_select_delete,
- otp_8166, exit_large_table_owner,
+ smp_fixed_delete, smp_unfix_fix, smp_select_replace,
+ smp_select_delete, otp_8166, exit_large_table_owner,
exit_many_large_table_owner, exit_many_tables_owner,
exit_many_many_tables_owner, write_concurrency, heir,
give_away, setopts, bad_table, types,
@@ -155,9 +136,8 @@ all() ->
otp_9932,
otp_9423,
ets_all,
- take,
-
- memory_check_summary]. % MUST BE LAST
+ massive_ets_all,
+ take].
groups() ->
[{new, [],
@@ -202,33 +182,12 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
-%% Test that we did not have "too many" failed verify_etsmem()'s
-%% in the test suite.
-%% verify_etsmem() may give a low number of false positives
-%% as concurrent activities, such as lingering processes
-%% from earlier test suites, may do unrelated ets (de)allocations.
-memory_check_summary(_Config) ->
- case whereis(ets_test_spawn_logger) of
- undefined ->
- ct:fail("No spawn logger exist");
- _ ->
- ets_test_spawn_logger ! {self(), get_failed_memchecks},
- receive {get_failed_memchecks, FailedMemchecks} -> ok end,
- io:format("Failed memchecks: ~p\n",[FailedMemchecks]),
- NoFailedMemchecks = length(FailedMemchecks),
- if NoFailedMemchecks > 3 ->
- ct:fail("Too many failed (~p) memchecks", [NoFailedMemchecks]);
- true ->
- ok
- end
- end.
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Test that a disappearing bucket during select of a non-fixed table works.
t_bucket_disappears(Config) when is_list(Config) ->
- repeat_for_opts(t_bucket_disappears_do).
+ repeat_for_opts(fun t_bucket_disappears_do/1).
t_bucket_disappears_do(Opts) ->
EtsMem = etsmem(),
@@ -396,11 +355,16 @@ ms_tracer_collect(Tracee, Ref, Acc) ->
ms_tracee(Parent, CallArgList) ->
Parent ! {self(), ready},
receive start -> ok end,
- lists:foreach(fun(Args) ->
- erlang:apply(?MODULE, ms_tracee_dummy, tuple_to_list(Args))
- end, CallArgList).
-
-
+ F = fun({A1}) ->
+ ms_tracee_dummy(A1);
+ ({A1,A2}) ->
+ ms_tracee_dummy(A1, A2);
+ ({A1,A2,A3}) ->
+ ms_tracee_dummy(A1, A2, A3);
+ ({A1,A2,A3,A4}) ->
+ ms_tracee_dummy(A1, A2, A3, A4)
+ end,
+ lists:foreach(F, CallArgList).
ms_tracee_dummy(_) -> ok.
ms_tracee_dummy(_,_) -> ok.
@@ -418,7 +382,7 @@ assert_eq(A,B) ->
%% Test ets:repair_continuation/2.
t_repair_continuation(Config) when is_list(Config) ->
- repeat_for_opts(t_repair_continuation_do).
+ repeat_for_opts(fun t_repair_continuation_do/1).
t_repair_continuation_do(Opts) ->
@@ -564,7 +528,8 @@ default(Config) when is_list(Config) ->
%% Test that select fails even if nothing can match.
select_fail(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(select_fail_do, [all_types,write_concurrency]),
+ repeat_for_opts(fun select_fail_do/1,
+ [all_types,write_concurrency]),
verify_etsmem(EtsMem).
select_fail_do(Opts) ->
@@ -590,27 +555,21 @@ select_fail_do(Opts) ->
-define(S(T),ets:info(T,memory)).
--define(TAB_STRUCT_SZ, erts_debug:get_internal_state('DbTable_words')).
-%%-define(NORMAL_TAB_STRUCT_SZ, 26). %% SunOS5.8, 32-bit, non smp, private heap
-%%
-%% The hardcoded expected memory sizes (in words) are the ones we expect on:
-%% SunOS5.8, 32-bit, non smp, private heap
-%%
%% Whitebox test of ets:info(X, memory).
memory(Config) when is_list(Config) ->
ok = chk_normal_tab_struct_size(),
- repeat_for_opts(memory_do,[compressed]),
+ repeat_for_opts(fun memory_do/1, [compressed]),
catch erts_debug:set_internal_state(available_internal_state, false).
memory_do(Opts) ->
L = [T1,T2,T3,T4] = fill_sets_int(1000,Opts),
XR1 = case mem_mode(T1) of
- {normal,_} -> {13836,13046,13046,13052}; %{13862,13072,13072,13078};
- {compressed,4} -> {11041,10251,10251,10252}; %{11067,10277,10277,10278};
- {compressed,8} -> {10050,9260,9260,9260} %{10076,9286,9286,9286}
+ {normal,_} -> {13836, 15346, 15346, 15346+6};
+ {compressed,4} -> {11041, 12551, 12551, 12551+1};
+ {compressed,8} -> {10050, 11560, 11560, 11560}
end,
- XRes1 = adjust_xmem(L, XR1),
+ XRes1 = adjust_xmem(L, XR1, 1),
Res1 = {?S(T1),?S(T2),?S(T3),?S(T4)},
lists:foreach(fun(T) ->
Before = ets:info(T,size),
@@ -622,11 +581,11 @@ memory_do(Opts) ->
end,
L),
XR2 = case mem_mode(T1) of
- {normal,_} -> {13826,13037,13028,13034}; %{13852,13063,13054,13060};
- {compressed,4} -> {11031,10242,10233,10234}; %{11057,10268,10259,10260};
- {compressed,8} -> {10040,9251,9242,9242} %10066,9277,9268,9268}
+ {normal,_} -> {13826, 15337, 15337-9, 15337-3};
+ {compressed,4} -> {11031, 12542, 12542-9, 12542-8};
+ {compressed,8} -> {10040, 11551, 11551-9, 11551-9}
end,
- XRes2 = adjust_xmem(L, XR2),
+ XRes2 = adjust_xmem(L, XR2, 1),
Res2 = {?S(T1),?S(T2),?S(T3),?S(T4)},
lists:foreach(fun(T) ->
Before = ets:info(T,size),
@@ -638,17 +597,17 @@ memory_do(Opts) ->
end,
L),
XR3 = case mem_mode(T1) of
- {normal,_} -> {13816,13028,13010,13016}; %{13842,13054,13036,13042};
- {compressed,4} -> {11021,10233,10215,10216}; %{11047,10259,10241,10242};
- {compressed,8} -> {10030,9242,9224,9224} %{10056,9268,9250,9250}
+ {normal,_} -> {13816, 15328, 15328-18, 15328-12};
+ {compressed,4} -> {11021, 12533, 12533-18, 12533-17};
+ {compressed,8} -> {10030, 11542, 11542-18, 11542-18}
end,
- XRes3 = adjust_xmem(L, XR3),
+ XRes3 = adjust_xmem(L, XR3, 1),
Res3 = {?S(T1),?S(T2),?S(T3),?S(T4)},
lists:foreach(fun(T) ->
ets:delete_all_objects(T)
end,
L),
- XRes4 = adjust_xmem(L, {50,260,260,260}), %{76,286,286,286}),
+ XRes4 = adjust_xmem(L, {50, 256, 256, 256}, 0),
Res4 = {?S(T1),?S(T2),?S(T3),?S(T4)},
lists:foreach(fun(T) ->
ets:delete(T)
@@ -659,7 +618,7 @@ memory_do(Opts) ->
ets:select_delete(T,[{'_',[],[true]}])
end,
L2),
- XRes5 = adjust_xmem(L2, {50,260,260,260}), %{76,286,286,286}),
+ XRes5 = adjust_xmem(L2, {50, 256, 256, 256}, 0),
Res5 = {?S(T11),?S(T12),?S(T13),?S(T14)},
io:format("XRes1 = ~p~n"
" Res1 = ~p~n~n"
@@ -697,25 +656,25 @@ chk_normal_tab_struct_size() ->
erlang:system_info(smp_support),
erlang:system_info(heap_type)},
io:format("System = ~p~n", [System]),
- io:format("?TAB_STRUCT_SZ=~p~n", [?TAB_STRUCT_SZ]),
ok.
-adjust_xmem([_T1,_T2,_T3,_T4], {A0,B0,C0,D0} = _Mem0) ->
+adjust_xmem([_T1,_T2,_T3,_T4], {A0,B0,C0,D0} = _Mem0, EstCnt) ->
%% Adjust for 64-bit, smp, and os:
%% Table struct size may differ.
- TabDiff = ?TAB_STRUCT_SZ,
- {A0+TabDiff, B0+TabDiff, C0+TabDiff, D0+TabDiff}.
+ {TabSz, EstSz} = erts_debug:get_internal_state('DbTable_words'),
+ HTabSz = TabSz + EstCnt*EstSz,
+ {A0+TabSz, B0+HTabSz, C0+HTabSz, D0+HTabSz}.
%% Misc. whitebox tests
t_whitebox(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(whitebox_1),
- repeat_for_opts(whitebox_1),
- repeat_for_opts(whitebox_1),
- repeat_for_opts(whitebox_2),
- repeat_for_opts(whitebox_2),
- repeat_for_opts(whitebox_2),
+ repeat_for_opts(fun whitebox_1/1),
+ repeat_for_opts(fun whitebox_1/1),
+ repeat_for_opts(fun whitebox_1/1),
+ repeat_for_opts(fun whitebox_2/1),
+ repeat_for_opts(fun whitebox_2/1),
+ repeat_for_opts(fun whitebox_2/1),
verify_etsmem(EtsMem).
whitebox_1(Opts) ->
@@ -739,6 +698,15 @@ whitebox_2(Opts) ->
ets:delete(T2),
ok.
+select_bound_chunk(Config) ->
+ repeat_for_opts(fun select_bound_chunk_do/1, [all_types]).
+
+select_bound_chunk_do(Opts) ->
+ T = ets:new(x, Opts),
+ ets:insert(T, [{key, 1}]),
+ {[{key, 1}], '$end_of_table'} = ets:select(T, [{{key,1},[],['$_']}], 100000),
+ ok.
+
%% Test ets:to/from_dets.
t_ets_dets(Config) when is_list(Config) ->
@@ -780,7 +748,7 @@ check_badarg({'EXIT', {badarg, [{M,F,A,_} | _]}}, M, F, Args) ->
%% Test ets:delete_all_objects/1.
t_delete_all_objects(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(t_delete_all_objects_do),
+ repeat_for_opts(fun t_delete_all_objects_do/1),
verify_etsmem(EtsMem).
get_kept_objects(T) ->
@@ -814,7 +782,7 @@ t_delete_all_objects_do(Opts) ->
%% Test ets:delete_object/2.
t_delete_object(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(t_delete_object_do),
+ repeat_for_opts(fun t_delete_object_do/1),
verify_etsmem(EtsMem).
t_delete_object_do(Opts) ->
@@ -887,7 +855,7 @@ make_init_fun(N) ->
%% Test ets:init_table/2.
t_init_table(Config) when is_list(Config)->
EtsMem = etsmem(),
- repeat_for_opts(t_init_table_do),
+ repeat_for_opts(fun t_init_table_do/1),
verify_etsmem(EtsMem).
t_init_table_do(Opts) ->
@@ -963,7 +931,7 @@ t_insert_new(Config) when is_list(Config) ->
%% Test ets:insert/2 with list of objects.
t_insert_list(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(t_insert_list_do),
+ repeat_for_opts(fun t_insert_list_do/1),
verify_etsmem(EtsMem).
t_insert_list_do(Opts) ->
@@ -1180,6 +1148,211 @@ t_select_delete(Config) when is_list(Config) ->
lists:foreach(fun(Tab) -> ets:delete(Tab) end,Tables),
verify_etsmem(EtsMem).
+%% Tests the ets:select_replace/2 BIF
+t_select_replace(Config) when is_list(Config) ->
+ EtsMem = etsmem(),
+ Tables = fill_sets_int(10000) ++ fill_sets_int(10000, [{write_concurrency,true}]),
+
+ TestFun = fun (Table, TableType) when TableType =:= bag ->
+ % Operation not supported; bag implementation
+ % presented both semantic consistency and performance issues.
+ 10000 = ets:select_delete(Table, [{'_',[],[true]}]);
+
+ (Table, TableType) ->
+ % Invalid replacement doesn't keep the key
+ MatchSpec1 = [{{'$1', '$2'},
+ [{'=:=', {'band', '$1', 2#11}, 2#11},
+ {'=/=', {'hd', '$2'}, $x}],
+ [{{'$2', '$1'}}]}],
+ {'EXIT',{badarg,_}} = (catch ets:select_replace(Table, MatchSpec1)),
+
+ % Invalid replacement doesn't keep the key (even though it would be the same value)
+ MatchSpec2 = [{{'$1', '$2'},
+ [{'=:=', {'band', '$1', 2#11}, 2#11}],
+ [{{{'+', '$1', 0}, '$2'}}]},
+ {{'$1', '$2'},
+ [{'=/=', {'band', '$1', 2#11}, 2#11}],
+ [{{{'-', '$1', 0}, '$2'}}]}],
+ {'EXIT',{badarg,_}} = (catch ets:select_replace(Table, MatchSpec2)),
+
+ % Invalid replacement changes key to float equivalent
+ MatchSpec3 = [{{'$1', '$2'},
+ [{'=:=', {'band', '$1', 2#11}, 2#11},
+ {'=/=', {'hd', '$2'}, $x}],
+ [{{{'*', '$1', 1.0}, '$2'}}]}],
+ {'EXIT',{badarg,_}} = (catch ets:select_replace(Table, MatchSpec3)),
+
+ % Replacements are differently-sized tuples
+ MatchSpec4_A = [{{'$1','$2'},
+ [{'<', {'rem', '$1', 5}, 2}],
+ [{{'$1', [$x | '$2'], stuff}}]}],
+ MatchSpec4_B = [{{'$1','$2','_'},
+ [],
+ [{{'$1','$2'}}]}],
+ 4000 = ets:select_replace(Table, MatchSpec4_A),
+ 4000 = ets:select_replace(Table, MatchSpec4_B),
+
+ % Replacement is the same tuple
+ MatchSpec5 = [{{'$1', '$2'},
+ [{'>', {'rem', '$1', 5}, 3}],
+ ['$_']}],
+ 2000 = ets:select_replace(Table, MatchSpec5),
+
+ % Replacement reconstructs an equal tuple
+ MatchSpec6 = [{{'$1', '$2'},
+ [{'>', {'rem', '$1', 5}, 3}],
+ [{{'$1', '$2'}}]}],
+ 2000 = ets:select_replace(Table, MatchSpec6),
+
+ % Replacement uses {element,KeyPos,T} for key
+ 2000 = ets:select_replace(Table,
+ [{{'$1', '$2'},
+ [{'>', {'rem', '$1', 5}, 3}],
+ [{{{element, 1, '$_'}, '$2'}}]}]),
+
+ % Replacement uses wrong {element,KeyPos,T} for key
+ {'EXIT',{badarg,_}} = (catch ets:select_replace(Table,
+ [{{'$1', '$2'},
+ [],
+ [{{{element, 2, '$_'}, '$2'}}]}])),
+
+ check(Table,
+ fun ({N, [$x, C | _]}) when ((N rem 5) < 2) -> (C >= $0) andalso (C =< $9);
+ ({N, [C | _]}) when is_float(N) -> (C >= $0) andalso (C =< $9);
+ ({N, [C | _]}) when ((N rem 5) > 3) -> (C >= $0) andalso (C =< $9);
+ ({_, [C | _]}) -> (C >= $0) andalso (C =< $9)
+ end,
+ 10000),
+
+ % Replace unbound range (>)
+ MatchSpec7 = [{{'$1', '$2'},
+ [{'>', '$1', 7000}],
+ [{{'$1', {{gt_range, '$2'}}}}]}],
+ 3000 = ets:select_replace(Table, MatchSpec7),
+
+ % Replace unbound range (<)
+ MatchSpec8 = [{{'$1', '$2'},
+ [{'<', '$1', 3000}],
+ [{{'$1', {{le_range, '$2'}}}}]}],
+ case TableType of
+ ordered_set -> 2999 = ets:select_replace(Table, MatchSpec8);
+ set -> 2999 = ets:select_replace(Table, MatchSpec8);
+ duplicate_bag -> 2998 = ets:select_replace(Table, MatchSpec8)
+ end,
+
+ % Replace bound range
+ MatchSpec9 = [{{'$1', '$2'},
+ [{'>=', '$1', 3001},
+ {'<', '$1', 7000}],
+ [{{'$1', {{range, '$2'}}}}]}],
+ case TableType of
+ ordered_set -> 3999 = ets:select_replace(Table, MatchSpec9);
+ set -> 3999 = ets:select_replace(Table, MatchSpec9);
+ duplicate_bag -> 3998 = ets:select_replace(Table, MatchSpec9)
+ end,
+
+ % Replace particular keys
+ MatchSpec10 = [{{'$1', '$2'},
+ [{'==', '$1', 3000}],
+ [{{'$1', {{specific1, '$2'}}}}]},
+ {{'$1', '$2'},
+ [{'==', '$1', 7000}],
+ [{{'$1', {{specific2, '$2'}}}}]}],
+ case TableType of
+ ordered_set -> 2 = ets:select_replace(Table, MatchSpec10);
+ set -> 2 = ets:select_replace(Table, MatchSpec10);
+ duplicate_bag -> 4 = ets:select_replace(Table, MatchSpec10)
+ end,
+
+ check(Table,
+ fun ({N, {gt_range, _}}) -> N > 7000;
+ ({N, {le_range, _}}) -> N < 3000;
+ ({N, {range, _}}) -> (N >= 3001) andalso (N < 7000);
+ ({N, {specific1, _}}) -> N == 3000;
+ ({N, {specific2, _}}) -> N == 7000
+ end,
+ 10000),
+
+ 10000 = ets:select_delete(Table, [{'_',[],[true]}]),
+ check(Table, fun (_) -> false end, 0)
+ end,
+
+ lists:foreach(
+ fun(Table) ->
+ TestFun(Table, ets:info(Table, type)),
+ ets:delete(Table)
+ end,
+ Tables),
+
+ %% Test key-safe match-specs are accepted
+ BigNum = (123 bsl 123),
+ RefcBin = list_to_binary(lists:seq(1,?heap_binary_size+1)),
+ Terms = [a, "hej", 123, 1.23, BigNum , <<"123">>, RefcBin, TestFun, self()],
+ EqPairs = fun(X,Y) ->
+ [{ '$1', '$1'},
+ { {X, Y}, {{X, Y}}},
+ { {'$1', Y}, {{'$1', Y}}},
+ { {{X, Y}}, {{{{X, Y}}}}},
+ { {X}, {{X}}},
+ { X, {const, X}},
+ { {X,Y}, {const, {X,Y}}},
+ { {X}, {const, {X}}},
+ { {X, Y}, {{X, {const, Y}}}},
+ { {X, {Y,'$1'}}, {{{const, X}, {{Y,'$1'}}}}},
+ { [X, Y | '$1'], [X, Y | '$1']},
+ { [{X, '$1'}, Y], [{{X, '$1'}}, Y]},
+ { [{X, Y} | '$1'], [{const, {X, Y}} | '$1']},
+ { [$p,$r,$e,$f,$i,$x | '$1'], [$p,$r,$e,$f,$i,$x | '$1']},
+ { {[{X,Y}]}, {{[{{X,Y}}]}}},
+ { {[{X,Y}]}, {{{const, [{X,Y}]}}}},
+ { {[{X,Y}]}, {{[{const,{X,Y}}]}}}
+ ]
+ end,
+
+ T2 = ets:new(x, []),
+ [lists:foreach(fun({A, B}) ->
+ %% just check that matchspec is accepted
+ 0 = ets:select_replace(T2, [{{A, '$2', '$3'}, [], [{{B, '$3', '$2'}}]}])
+ end,
+ EqPairs(X,Y)) || X <- Terms, Y <- Terms],
+
+ %% Test key-unsafe matchspecs are rejected
+ NeqPairs = fun(X, Y) ->
+ [{'$1', '$2'},
+ {{X, Y}, {X, Y}},
+ {{{X, Y}}, {{{X, Y}}}},
+ {{X}, {{{X}}}},
+ {{const, X}, {const, X}},
+ {{const, {X,Y}}, {const, {X,Y}}},
+ {'$1', {const, '$1'}},
+ {{X}, {const, {{X}}}},
+ {{X, {Y,'$1'}}, {{{const, X}, {Y,'$1'}}}},
+ {[X, Y | '$1'], [X, Y]},
+ {[X, Y], [X, Y | '$1']},
+ {[{X, '$1'}, Y], [{X, '$1'}, Y]},
+ {[$p,$r,$e,$f,$i,$x | '$1'], [$p,$r,$e,$f,$I,$x | '$1']},
+ { {[{X,Y}]}, {{[{X,Y}]}}},
+ { {[{X,Y}]}, {{{const, [{{X,Y}}]}}}},
+ { {[{X,Y}]}, {{[{const,{{X,Y}}}]}}},
+ {'_', '_'},
+ {'$_', '$_'},
+ {'$$', '$$'},
+ {#{}, #{}},
+ {#{X => '$1'}, #{X => '$1'}}
+ ]
+ end,
+
+ [lists:foreach(fun({A, B}) ->
+ %% just check that matchspec is rejected
+ {'EXIT',{badarg,_}} = (catch ets:select_replace(T2, [{{A, '$2', '$3'}, [], [{{B, '$3', '$2'}}]}]))
+ end,
+ NeqPairs(X,Y)) || X <- Terms, Y <- Terms],
+
+
+ ets:delete(T2),
+
+ verify_etsmem(EtsMem).
+
%% Test that partly bound keys gives faster matches.
partly_bound(Config) when is_list(Config) ->
case os:type() of
@@ -1193,7 +1366,7 @@ partly_bound(Config) when is_list(Config) ->
end.
dont_make_worse() ->
- seventyfive_percent_success({?MODULE,dont_make_worse_sub,[]},0,0,10).
+ seventyfive_percent_success(fun dont_make_worse_sub/0, 0, 0, 10).
dont_make_worse_sub() ->
T = build_table([a,b],[a,b],15000),
@@ -1205,8 +1378,9 @@ dont_make_worse_sub() ->
ok.
make_better() ->
- fifty_percent_success({?MODULE,make_better_sub2,[]},0,0,10),
- fifty_percent_success({?MODULE,make_better_sub1,[]},0,0,10).
+ fifty_percent_success(fun make_better_sub2/0, 0, 0, 10),
+ fifty_percent_success(fun make_better_sub1/0, 0, 0, 10).
+
make_better_sub1() ->
T = build_table2([a,b],[a,b],15000),
T1 = time_match_object(T,{'_',1500,a,a}, [{{1500,a,a},1500,a,a}]),
@@ -1491,7 +1665,7 @@ do_random_test() ->
%% Ttest various variants of update_element.
update_element(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(update_element_opts),
+ repeat_for_opts(fun update_element_opts/1),
verify_etsmem(EtsMem).
update_element_opts(Opts) ->
@@ -1653,7 +1827,7 @@ update_element_neg_do(T) ->
%% test various variants of update_counter.
update_counter(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(update_counter_do),
+ repeat_for_opts(fun update_counter_do/1),
verify_etsmem(EtsMem).
update_counter_do(Opts) ->
@@ -1874,7 +2048,7 @@ evil_update_counter(Config) when is_list(Config) ->
ordsets:module_info(),
rand:module_info(),
- repeat_for_opts(evil_update_counter_do).
+ repeat_for_opts(fun evil_update_counter_do/1).
evil_update_counter_do(Opts) ->
EtsMem = etsmem(),
@@ -1908,7 +2082,7 @@ evil_counter(I,Opts) ->
end,
Start = Start0 + rand:uniform(100000),
ets:insert(T, {dracula,Start}),
- Iter = 40000,
+ Iter = 40000 div syrup_factor(),
End = Start + Iter,
End = evil_counter_1(Iter, T),
ets:delete(T).
@@ -1921,7 +2095,7 @@ evil_counter_1(Iter, T) ->
evil_counter_1(Iter-1, T).
update_counter_with_default(Config) when is_list(Config) ->
- repeat_for_opts(update_counter_with_default_do).
+ repeat_for_opts(fun update_counter_with_default_do/1).
update_counter_with_default_do(Opts) ->
T1 = ets_new(a, [set | Opts]),
@@ -1959,7 +2133,7 @@ update_counter_with_default_do(Opts) ->
ok.
update_counter_table_growth(_Config) ->
- repeat_for_opts(update_counter_table_growth_do).
+ repeat_for_opts(fun update_counter_table_growth_do/1).
update_counter_table_growth_do(Opts) ->
Set = ets_new(b, [set | Opts]),
@@ -1970,7 +2144,8 @@ update_counter_table_growth_do(Opts) ->
%% Check that a first-next sequence always works on a fixed table.
fixtable_next(Config) when is_list(Config) ->
- repeat_for_opts(fixtable_next_do, [write_concurrency,all_types]).
+ repeat_for_opts(fun fixtable_next_do/1,
+ [write_concurrency,all_types]).
fixtable_next_do(Opts) ->
EtsMem = etsmem(),
@@ -2110,7 +2285,7 @@ write_concurrency(Config) when is_list(Config) ->
%% The 'heir' option.
heir(Config) when is_list(Config) ->
- repeat_for_opts(heir_do).
+ repeat_for_opts(fun heir_do/1).
heir_do(Opts) ->
EtsMem = etsmem(),
@@ -2250,7 +2425,7 @@ heir_1(HeirData,Mode,Opts) ->
%% Test ets:give_way/3.
give_away(Config) when is_list(Config) ->
- repeat_for_opts(give_away_do).
+ repeat_for_opts(fun give_away_do/1).
give_away_do(Opts) ->
T = ets_new(foo,[named_table, private | Opts]),
@@ -2331,7 +2506,7 @@ give_away_receiver(T, Giver) ->
%% Test ets:setopts/2.
setopts(Config) when is_list(Config) ->
- repeat_for_opts(setopts_do,[write_concurrency,all_types]).
+ repeat_for_opts(fun setopts_do/1, [write_concurrency,all_types]).
setopts_do(Opts) ->
Self = self(),
@@ -2481,7 +2656,7 @@ bad_table_call(T,{F,Args,_,{return,Return}}) ->
%% Check rename of ets tables.
rename(Config) when is_list(Config) ->
- repeat_for_opts(rename_do, [write_concurrency, all_types]).
+ repeat_for_opts(fun rename_do/1, [write_concurrency, all_types]).
rename_do(Opts) ->
EtsMem = etsmem(),
@@ -2496,7 +2671,8 @@ rename_do(Opts) ->
%% Check rename of unnamed ets table.
rename_unnamed(Config) when is_list(Config) ->
- repeat_for_opts(rename_unnamed_do,[write_concurrency,all_types]).
+ repeat_for_opts(fun rename_unnamed_do/1,
+ [write_concurrency,all_types]).
rename_unnamed_do(Opts) ->
EtsMem = etsmem(),
@@ -2571,7 +2747,7 @@ evil_create_fixed_tab() ->
%% Tests that the return values and errors are equal for set's and
%% ordered_set's where applicable.
interface_equality(Config) when is_list(Config) ->
- repeat_for_opts(interface_equality_do).
+ repeat_for_opts(fun interface_equality_do/1).
interface_equality_do(Opts) ->
EtsMem = etsmem(),
@@ -2635,7 +2811,7 @@ maybe_sort(Any) ->
%% Test match, match_object and match_delete in ordered set's.
ordered_match(Config) when is_list(Config)->
- repeat_for_opts(ordered_match_do).
+ repeat_for_opts(fun ordered_match_do/1).
ordered_match_do(Opts) ->
EtsMem = etsmem(),
@@ -2681,7 +2857,7 @@ ordered_match_do(Opts) ->
%% Test basic functionality in ordered_set's.
ordered(Config) when is_list(Config) ->
- repeat_for_opts(ordered_do).
+ repeat_for_opts(fun ordered_do/1).
ordered_do(Opts) ->
EtsMem = etsmem(),
@@ -2807,12 +2983,13 @@ keypos2(Config) when is_list(Config) ->
%% Privacy check. Check that a named(public/private/protected) table
%% cannot be read by the wrong process(es).
privacy(Config) when is_list(Config) ->
- repeat_for_opts(privacy_do).
+ repeat_for_opts(fun privacy_do/1).
privacy_do(Opts) ->
EtsMem = etsmem(),
process_flag(trap_exit,true),
- Owner = my_spawn_link(?MODULE,privacy_owner,[self(),Opts]),
+ Parent = self(),
+ Owner = my_spawn_link(fun() -> privacy_owner(Parent, Opts) end),
receive
{'EXIT',Owner,Reason} ->
exit({privacy_test,Reason});
@@ -2892,7 +3069,7 @@ rotate_tuple(Tuple, N) ->
%% Check lookup in an empty table and lookup of a non-existing key.
empty(Config) when is_list(Config) ->
- repeat_for_opts(empty_do).
+ repeat_for_opts(fun empty_do/1).
empty_do(Opts) ->
EtsMem = etsmem(),
@@ -2905,7 +3082,7 @@ empty_do(Opts) ->
%% Check proper return values for illegal insert operations.
badinsert(Config) when is_list(Config) ->
- repeat_for_opts(badinsert_do).
+ repeat_for_opts(fun badinsert_do/1).
badinsert_do(Opts) ->
EtsMem = etsmem(),
@@ -2929,7 +3106,7 @@ badinsert_do(Opts) ->
time_lookup(Config) when is_list(Config) ->
%% just for timing, really
EtsMem = etsmem(),
- Values = repeat_for_opts(time_lookup_do),
+ Values = repeat_for_opts(fun time_lookup_do/1),
verify_etsmem(EtsMem),
{comment,lists:flatten(io_lib:format(
"~p ets lookups/s",[Values]))}.
@@ -2963,7 +3140,8 @@ badlookup(Config) when is_list(Config) ->
%% Test that lookup returns objects in order of insertion for bag and dbag.
lookup_order(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(lookup_order_do, [write_concurrency,[bag,duplicate_bag]]),
+ repeat_for_opts(fun lookup_order_do/1,
+ [write_concurrency,[bag,duplicate_bag]]),
verify_etsmem(EtsMem),
ok.
@@ -3054,7 +3232,7 @@ fill_tab(Tab,Val) ->
%% OTP-2386. Multiple return elements.
lookup_element_mult(Config) when is_list(Config) ->
- repeat_for_opts(lookup_element_mult_do).
+ repeat_for_opts(fun lookup_element_mult_do/1).
lookup_element_mult_do(Opts) ->
EtsMem = etsmem(),
@@ -3092,7 +3270,8 @@ lem_crash_3(T) ->
%% Check delete of an element inserted in a `filled' table.
delete_elem(Config) when is_list(Config) ->
- repeat_for_opts(delete_elem_do, [write_concurrency, all_types]).
+ repeat_for_opts(fun delete_elem_do/1,
+ [write_concurrency, all_types]).
delete_elem_do(Opts) ->
EtsMem = etsmem(),
@@ -3109,7 +3288,8 @@ delete_elem_do(Opts) ->
%% Check that ets:delete() works and releases the name of the
%% deleted table.
delete_tab(Config) when is_list(Config) ->
- repeat_for_opts(delete_tab_do,[write_concurrency,all_types]).
+ repeat_for_opts(fun delete_tab_do/1,
+ [write_concurrency,all_types]).
delete_tab_do(Opts) ->
Name = foo,
@@ -3300,23 +3480,29 @@ evil_delete_owner(Name, Flags, Data, Fix) ->
exit_large_table_owner(Config) when is_list(Config) ->
%%Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 500000)],
- FEData = fun(Do) -> repeat_while(fun(500000) -> {false,ok};
+ Laps = 500000 div syrup_factor(),
+ FEData = fun(Do) -> repeat_while(fun(I) when I =:= Laps -> {false,ok};
(I) -> Do({erlang:phash2(I, 16#ffffff),I}),
{true, I+1}
end, 1)
end,
EtsMem = etsmem(),
- repeat_for_opts({exit_large_table_owner_do,{FEData,Config}}),
+ repeat_for_opts(fun(Opts) ->
+ exit_large_table_owner_do(Opts,
+ FEData,
+ Config)
+ end),
verify_etsmem(EtsMem).
-exit_large_table_owner_do(Opts,{FEData,Config}) ->
+exit_large_table_owner_do(Opts, FEData, Config) ->
verify_rescheduling_exit(Config, FEData, [named_table | Opts], true, 1, 1),
verify_rescheduling_exit(Config, FEData, Opts, false, 1, 1).
exit_many_large_table_owner(Config) when is_list(Config) ->
ct:timetrap({minutes,30}), %% valgrind needs a lot
%%Data = [{erlang:phash2(I, 16#ffffff),I} || I <- lists:seq(1, 500000)],
- FEData = fun(Do) -> repeat_while(fun(500000) -> {false,ok};
+ Laps = 500000 div syrup_factor(),
+ FEData = fun(Do) -> repeat_while(fun(I) when I =:= Laps -> {false,ok};
(I) -> Do({erlang:phash2(I, 16#ffffff),I}),
{true, I+1}
end, 1)
@@ -3476,7 +3662,8 @@ baddelete(Config) when is_list(Config) ->
%% Check that match_delete works. Also tests tab2list function.
match_delete(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(match_delete_do,[write_concurrency,all_types]),
+ repeat_for_opts(fun match_delete_do/1,
+ [write_concurrency,all_types]),
verify_etsmem(EtsMem).
match_delete_do(Opts) ->
@@ -3493,7 +3680,7 @@ match_delete_do(Opts) ->
%% OTP-3005: check match_delete with constant argument.
match_delete3(Config) when is_list(Config) ->
- repeat_for_opts(match_delete3_do).
+ repeat_for_opts(fun match_delete3_do/1).
match_delete3_do(Opts) ->
EtsMem = etsmem(),
@@ -3518,7 +3705,7 @@ match_delete3_do(Opts) ->
%% Test ets:first/1 & ets:next/2.
firstnext(Config) when is_list(Config) ->
- repeat_for_opts(firstnext_do).
+ repeat_for_opts(fun firstnext_do/1).
firstnext_do(Opts) ->
EtsMem = etsmem(),
@@ -3576,7 +3763,7 @@ dyn_lookup(T, K) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
slot(Config) when is_list(Config) ->
- repeat_for_opts(slot_do).
+ repeat_for_opts(fun slot_do/1).
slot_do(Opts) ->
EtsMem = etsmem(),
@@ -3601,7 +3788,7 @@ slot_loop(Tab,SlotNo,EltsSoFar) ->
match1(Config) when is_list(Config) ->
- repeat_for_opts(match1_do).
+ repeat_for_opts(fun match1_do/1).
match1_do(Opts) ->
EtsMem = etsmem(),
@@ -3637,7 +3824,7 @@ match1_do(Opts) ->
%% Test match with specified keypos bag table.
match2(Config) when is_list(Config) ->
- repeat_for_opts(match2_do).
+ repeat_for_opts(fun match2_do/1).
match2_do(Opts) ->
EtsMem = etsmem(),
@@ -3664,7 +3851,7 @@ match2_do(Opts) ->
%% Some ets:match_object tests.
match_object(Config) when is_list(Config) ->
- repeat_for_opts(match_object_do).
+ repeat_for_opts(fun match_object_do/1).
match_object_do(Opts) ->
EtsMem = etsmem(),
@@ -3764,7 +3951,7 @@ match_object_do(Opts) ->
%% Tests that db_match_object does not generate a `badarg' when
%% resuming a search with no previous matches.
match_object2(Config) when is_list(Config) ->
- repeat_for_opts(match_object2_do).
+ repeat_for_opts(fun match_object2_do/1).
match_object2_do(Opts) ->
EtsMem = etsmem(),
@@ -3800,7 +3987,7 @@ tab2list(Config) when is_list(Config) ->
%% Simple general small test. If this fails, ets is in really bad
%% shape.
misc1(Config) when is_list(Config) ->
- repeat_for_opts(misc1_do).
+ repeat_for_opts(fun misc1_do/1).
misc1_do(Opts) ->
EtsMem = etsmem(),
@@ -3818,7 +4005,7 @@ misc1_do(Opts) ->
%% Check the safe_fixtable function.
safe_fixtable(Config) when is_list(Config) ->
- repeat_for_opts(safe_fixtable_do).
+ repeat_for_opts(fun safe_fixtable_do/1).
safe_fixtable_do(Opts) ->
EtsMem = etsmem(),
@@ -3876,7 +4063,7 @@ safe_fixtable_do(Opts) ->
%% Tests ets:info result for required tuples.
info(Config) when is_list(Config) ->
- repeat_for_opts(info_do).
+ repeat_for_opts(fun info_do/1).
info_do(Opts) ->
EtsMem = etsmem(),
@@ -3908,7 +4095,7 @@ info_do(Opts) ->
%% Test various duplicate_bags stuff.
dups(Config) when is_list(Config) ->
- repeat_for_opts(dups_do).
+ repeat_for_opts(fun dups_do/1).
dups_do(Opts) ->
EtsMem = etsmem(),
@@ -3974,7 +4161,9 @@ tab2file_do(FName, Opts) ->
%% Check the ets:tab2file function on a filled set/bag type ets table.
tab2file2(Config) when is_list(Config) ->
- repeat_for_opts({tab2file2_do,Config}, [[set,bag],compressed]).
+ repeat_for_opts(fun(Opts) ->
+ tab2file2_do(Opts, Config)
+ end, [[set,bag],compressed]).
tab2file2_do(Opts, Config) ->
EtsMem = etsmem(),
@@ -4238,7 +4427,7 @@ make_sub_binary(List, Num) when is_list(List) ->
%% Perform multiple lookups for every key in a large table.
heavy_lookup(Config) when is_list(Config) ->
- repeat_for_opts(heavy_lookup_do).
+ repeat_for_opts(fun heavy_lookup_do/1).
heavy_lookup_do(Opts) ->
EtsMem = etsmem(),
@@ -4261,14 +4450,15 @@ do_lookup(Tab, N) ->
%% Perform multiple lookups for every element in a large table.
heavy_lookup_element(Config) when is_list(Config) ->
- repeat_for_opts(heavy_lookup_element_do).
+ repeat_for_opts(fun heavy_lookup_element_do/1).
heavy_lookup_element_do(Opts) ->
EtsMem = etsmem(),
Tab = ets_new(foobar_table, [set, protected, {keypos, 2} | Opts]),
ok = fill_tab2(Tab, 0, 7000),
%% lookup ALL elements 50 times
- _ = [do_lookup_element(Tab, 6999, 1) || _ <- lists:seq(1, 50)],
+ Laps = 50 div syrup_factor(),
+ _ = [do_lookup_element(Tab, 6999, 1) || _ <- lists:seq(1, Laps)],
true = ets:delete(Tab),
verify_etsmem(EtsMem).
@@ -4288,10 +4478,11 @@ do_lookup_element(Tab, N, M) ->
heavy_concurrent(Config) when is_list(Config) ->
ct:timetrap({minutes,30}), %% valgrind needs a lot of time
- repeat_for_opts(do_heavy_concurrent).
+ repeat_for_opts(fun do_heavy_concurrent/1).
do_heavy_concurrent(Opts) ->
Size = 10000,
+ Laps = 10000 div syrup_factor(),
EtsMem = etsmem(),
Tab = ets_new(blupp, [set, public, {keypos, 2} | Opts]),
ok = fill_tab2(Tab, 0, Size),
@@ -4299,7 +4490,7 @@ do_heavy_concurrent(Opts) ->
fun (N) ->
my_spawn_link(
fun () ->
- do_heavy_concurrent_proc(Tab, Size, N)
+ do_heavy_concurrent_proc(Tab, Laps, N)
end)
end,
lists:seq(1, 500)),
@@ -4372,7 +4563,7 @@ foldr_ordered(Config) when is_list(Config) ->
%% Test ets:member BIF.
member(Config) when is_list(Config) ->
- repeat_for_opts(member_do, [write_concurrency, all_types]).
+ repeat_for_opts(fun member_do/1, [write_concurrency, all_types]).
member_do(Opts) ->
EtsMem = etsmem(),
@@ -4441,40 +4632,40 @@ build_table2(L1,L2,Num) ->
T.
time_match_object(Tab,Match, Res) ->
- T1 = erlang:monotonic_time(micro_seconds),
+ T1 = erlang:monotonic_time(microsecond),
Res = ets:match_object(Tab,Match),
- T2 = erlang:monotonic_time(micro_seconds),
+ T2 = erlang:monotonic_time(microsecond),
T2 - T1.
time_match(Tab,Match) ->
- T1 = erlang:monotonic_time(micro_seconds),
+ T1 = erlang:monotonic_time(microsecond),
ets:match(Tab,Match),
- T2 = erlang:monotonic_time(micro_seconds),
+ T2 = erlang:monotonic_time(microsecond),
T2 - T1.
seventyfive_percent_success(_,S,Fa,0) ->
true = (S > ((S + Fa) * 0.75));
-seventyfive_percent_success({M,F,A},S,Fa,N) ->
- case (catch apply(M,F,A)) of
- {'EXIT', _} ->
- seventyfive_percent_success({M,F,A},S,Fa+1,N-1);
- _ ->
- seventyfive_percent_success({M,F,A},S+1,Fa,N-1)
+seventyfive_percent_success(F, S, Fa, N) when is_function(F, 0) ->
+ try F() of
+ _ ->
+ seventyfive_percent_success(F, S+1, Fa, N-1)
+ catch error:_ ->
+ seventyfive_percent_success(F, S, Fa+1, N-1)
end.
fifty_percent_success(_,S,Fa,0) ->
true = (S > ((S + Fa) * 0.5));
-fifty_percent_success({M,F,A},S,Fa,N) ->
- case (catch apply(M,F,A)) of
- {'EXIT', _} ->
- fifty_percent_success({M,F,A},S,Fa+1,N-1);
- _ ->
- fifty_percent_success({M,F,A},S+1,Fa,N-1)
+fifty_percent_success(F, S, Fa, N) when is_function(F, 0) ->
+ try F() of
+ _ ->
+ fifty_percent_success(F, S+1, Fa, N-1)
+ catch
+ error:_ ->
+ fifty_percent_success(F, S, Fa+1, N-1)
end.
-
create_random_string(0) ->
[];
@@ -4813,7 +5004,7 @@ otp_6338(Config) when is_list(Config) ->
%% Elements could come in the wrong order in a bag if a rehash occurred.
otp_5340(Config) when is_list(Config) ->
- repeat_for_opts(otp_5340_do).
+ repeat_for_opts(fun otp_5340_do/1).
otp_5340_do(Opts) ->
N = 3000,
@@ -4849,7 +5040,7 @@ verify2(_Err, _) ->
%% delete_object followed by delete on fixed bag failed to delete objects.
otp_7665(Config) when is_list(Config) ->
- repeat_for_opts(otp_7665_do).
+ repeat_for_opts(fun otp_7665_do/1).
otp_7665_do(Opts) ->
Tab = ets_new(otp_7665,[bag | Opts]),
@@ -4879,7 +5070,7 @@ otp_7665_act(Tab,Min,Max,DelNr) ->
%% Whitebox testing of meta name table hashing.
meta_wb(Config) when is_list(Config) ->
EtsMem = etsmem(),
- repeat_for_opts(meta_wb_do),
+ repeat_for_opts(fun meta_wb_do/1),
verify_etsmem(EtsMem).
@@ -5093,7 +5284,7 @@ meta_lookup_unnamed_read(Config) when is_list(Config) ->
end,
FiniF = fun(Tab) -> true = ets:delete(Tab)
end,
- run_workers(InitF,ExecF,FiniF,10000).
+ run_smp_workers(InitF,ExecF,FiniF,10000).
meta_lookup_unnamed_write(Config) when is_list(Config) ->
InitF = fun(_) -> Tab = ets_new(unnamed,[]),
@@ -5104,7 +5295,7 @@ meta_lookup_unnamed_write(Config) when is_list(Config) ->
end,
FiniF = fun({Tab,_}) -> true = ets:delete(Tab)
end,
- run_workers(InitF,ExecF,FiniF,10000).
+ run_smp_workers(InitF,ExecF,FiniF,10000).
meta_lookup_named_read(Config) when is_list(Config) ->
InitF = fun([ProcN|_]) -> Name = list_to_atom(integer_to_list(ProcN)),
@@ -5117,7 +5308,7 @@ meta_lookup_named_read(Config) when is_list(Config) ->
end,
FiniF = fun(Tab) -> true = ets:delete(Tab)
end,
- run_workers(InitF,ExecF,FiniF,10000).
+ run_smp_workers(InitF,ExecF,FiniF,10000).
meta_lookup_named_write(Config) when is_list(Config) ->
InitF = fun([ProcN|_]) -> Name = list_to_atom(integer_to_list(ProcN)),
@@ -5129,7 +5320,7 @@ meta_lookup_named_write(Config) when is_list(Config) ->
end,
FiniF = fun({Tab,_}) -> true = ets:delete(Tab)
end,
- run_workers(InitF,ExecF,FiniF,10000).
+ run_smp_workers(InitF,ExecF,FiniF,10000).
meta_newdel_unnamed(Config) when is_list(Config) ->
InitF = fun(_) -> ok end,
@@ -5137,7 +5328,7 @@ meta_newdel_unnamed(Config) when is_list(Config) ->
true = ets:delete(Tab)
end,
FiniF = fun(_) -> ok end,
- run_workers(InitF,ExecF,FiniF,10000).
+ run_smp_workers(InitF,ExecF,FiniF,10000).
meta_newdel_named(Config) when is_list(Config) ->
InitF = fun([ProcN|_]) -> list_to_atom(integer_to_list(ProcN))
@@ -5147,7 +5338,7 @@ meta_newdel_named(Config) when is_list(Config) ->
Name
end,
FiniF = fun(_) -> ok end,
- run_workers(InitF,ExecF,FiniF,10000).
+ run_smp_workers(InitF,ExecF,FiniF,10000).
%% Concurrent insert's on same table.
smp_insert(Config) when is_list(Config) ->
@@ -5156,7 +5347,7 @@ smp_insert(Config) when is_list(Config) ->
ExecF = fun(_) -> true = ets:insert(smp_insert,{rand:uniform(10000)})
end,
FiniF = fun(_) -> ok end,
- run_workers(InitF,ExecF,FiniF,100000),
+ run_smp_workers(InitF,ExecF,FiniF,100000),
verify_table_load(smp_insert),
ets:delete(smp_insert).
@@ -5179,7 +5370,7 @@ smp_fixed_delete_do() ->
{Key+Increment,Increment}
end,
FiniF = fun(_) -> ok end,
- run_workers_do(InitF,ExecF,FiniF,NumOfObjs),
+ run_sched_workers(InitF,ExecF,FiniF,NumOfObjs),
0 = ets:info(T,size),
true = ets:info(T,fixed),
Buckets = num_of_buckets(T),
@@ -5359,12 +5550,12 @@ verify_table_load(T) ->
Stats = ets:info(T,stats),
{Buckets,AvgLen,StdDev,ExpSD,_MinLen,_MaxLen,_} = Stats,
ok = if
- AvgLen > 7 ->
+ AvgLen > 1.2 ->
io:format("Table overloaded: Stats=~p\n~p\n",
[Stats, ets:info(T)]),
false;
- Buckets>256, AvgLen < 6 ->
+ Buckets>256, AvgLen < 0.47 ->
io:format("Table underloaded: Stats=~p\n~p\n",
[Stats, ets:info(T)]),
false;
@@ -5420,7 +5611,7 @@ smp_select_delete(Config) when is_list(Config) ->
end
end,
FiniF = fun(Result) -> Result end,
- Results = run_workers_do(InitF,ExecF,FiniF,20000),
+ Results = run_sched_workers(InitF,ExecF,FiniF,20000),
TotCnts = lists:foldl(fun(Diffs, Sum) -> add_lists(Sum,tuple_to_list(Diffs)) end,
lists:duplicate(Mod, 0), Results),
io:format("TotCnts = ~p\n",[TotCnts]),
@@ -5438,16 +5629,56 @@ smp_select_delete(Config) when is_list(Config) ->
Eq+1
end,
0, TotCnts),
- verify_table_load(T),
+ %% May fail as select_delete does not shrink table (enough)
+ %%verify_table_load(T),
LeftInTab = ets:select_delete(T, [{{'$1','$1'}, [], [true]}]),
0 = ets:info(T,size),
false = ets:info(T,fixed),
ets:delete(T).
+smp_select_replace(Config) when is_list(Config) ->
+ repeat_for_opts(fun smp_select_replace_do/1,
+ [[set,ordered_set,duplicate_bag]]).
+
+smp_select_replace_do(Opts) ->
+ T = ets_new(smp_select_replace,
+ [public, {write_concurrency, true} | Opts]),
+ ObjCount = 20,
+ InitF = fun (_) -> 0 end,
+ ExecF = fun (Cnt0) ->
+ CounterId = rand:uniform(ObjCount),
+ Match = [{{'$1', '$2'},
+ [{'=:=', '$1', CounterId}],
+ [{{'$1', {'+', '$2', 1}}}]}],
+ Cnt1 = case ets:select_replace(T, Match) of
+ 1 -> Cnt0+1;
+ 0 ->
+ ets:insert_new(T, {CounterId, 0}),
+ Cnt0
+ end,
+ receive stop ->
+ [end_of_work | Cnt1]
+ after 0 ->
+ Cnt1
+ end
+ end,
+ FiniF = fun (Cnt) -> Cnt end,
+ Pids = run_sched_workers(InitF, ExecF, FiniF, infinite),
+ receive after 3*1000 -> ok end,
+ [P ! stop || P <- Pids],
+ Results = wait_pids(Pids),
+ FinalCounts = ets:select(T, [{{'_', '$1'}, [], ['$1']}]),
+ Total = lists:sum(FinalCounts),
+ Total = lists:sum(Results),
+ ObjCount = ets:select_delete(T, [{{'_', '_'}, [], [true]}]),
+ 0 = ets:info(T, size),
+ true = ets:delete(T),
+ ok.
+
%% Test different types.
types(Config) when is_list(Config) ->
init_externals(),
- repeat_for_opts(types_do,[[set,ordered_set],compressed]).
+ repeat_for_opts(fun types_do/1, [[set,ordered_set],compressed]).
types_do(Opts) ->
EtsMem = etsmem(),
@@ -5506,7 +5737,7 @@ otp_9423(Config) when is_list(Config) ->
end
end,
FiniF = fun(R) -> R end,
- case run_workers(InitF, ExecF, FiniF, infinite, 1) of
+ case run_smp_workers(InitF, ExecF, FiniF, infinite, 1) of
Pids when is_list(Pids) ->
%%[P ! start || P <- Pids],
repeat(fun() -> ets:new(otp_9423, [named_table, public, {write_concurrency,true}]),
@@ -5547,6 +5778,68 @@ ets_all_run() ->
false = lists:member(Table, ets:all()),
ets_all_run().
+create_tables(N) ->
+ create_tables(N, []).
+
+create_tables(0, Ts) ->
+ Ts;
+create_tables(N, Ts) ->
+ create_tables(N-1, [ets:new(tjo, [])|Ts]).
+
+massive_ets_all(Config) when is_list(Config) ->
+ Me = self(),
+ InitTables = lists:sort(ets:all()),
+ io:format("InitTables=~p~n", [InitTables]),
+ PMs0 = lists:map(fun (Sid) ->
+ my_spawn_opt(fun () ->
+ Ts = create_tables(250),
+ Me ! {self(), up, Ts},
+ receive {Me, die} -> ok end
+ end,
+ [link, monitor, {scheduler, Sid}])
+ end,
+ lists:seq(1, erlang:system_info(schedulers_online))),
+ AllRes = lists:sort(lists:foldl(fun ({P, _M}, Ts) ->
+ receive
+ {P, up, PTs} ->
+ PTs ++ Ts
+ end
+ end,
+ InitTables,
+ PMs0)),
+ AllRes = lists:sort(ets:all()),
+ PMs1 = lists:map(fun (_) ->
+ my_spawn_opt(fun () ->
+ AllRes = lists:sort(ets:all())
+ end,
+ [link, monitor])
+ end, lists:seq(1, 50)),
+ lists:foreach(fun ({P, M}) ->
+ receive
+ {'DOWN', M, process, P, _} ->
+ ok
+ end
+ end, PMs1),
+ PMs2 = lists:map(fun (_) ->
+ my_spawn_opt(fun () ->
+ _ = ets:all()
+ end,
+ [link, monitor])
+ end, lists:seq(1, 50)),
+ lists:foreach(fun ({P, _M}) ->
+ P ! {Me, die}
+ end, PMs0),
+ lists:foreach(fun ({P, M}) ->
+ receive
+ {'DOWN', M, process, P, _} ->
+ ok
+ end
+ end, PMs0 ++ PMs2),
+ EndTables = lists:sort(ets:all()),
+ io:format("EndTables=~p~n", [EndTables]),
+ InitTables = EndTables,
+ ok.
+
take(Config) when is_list(Config) ->
%% Simple test for set tables.
@@ -5596,23 +5889,27 @@ add_lists([],[],Acc) ->
add_lists([E1|T1], [E2|T2], Acc) ->
add_lists(T1, T2, [E1+E2 | Acc]).
-run_workers(InitF,ExecF,FiniF,Laps) ->
- run_workers(InitF,ExecF,FiniF,Laps, 0).
-run_workers(InitF,ExecF,FiniF,Laps, Exclude) ->
+run_smp_workers(InitF,ExecF,FiniF,Laps) ->
+ run_smp_workers(InitF,ExecF,FiniF,Laps, 0).
+run_smp_workers(InitF,ExecF,FiniF,Laps, Exclude) ->
case erlang:system_info(smp_support) of
true ->
- run_workers_do(InitF,ExecF,FiniF,Laps, Exclude);
+ case erlang:system_info(schedulers_online) of
+ N when N > Exclude ->
+ run_workers_do(InitF,ExecF,FiniF,Laps, N - Exclude);
+ _ ->
+ {skipped, "Too few schedulers online"}
+ end;
false ->
{skipped,"No smp support"}
end.
-run_workers_do(InitF,ExecF,FiniF,Laps) ->
- run_workers_do(InitF,ExecF,FiniF,Laps, 0).
-run_workers_do(InitF,ExecF,FiniF,Laps, Exclude) ->
- NumOfProcs = case erlang:system_info(schedulers) of
- N when (N > Exclude) -> N - Exclude
- end,
- io:format("smp starting ~p workers\n",[NumOfProcs]),
+run_sched_workers(InitF,ExecF,FiniF,Laps) ->
+ run_workers_do(InitF,ExecF,FiniF,Laps,
+ erlang:system_info(schedulers)).
+
+run_workers_do(InitF,ExecF,FiniF,Laps, NumOfProcs) ->
+ io:format("starting ~p workers\n",[NumOfProcs]),
Seeds = [{ProcN,rand:uniform(9999)} || ProcN <- lists:seq(1,NumOfProcs)],
Parent = self(),
Pids = [my_spawn_link(fun()-> worker(Seed,InitF,ExecF,FiniF,Laps,Parent,NumOfProcs) end)
@@ -5726,15 +6023,15 @@ verify_etsmem({MemInfo,AllTabs}) ->
%% Use 'erl +Mea max' to do more complete memory leak testing.
{comment,"Incomplete or no mem leak testing"};
_ ->
- ok
+ ok
end;
+
{MemInfo2, AllTabs2} ->
io:format("Expected: ~p", [MemInfo]),
io:format("Actual: ~p", [MemInfo2]),
io:format("Changed tables before: ~p\n",[AllTabs -- AllTabs2]),
io:format("Changed tables after: ~p\n", [AllTabs2 -- AllTabs]),
- ets_test_spawn_logger ! {failed_memcheck, get('__ETS_TEST_CASE__')},
- {comment, "Failed memory check"}
+ ct:fail("Failed memory check")
end.
@@ -5756,10 +6053,10 @@ stop_loopers(Loopers) ->
looper(Fun, State) ->
looper(Fun, Fun(State)).
-spawn_logger(Procs, FailedMemchecks) ->
+spawn_logger(Procs) ->
receive
{new_test_proc, Proc} ->
- spawn_logger([Proc|Procs], FailedMemchecks);
+ spawn_logger([Proc|Procs]);
{sync_test_procs, Kill, From} ->
lists:foreach(fun (Proc) when From == Proc ->
ok;
@@ -5783,14 +6080,7 @@ spawn_logger(Procs, FailedMemchecks) ->
end
end, Procs),
From ! test_procs_synced,
- spawn_logger([From], FailedMemchecks);
-
- {failed_memcheck, TestCase} ->
- spawn_logger(Procs, [TestCase|FailedMemchecks]);
-
- {Pid, get_failed_memchecks} ->
- Pid ! {get_failed_memchecks, FailedMemchecks},
- spawn_logger(Procs, FailedMemchecks)
+ spawn_logger([From])
end.
pid_status(Pid) ->
@@ -5806,7 +6096,7 @@ start_spawn_logger() ->
case whereis(ets_test_spawn_logger) of
Pid when is_pid(Pid) -> true;
_ -> register(ets_test_spawn_logger,
- spawn_opt(fun () -> spawn_logger([], []) end,
+ spawn_opt(fun () -> spawn_logger([]) end,
[{priority, max}]))
end.
@@ -5831,12 +6121,8 @@ log_test_proc(Proc) when is_pid(Proc) ->
Proc.
my_spawn(Fun) -> log_test_proc(spawn(Fun)).
-%%my_spawn(M,F,A) -> log_test_proc(spawn(M,F,A)).
-%%my_spawn(N,M,F,A) -> log_test_proc(spawn(N,M,F,A)).
my_spawn_link(Fun) -> log_test_proc(spawn_link(Fun)).
-my_spawn_link(M,F,A) -> log_test_proc(spawn_link(M,F,A)).
-%%my_spawn_link(N,M,F,A) -> log_test_proc(spawn_link(N,M,F,A)).
my_spawn_opt(Fun,Opts) ->
case spawn_opt(Fun,Opts) of
@@ -5933,7 +6219,6 @@ only_if_smp(Schedulers, Func) ->
end.
%% Copy-paste from emulator/test/binary_SUITE.erl
--define(heap_binary_size, 64).
test_terms(Test_Func, Mode) ->
garbage_collect(),
Pib0 = process_info(self(),binary),
@@ -6079,7 +6364,7 @@ make_port() ->
open_port({spawn, "efile"}, [eof]).
make_pid() ->
- spawn_link(?MODULE, sleeper, []).
+ spawn_link(fun sleeper/0).
sleeper() ->
receive after infinity -> ok end.
@@ -6215,11 +6500,7 @@ make_unaligned_sub_binary(List) ->
repeat_for_opts(F) ->
repeat_for_opts(F, [write_concurrency, read_concurrency, compressed]).
-repeat_for_opts(F, OptGenList) when is_atom(F) ->
- repeat_for_opts(fun(Opts) -> ?MODULE:F(Opts) end, OptGenList);
-repeat_for_opts({F,Args}, OptGenList) when is_atom(F) ->
- repeat_for_opts(fun(Opts) -> ?MODULE:F(Opts,Args) end, OptGenList);
-repeat_for_opts(F, OptGenList) ->
+repeat_for_opts(F, OptGenList) when is_function(F, 1) ->
repeat_for_opts(F, OptGenList, []).
repeat_for_opts(F, [], Acc) ->
@@ -6255,5 +6536,11 @@ do_tc(Do, Report) ->
T1 = erlang:monotonic_time(),
Do(),
T2 = erlang:monotonic_time(),
- Elapsed = erlang:convert_time_unit(T2 - T1, native, milli_seconds),
+ Elapsed = erlang:convert_time_unit(T2 - T1, native, millisecond),
Report(Elapsed).
+
+syrup_factor() ->
+ case erlang:system_info(build_type) of
+ valgrind -> 20;
+ _ -> 1
+ end.
diff --git a/lib/stdlib/test/ets_tough_SUITE.erl b/lib/stdlib/test/ets_tough_SUITE.erl
index 49aba7a529..0abce3200f 100644
--- a/lib/stdlib/test/ets_tough_SUITE.erl
+++ b/lib/stdlib/test/ets_tough_SUITE.erl
@@ -19,10 +19,15 @@
%%
-module(ets_tough_SUITE).
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2,ex1/1]).
--export([init/1,terminate/2,handle_call/3,handle_info/2]).
+ init_per_group/2,end_per_group/2,
+ ex1/1]).
-export([init_per_testcase/2, end_per_testcase/2]).
--compile([export_all]).
+
+%% gen_server behavior.
+-behavior(gen_server).
+-export([init/1,terminate/2,handle_call/3,handle_cast/2,
+ handle_info/2,code_change/3]).
+
-include_lib("common_test/include/ct.hrl").
suite() ->
@@ -235,33 +240,6 @@ random_element(T) ->
I = rand:uniform(tuple_size(T)),
element(I,T).
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-show_table(N) ->
- FileName = ["etsdump.",integer_to_list(N)],
- case file:open(FileName,read) of
- {ok,Fd} ->
- show_entries(Fd);
- _ ->
- error
- end.
-
-show_entries(Fd) ->
- case phys_read_len(Fd) of
- {ok,Len} ->
- case phys_read_entry(Fd,Len) of
- {ok,ok} ->
- ok;
- {ok,{Key,Val}} ->
- io:format("~w\n",[{Key,Val}]),
- show_entries(Fd);
- _ ->
- error
- end;
- _ ->
- error
- end.
-
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -378,20 +356,6 @@ dget_class(ServerPid,Class,Condition) ->
derase_class(ServerPid,Class) ->
gen_server:call(ServerPid,{handle_delete_class,Class}, infinity).
-%%% dmodify(ServerPid,Application) -> ok
-%%%
-%%% Applies a function on every instance in the database.
-%%% The user provided function must always return one of the
-%%% terms {ok,NewItem}, true, or false.
-%%% Aug 96, this is only used to reset all timestamp values
-%%% in the database.
-%%% The function is supplied as Application = {Mod, Fun, ExtraArgs},
-%%% where the instance will be prepended to ExtraArgs before each
-%%% call is made.
-
-dmodify(ServerPid,Application) ->
- gen_server:call(ServerPid,{handle_dmodify,Application}, infinity).
-
%%% ddump_first(ServerPid,DumpDir) -> {dump_more,Ticket} | already_dumping
%%%
%%% Starts dumping the database. This call redirects all database updates
@@ -643,9 +607,15 @@ handle_call(stop,_From,Admin) ->
?ets_delete(Admin), % Make sure table is gone before reply is sent.
{stop, normal, ok, []}.
+handle_cast(_Req, Admin) ->
+ {noreply, Admin}.
+
handle_info({'EXIT',_Pid,_Reason},Admin) ->
{stop,normal,Admin}.
+code_change(_OldVsn, StateData, _Extra) ->
+ {ok, StateData}.
+
handle_delete(Class, Key, Admin) ->
handle_call({handle_delete,Class,Key},from,Admin).
diff --git a/lib/stdlib/test/filelib_SUITE.erl b/lib/stdlib/test/filelib_SUITE.erl
index 4f8936edbf..6133a3ded4 100644
--- a/lib/stdlib/test/filelib_SUITE.erl
+++ b/lib/stdlib/test/filelib_SUITE.erl
@@ -25,7 +25,8 @@
init_per_testcase/2,end_per_testcase/2,
wildcard_one/1,wildcard_two/1,wildcard_errors/1,
fold_files/1,otp_5960/1,ensure_dir_eexist/1,ensure_dir_symlink/1,
- wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1]).
+ wildcard_symlink/1, is_file_symlink/1, file_props_symlink/1,
+ find_source/1]).
-import(lists, [foreach/2]).
@@ -45,7 +46,8 @@ suite() ->
all() ->
[wildcard_one, wildcard_two, wildcard_errors,
fold_files, otp_5960, ensure_dir_eexist, ensure_dir_symlink,
- wildcard_symlink, is_file_symlink, file_props_symlink].
+ wildcard_symlink, is_file_symlink, file_props_symlink,
+ find_source].
groups() ->
[].
@@ -503,3 +505,57 @@ file_props_symlink(Config) ->
FileSize = filelib:file_size(Alias, erl_prim_loader),
FileSize = filelib:file_size(Alias, prim_file)
end.
+
+find_source(Config) when is_list(Config) ->
+ %% filename:find_{file,source}() does not work if the files are
+ %% cover-compiled. To make sure that the test does not fail
+ %% when the STDLIB is cover-compiled, search for modules in
+ %% the compiler application.
+
+ BeamFile = code:which(compile),
+ BeamName = filename:basename(BeamFile),
+ BeamDir = filename:dirname(BeamFile),
+ SrcName = filename:basename(BeamFile, ".beam") ++ ".erl",
+
+ {ok, BeamFile} = filelib:find_file(BeamName, BeamDir),
+ {ok, BeamFile} = filelib:find_file(BeamName, BeamDir, []),
+ {ok, BeamFile} = filelib:find_file(BeamName, BeamDir, [{"",""},{"ebin","src"}]),
+ {error, not_found} = filelib:find_file(BeamName, BeamDir, [{"ebin","src"}]),
+
+ {ok, SrcFile} = filelib:find_file(SrcName, BeamDir),
+ {ok, SrcFile} = filelib:find_file(SrcName, BeamDir, []),
+ {ok, SrcFile} = filelib:find_file(SrcName, BeamDir, [{"foo","bar"},{"ebin","src"}]),
+ {error, not_found} = filelib:find_file(SrcName, BeamDir, [{"",""}]),
+
+ {ok, SrcFile} = filelib:find_source(BeamFile),
+ {ok, SrcFile} = filelib:find_source(BeamName, BeamDir),
+ {ok, SrcFile} = filelib:find_source(BeamName, BeamDir,
+ [{".erl",".yrl",[{"",""}]},
+ {".beam",".erl",[{"ebin","src"}]}]),
+ {error, not_found} = filelib:find_source(BeamName, BeamDir,
+ [{".erl",".yrl",[{"",""}]}]),
+
+ {ok, ParserErl} = filelib:find_source(code:which(core_parse)),
+ {ok, ParserYrl} = filelib:find_source(ParserErl),
+ "lry." ++ _ = lists:reverse(ParserYrl),
+ {ok, ParserYrl} = filelib:find_source(ParserErl,
+ [{".beam",".erl",[{"ebin","src"}]},
+ {".erl",".yrl",[{"",""}]}]),
+
+ %% find_source automatically checks the local directory regardless of rules
+ {ok, ParserYrl} = filelib:find_source(ParserErl),
+ {ok, ParserYrl} = filelib:find_source(ParserErl,
+ [{".beam",".erl",[{"ebin","src"}]}]),
+
+ %% find_file does not check the local directory unless in the rules
+ ParserYrlName = filename:basename(ParserYrl),
+ ParserYrlDir = filename:dirname(ParserYrl),
+ {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir,
+ [{"",""}]),
+ {error, not_found} = filelib:find_file(ParserYrlName, ParserYrlDir,
+ [{"ebin","src"}]),
+
+ %% local directory is in the default list for find_file
+ {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir),
+ {ok, ParserYrl} = filelib:find_file(ParserYrlName, ParserYrlDir, []),
+ ok.
diff --git a/lib/stdlib/test/filename_SUITE.erl b/lib/stdlib/test/filename_SUITE.erl
index d48b75fde8..dc3daa56c1 100644
--- a/lib/stdlib/test/filename_SUITE.erl
+++ b/lib/stdlib/test/filename_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1997-2017. All Rights Reserved.
+%% Copyright Ericsson AB 1997-2016. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -423,8 +423,10 @@ t_nativename(Config) when is_list(Config) ->
find_src(Config) when is_list(Config) ->
{Source,_} = filename:find_src(file),
["file"|_] = lists:reverse(filename:split(Source)),
- {_,_} = filename:find_src(init, [{".","."}, {"ebin","src"}]),
-
+ {Source,_} = filename:find_src(file, [{"",""}, {"ebin","src"}]),
+ {Source,_} = filename:find_src(Source),
+ {Source,_} = filename:find_src(Source ++ ".erl"),
+
%% Try to find the source for a preloaded module.
{error,{preloaded,init}} = filename:find_src(init),
diff --git a/lib/stdlib/test/gen_event_SUITE.erl b/lib/stdlib/test/gen_event_SUITE.erl
index 4415c2d09d..9a7400c84e 100644
--- a/lib/stdlib/test/gen_event_SUITE.erl
+++ b/lib/stdlib/test/gen_event_SUITE.erl
@@ -21,22 +21,24 @@
-include_lib("common_test/include/ct.hrl").
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2]).
-export([start/1, add_handler/1, add_sup_handler/1,
delete_handler/1, swap_handler/1, swap_sup_handler/1,
notify/1, sync_notify/1, call/1, info/1, hibernate/1,
call_format_status/1, call_format_status_anon/1,
- error_format_status/1, get_state/1, replace_state/1]).
+ error_format_status/1, get_state/1, replace_state/1,
+ start_opt/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
-all() ->
+all() ->
[start, {group, test_all}, hibernate,
call_format_status, call_format_status_anon, error_format_status,
- get_state, replace_state].
+ get_state, replace_state,
+ start_opt].
-groups() ->
+groups() ->
[{test_all, [],
[add_handler, add_sup_handler, delete_handler,
swap_handler, swap_sup_handler, notify, sync_notify,
@@ -59,6 +61,9 @@ end_per_group(_GroupName, Config) ->
%% Start an event manager.
%% --------------------------------------
+-define(LMGR, {local, my_dummy_name}).
+-define(GMGR, {global, my_dummy_name}).
+
start(Config) when is_list(Config) ->
OldFl = process_flag(trap_exit, true),
@@ -72,40 +77,36 @@ start(Config) when is_list(Config) ->
[] = gen_event:which_handlers(Pid1),
ok = gen_event:stop(Pid1),
- {ok, Pid2} = gen_event:start({local, my_dummy_name}),
+ {ok, Pid2} = gen_event:start(?LMGR),
[] = gen_event:which_handlers(my_dummy_name),
[] = gen_event:which_handlers(Pid2),
ok = gen_event:stop(my_dummy_name),
- {ok, Pid3} = gen_event:start_link({local, my_dummy_name}),
+ {ok, Pid3} = gen_event:start_link(?LMGR),
[] = gen_event:which_handlers(my_dummy_name),
[] = gen_event:which_handlers(Pid3),
ok = gen_event:stop(my_dummy_name),
- {ok, Pid4} = gen_event:start_link({global, my_dummy_name}),
- [] = gen_event:which_handlers({global, my_dummy_name}),
+ {ok, Pid4} = gen_event:start_link(?GMGR),
+ [] = gen_event:which_handlers(?GMGR),
[] = gen_event:which_handlers(Pid4),
- ok = gen_event:stop({global, my_dummy_name}),
+ ok = gen_event:stop(?GMGR),
{ok, Pid5} = gen_event:start_link({via, dummy_via, my_dummy_name}),
[] = gen_event:which_handlers({via, dummy_via, my_dummy_name}),
[] = gen_event:which_handlers(Pid5),
ok = gen_event:stop({via, dummy_via, my_dummy_name}),
- {ok, _} = gen_event:start_link({local, my_dummy_name}),
- {error, {already_started, _}} =
- gen_event:start_link({local, my_dummy_name}),
- {error, {already_started, _}} =
- gen_event:start({local, my_dummy_name}),
+ {ok, _} = gen_event:start_link(?LMGR),
+ {error, {already_started, _}} = gen_event:start_link(?LMGR),
+ {error, {already_started, _}} = gen_event:start(?LMGR),
ok = gen_event:stop(my_dummy_name),
- {ok, Pid6} = gen_event:start_link({global, my_dummy_name}),
- {error, {already_started, _}} =
- gen_event:start_link({global, my_dummy_name}),
- {error, {already_started, _}} =
- gen_event:start({global, my_dummy_name}),
+ {ok, Pid6} = gen_event:start_link(?GMGR),
+ {error, {already_started, _}} = gen_event:start_link(?GMGR),
+ {error, {already_started, _}} = gen_event:start(?GMGR),
- ok = gen_event:stop({global, my_dummy_name}, shutdown, 10000),
+ ok = gen_event:stop(?GMGR, shutdown, 10000),
receive
{'EXIT', Pid6, shutdown} -> ok
after 10000 ->
@@ -113,10 +114,8 @@ start(Config) when is_list(Config) ->
end,
{ok, Pid7} = gen_event:start_link({via, dummy_via, my_dummy_name}),
- {error, {already_started, _}} =
- gen_event:start_link({via, dummy_via, my_dummy_name}),
- {error, {already_started, _}} =
- gen_event:start({via, dummy_via, my_dummy_name}),
+ {error, {already_started, _}} = gen_event:start_link({via, dummy_via, my_dummy_name}),
+ {error, {already_started, _}} = gen_event:start({via, dummy_via, my_dummy_name}),
exit(Pid7, shutdown),
receive
@@ -128,6 +127,83 @@ start(Config) when is_list(Config) ->
process_flag(trap_exit, OldFl),
ok.
+start_opt(Config) when is_list(Config) ->
+ OldFl = process_flag(trap_exit, true),
+
+ dummy_via:reset(),
+
+ {ok, Pid0} = gen_event:start([]), %anonymous
+ [] = gen_event:which_handlers(Pid0),
+ ok = gen_event:stop(Pid0),
+
+ {ok, Pid1} = gen_event:start_link([]), %anonymous
+ [] = gen_event:which_handlers(Pid1),
+ ok = gen_event:stop(Pid1),
+
+ {ok, Pid2} = gen_event:start(?LMGR, []),
+ [] = gen_event:which_handlers(my_dummy_name),
+ [] = gen_event:which_handlers(Pid2),
+ ok = gen_event:stop(my_dummy_name),
+
+ {ok, Pid3} = gen_event:start_link(?LMGR, []),
+ [] = gen_event:which_handlers(my_dummy_name),
+ [] = gen_event:which_handlers(Pid3),
+ ok = gen_event:stop(my_dummy_name),
+
+ {ok, Pid4} = gen_event:start_link(?GMGR, []),
+ [] = gen_event:which_handlers(?GMGR),
+ [] = gen_event:which_handlers(Pid4),
+ ok = gen_event:stop(?GMGR),
+
+ {ok, Pid5} = gen_event:start_link({via, dummy_via, my_dummy_name}, []),
+ [] = gen_event:which_handlers({via, dummy_via, my_dummy_name}),
+ [] = gen_event:which_handlers(Pid5),
+ ok = gen_event:stop({via, dummy_via, my_dummy_name}),
+
+ {ok, _} = gen_event:start_link(?LMGR, []),
+ {error, {already_started, _}} = gen_event:start_link(?LMGR, []),
+ {error, {already_started, _}} = gen_event:start(?LMGR, []),
+ ok = gen_event:stop(my_dummy_name),
+
+ {ok, Pid7} = gen_event:start_link(?GMGR),
+ {error, {already_started, _}} = gen_event:start_link(?GMGR, []),
+ {error, {already_started, _}} = gen_event:start(?GMGR, []),
+
+ ok = gen_event:stop(?GMGR, shutdown, 10000),
+ receive
+ {'EXIT', Pid7, shutdown} -> ok
+ after 10000 ->
+ ct:fail(exit_gen_event)
+ end,
+
+ {ok, Pid8} = gen_event:start_link({via, dummy_via, my_dummy_name}),
+ {error, {already_started, _}} = gen_event:start_link({via, dummy_via, my_dummy_name}, []),
+ {error, {already_started, _}} = gen_event:start({via, dummy_via, my_dummy_name}, []),
+
+ exit(Pid8, shutdown),
+ receive
+ {'EXIT', Pid8, shutdown} -> ok
+ after 10000 ->
+ ct:fail(exit_gen_event)
+ end,
+
+ %% test spawn_opt
+ MinHeapSz = 10000,
+ {ok, Pid9} = gen_event:start_link(?LMGR, [{spawn_opt, [{min_heap_size, MinHeapSz}]}]),
+ {error, {already_started, _}} = gen_event:start_link(?LMGR, []),
+ {error, {already_started, _}} = gen_event:start(?LMGR, []),
+ {heap_size, HeapSz} = erlang:process_info(Pid9, heap_size),
+ true = HeapSz > MinHeapSz,
+ ok = gen_event:stop(my_dummy_name),
+
+ %% test debug opt
+ {ok, _} = gen_event:start_link(?LMGR, [{debug,[debug]}]),
+ {error, {already_started, _}} = gen_event:start_link(?LMGR, []),
+ {error, {already_started, _}} = gen_event:start(?LMGR, []),
+ ok = gen_event:stop(my_dummy_name),
+
+ process_flag(trap_exit, OldFl),
+ ok.
hibernate(Config) when is_list(Config) ->
{ok,Pid} = gen_event:start({local, my_dummy_handler}),
diff --git a/lib/stdlib/test/gen_server_SUITE.erl b/lib/stdlib/test/gen_server_SUITE.erl
index 338cd3dc0a..6888cb8c58 100644
--- a/lib/stdlib/test/gen_server_SUITE.erl
+++ b/lib/stdlib/test/gen_server_SUITE.erl
@@ -375,12 +375,14 @@ crash(Config) when is_list(Config) ->
%% from gen_server.
{ok,Pid4} = gen_server:start(?MODULE, {state,state4}, []),
{'EXIT',{crashed,_}} = (catch gen_server:call(Pid4, crash)),
+ ClientPid = self(),
receive
{error,_GroupLeader4,{Pid4,
"** Generic server"++_,
[Pid4,crash,{formatted, state4},
{crashed,[{?MODULE,handle_call,3,_}
- |_Stacktrace]}]}} ->
+ |_Stacktrace]},
+ ClientPid, [_|_] = _ClientStack]}} ->
ok;
Other4a ->
io:format("Unexpected: ~p", [Other4a]),
@@ -1115,12 +1117,14 @@ error_format_status(Config) when is_list(Config) ->
{'EXIT', Pid, crashed} ->
ok
end,
+ ClientPid = self(),
receive
{error,_GroupLeader,{Pid,
"** Generic server"++_,
[Pid,crash,{formatted, State},
{crashed,[{?MODULE,handle_call,3,_}
- |_Stacktrace]}]}} ->
+ |_Stacktrace]},
+ ClientPid, [_|_] = _ClientStack]}} ->
ok;
Other ->
io:format("Unexpected: ~p", [Other]),
@@ -1138,12 +1142,14 @@ terminate_crash_format(Config) when is_list(Config) ->
{ok, Pid} = gen_server:start_link(?MODULE, {state, State}, []),
gen_server:call(Pid, stop),
receive {'EXIT', Pid, {crash, terminate}} -> ok end,
+ ClientPid = self(),
receive
{error,_GroupLeader,{Pid,
"** Generic server"++_,
[Pid,stop, {formatted, State},
- {{crash, terminate},[{?MODULE,terminate,2,_}
- |_Stacktrace]}]}} ->
+ {{crash, terminate},
+ [{?MODULE,terminate,2,_}|_Stacktrace]},
+ ClientPid, [_|_] = _ClientStack]}} ->
ok;
Other ->
io:format("Unexpected: ~p", [Other]),
diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl
index 99ac0c3951..ac27c9fc79 100644
--- a/lib/stdlib/test/gen_statem_SUITE.erl
+++ b/lib/stdlib/test/gen_statem_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2016-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2016. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -505,10 +505,10 @@ abnormal2(Config) ->
{ok,Pid} = gen_statem:start_link(?MODULE, start_arg(Config, []), []),
%% bad return value in the gen_statem loop
- {{bad_return_from_state_function,badreturn},_} =
+ {{{bad_return_from_state_function,badreturn},_},_} =
?EXPECT_FAILURE(gen_statem:call(Pid, badreturn), Reason),
receive
- {'EXIT',Pid,{bad_return_from_state_function,badreturn}} -> ok
+ {'EXIT',Pid,{{bad_return_from_state_function,badreturn},_}} -> ok
after 5000 ->
ct:fail(gen_statem_did_not_die)
end,
@@ -984,7 +984,7 @@ error_format_status(Config) ->
gen_statem:start(
?MODULE, start_arg(Config, {data,Data}), []),
%% bad return value in the gen_statem loop
- {{bad_return_from_state_function,badreturn},_} =
+ {{{bad_return_from_state_function,badreturn},_},_} =
?EXPECT_FAILURE(gen_statem:call(Pid, badreturn), Reason),
receive
{error,_,
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index 6e99619324..b2754e47ba 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_SUITE.erl
@@ -30,7 +30,8 @@
io_lib_print_binary_depth_one/1, otp_10302/1, otp_10755/1,
otp_10836/1, io_lib_width_too_small/1,
io_with_huge_message_queue/1, format_string/1,
- maps/1, coverage/1, otp_14175/1]).
+ maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1,
+ otp_14285/1]).
-export([pretty/2]).
@@ -61,7 +62,8 @@ all() ->
printable_range, bad_printable_range,
io_lib_print_binary_depth_one, otp_10302, otp_10755, otp_10836,
io_lib_width_too_small, io_with_huge_message_queue,
- format_string, maps, coverage, otp_14175].
+ format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175,
+ otp_14285].
%% Error cases for output.
error_1(Config) when is_list(Config) ->
@@ -755,6 +757,8 @@ rfd(rrrrr, 3) ->
[f1, f2, f3];
rfd(aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa, 0) ->
[];
+rfd('\x{400}', 1) ->
+ ['\x{400}'];
rfd(_, _) ->
no.
@@ -1881,6 +1885,7 @@ otp_10302(Suite) when is_list(Suite) ->
pretty(Term, Depth) when is_integer(Depth) ->
Opts = [{column, 1}, {line_length, 20},
{depth, Depth}, {max_chars, 60},
+ {record_print_fun, fun rfd/2},
{encoding, unicode}],
pretty(Term, Opts);
pretty(Term, Opts) when is_list(Opts) ->
@@ -2107,6 +2112,27 @@ coverage(_Config) ->
ok.
+%% Test UTF-8 atoms.
+otp_14178_unicode_atoms(_Config) ->
+ "atom" = fmt("~ts", ['atom']),
+ "кирилли́ческий атом" = fmt("~ts", ['кирилли́ческий атом']),
+ [16#10FFFF] = fmt("~ts", ['\x{10FFFF}']),
+
+ %% ~s must not accept code points greater than 255.
+ bad_io_lib_format("~s", ['\x{100}']),
+ bad_io_lib_format("~s", ['кирилли́ческий атом']),
+
+ ok.
+
+bad_io_lib_format(F, S) ->
+ try io_lib:format(F, S) of
+ _ ->
+ ct:fail({should_fail,F,S})
+ catch
+ error:badarg ->
+ ok
+ end.
+
otp_14175(_Config) ->
"..." = p(#{}, 0),
"#{}" = p(#{}, 1),
@@ -2303,3 +2329,23 @@ text1([T|Ts]) ->
[erl_anno:text(Anno) | text1(Ts)].
-endif. % EXACT
+
+otp_14285(_Config) ->
+ UOpts = [{record_print_fun, fun rfd/2},
+ {encoding, unicode}],
+ LOpts = [{record_print_fun, fun rfd/2},
+ {encoding, latin1}],
+
+ RT = {'\x{400}','\x{400}'},
+ "#'\x{400}'{'\x{400}' = '\x{400}'}" = pretty(RT, UOpts),
+ "#'\\x{400}'{'\\x{400}' = '\\x{400}'}" = pretty(RT, LOpts),
+
+ Chars = lists:seq(0, 512),
+ [] = [C ||
+ C <- Chars,
+ S <- io_lib:write_atom_as_latin1(list_to_atom([C])),
+ not is_latin1(S)],
+ L1 = [S || C <- Chars, S <- io_lib:write_atom(list_to_atom([C])),
+ not is_latin1(S)],
+ L1 = lists:seq(256, 512),
+ ok.
diff --git a/lib/stdlib/test/io_proto_SUITE.erl b/lib/stdlib/test/io_proto_SUITE.erl
index 1e286a9306..db321d7490 100644
--- a/lib/stdlib/test/io_proto_SUITE.erl
+++ b/lib/stdlib/test/io_proto_SUITE.erl
@@ -1715,7 +1715,7 @@ toerl_loop(Port,Acc) ->
end.
millistamp() ->
- erlang:monotonic_time(milli_seconds).
+ erlang:monotonic_time(millisecond).
get_data_within(Port, X, Acc) when X =< 0 ->
?dbg({get_data_within, X, Acc, ?LINE}),
diff --git a/lib/stdlib/test/lists_SUITE.erl b/lib/stdlib/test/lists_SUITE.erl
index 531e97e8d6..5f2d8f0f4e 100644
--- a/lib/stdlib/test/lists_SUITE.erl
+++ b/lib/stdlib/test/lists_SUITE.erl
@@ -121,7 +121,7 @@ groups() ->
{zip, [parallel], [zip_unzip, zip_unzip3, zipwith, zipwith3]},
{misc, [parallel], [reverse, member, dropwhile, takewhile,
filter_partition, suffix, subtract, join,
- hof]}
+ hof, droplast]}
].
init_per_suite(Config) ->
diff --git a/lib/stdlib/test/math_SUITE.erl b/lib/stdlib/test/math_SUITE.erl
new file mode 100644
index 0000000000..2b29e44228
--- /dev/null
+++ b/lib/stdlib/test/math_SUITE.erl
@@ -0,0 +1,92 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(math_SUITE).
+
+-include_lib("common_test/include/ct.hrl").
+
+%% Test server specific exports
+-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]).
+
+%% Test cases
+-export([floor_ceil/1]).
+
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]},
+ {timetrap,{minutes,1}}].
+
+all() ->
+ [floor_ceil].
+
+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) ->
+ Config.
+
+end_per_testcase(_Case, _Config) ->
+ ok.
+
+floor_ceil(_Config) ->
+ MinusZero = 0.0/(-1.0),
+ -43.0 = do_floor_ceil(-42.1),
+ -43.0 = do_floor_ceil(-42.7),
+ 0.0 = do_floor_ceil(MinusZero),
+ 10.0 = do_floor_ceil(10.1),
+ 10.0 = do_floor_ceil(10.9),
+
+ -533.0 = do_floor_ceil(-533.0),
+ 453555.0 = do_floor_ceil(453555.0),
+
+ -58.0 = do_floor_ceil(-58),
+ 777.0 = do_floor_ceil(777),
+
+ ok.
+
+do_floor_ceil(Val) ->
+ Floor = math:floor(Val),
+ Ceil = math:ceil(Val),
+
+ true = is_float(Floor),
+ true = is_float(Ceil),
+
+ if
+ Floor =:= Ceil ->
+ Floor;
+ true ->
+ 1.0 = Ceil - Floor,
+ Floor
+ end.
diff --git a/lib/stdlib/test/proc_lib_SUITE.erl b/lib/stdlib/test/proc_lib_SUITE.erl
index 416650e27e..a53e99afc9 100644
--- a/lib/stdlib/test/proc_lib_SUITE.erl
+++ b/lib/stdlib/test/proc_lib_SUITE.erl
@@ -26,7 +26,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
- crash/1, sync_start_nolink/1, sync_start_link/1,
+ crash/1, stacktrace/1, sync_start_nolink/1, sync_start_link/1,
spawn_opt/1, sp1/0, sp2/0, sp3/1, sp4/2, sp5/1,
hibernate/1, stop/1, t_format/1]).
-export([ otp_6345/1, init_dont_hang/1]).
@@ -50,7 +50,7 @@
suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
- [crash, {group, sync_start}, spawn_opt, hibernate,
+ [crash, stacktrace, {group, sync_start}, spawn_opt, hibernate,
{group, tickets}, stop, t_format].
groups() ->
@@ -198,6 +198,31 @@ match_info(Tuple1, Tuple2) when tuple_size(Tuple1) =:= tuple_size(Tuple2) ->
match_info(_, _) ->
throw(no_match).
+stacktrace(Config) when is_list(Config) ->
+ process_flag(trap_exit, true),
+ %% Errors.
+ Pid1 = proc_lib:spawn_link(fun() -> 1 = 2 end),
+ receive
+ {'EXIT',Pid1,{{badmatch,2},_Stack1}} -> ok
+ after 500 ->
+ ct:fail(error)
+ end,
+ %% Exits.
+ Pid2 = proc_lib:spawn_link(fun() -> exit(bye) end),
+ receive
+ {'EXIT',Pid2,bye} -> ok
+ after 500 ->
+ ct:fail(exit)
+ end,
+ %% Throws.
+ Pid3 = proc_lib:spawn_link(fun() -> throw(ball) end),
+ receive
+ {'EXIT',Pid3,{{nocatch,ball},_Stack3}} -> ok
+ after 500 ->
+ ct:fail(throw)
+ end,
+ ok.
+
sync_start_nolink(Config) when is_list(Config) ->
_Pid = spawn_link(?MODULE, sp5, [self()]),
receive
@@ -457,7 +482,7 @@ stop(_Config) ->
%% System message is handled, but process dies with other reason
%% than the given (in system_terminate/4 below)
Pid5 = proc_lib:spawn(SysMsgProc),
- {'EXIT',{badmatch,2}} = (catch proc_lib:stop(Pid5,crash,infinity)),
+ {'EXIT',{{badmatch,2},_Stacktrace}} = (catch proc_lib:stop(Pid5,crash,infinity)),
false = erlang:is_process_alive(Pid5),
%% Local registered name
diff --git a/lib/stdlib/test/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index 846c2c56f4..2b5d52287e 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_SUITE.erl
@@ -58,7 +58,7 @@
-export([
badarg/1, nested_qlc/1, unused_var/1, lc/1, fun_clauses/1,
filter_var/1, single/1, exported_var/1, generator_vars/1,
- nomatch/1, errors/1, pattern/1,
+ nomatch/1, errors/1, pattern/1, overridden_bif/1,
eval/1, cursor/1, fold/1, eval_unique/1, eval_cache/1, append/1,
evaluator/1, string_to_handle/1, table/1, process_dies/1,
@@ -126,7 +126,7 @@ groups() ->
[{parse_transform, [],
[badarg, nested_qlc, unused_var, lc, fun_clauses,
filter_var, single, exported_var, generator_vars,
- nomatch, errors, pattern]},
+ nomatch, errors, pattern, overridden_bif]},
{evaluation, [],
[eval, cursor, fold, eval_unique, eval_cache, append,
evaluator, string_to_handle, table, process_dies, sort,
@@ -468,6 +468,23 @@ pattern(Config) when is_list(Config) ->
-record(k, {t,v}).\n">>, Ts),
ok.
+%% Override a guard BIF with an imported or local function.
+overridden_bif(Config) ->
+ Ts = [
+ <<"[2] = qlc:e(qlc:q([P || P <- [1,2,3], port(P)])),
+ [10] = qlc:e(qlc:q([P || P <- [0,9,10,11,12],
+ (is_reference(P) andalso P > 5)])),
+ Empty = gb_sets:empty(), Single = gb_sets:singleton(42),
+ GbSets = [Empty,Single],
+ [Single] = qlc:e(qlc:q([S || S <- GbSets, size(S) =/= 0]))
+ ">>
+ ],
+ run(Config, "-import(gb_sets, [size/1]).
+ -compile({no_auto_import, [size/1, is_reference/1]}).
+ port(N) -> N rem 2 =:= 0.
+ is_reference(N) -> N rem 10 =:= 0.\n", Ts),
+ ok.
+
%% eval/2
eval(Config) when is_list(Config) ->
@@ -7929,7 +7946,6 @@ compile(Config, Tests, Fun) ->
compile_file(Config, Test0, Opts0) ->
{File, Mod} = compile_file_mod(Config),
Test = list_to_binary(["-module(", atom_to_list(Mod), "). "
- "-compile(export_all). "
"-import(qlc_SUITE, [i/1,i/2,format_info/2]). "
"-import(qlc_SUITE, [etsc/2, etsc/3]). "
"-import(qlc_SUITE, [create_ets/2]). "
@@ -7939,7 +7955,7 @@ compile_file(Config, Test0, Opts0) ->
"-import(qlc_SUITE, [lookup_keys/1]). "
"-include_lib(\"stdlib/include/qlc.hrl\"). ",
Test0]),
- Opts = [export_all,return,nowarn_unused_record,{outdir,?privdir}|Opts0],
+ Opts = [export_all,nowarn_export_all,return,nowarn_unused_record,{outdir,?privdir}|Opts0],
ok = file:write_file(File, Test),
case compile:file(File, Opts) of
{ok, _M, Ws} -> warnings(File, Ws);
diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl
index 47e7c4f03d..098eefeb61 100644
--- a/lib/stdlib/test/rand_SUITE.erl
+++ b/lib/stdlib/test/rand_SUITE.erl
@@ -28,7 +28,8 @@
api_eq/1, reference/1,
basic_stats_uniform_1/1, basic_stats_uniform_2/1,
basic_stats_normal/1,
- plugin/1, measure/1]).
+ plugin/1, measure/1,
+ reference_jump_state/1, reference_jump_procdict/1]).
-export([test/0, gen/1]).
@@ -45,14 +46,21 @@ all() ->
api_eq,
reference,
{group, basic_stats},
- plugin, measure].
+ plugin, measure,
+ {group, reference_jump}
+ ].
groups() ->
[{basic_stats, [parallel],
- [basic_stats_uniform_1, basic_stats_uniform_2, basic_stats_normal]}].
+ [basic_stats_uniform_1, basic_stats_uniform_2, basic_stats_normal]},
+ {reference_jump, [parallel],
+ [reference_jump_state, reference_jump_procdict]}].
group(basic_stats) ->
%% valgrind needs a lot of time
+ [{timetrap,{minutes,10}}];
+group(reference_jump) ->
+ %% valgrind needs a lot of time
[{timetrap,{minutes,10}}].
%% A simple helper to test without test_server during dev
@@ -228,7 +236,7 @@ interval_float_1(N) ->
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-%% Check if exs64 algorithm generates the proper sequence.
+%% Check if each algorithm generates the proper sequence.
reference(Config) when is_list(Config) ->
[reference_1(Alg) || Alg <- algs()],
ok.
@@ -242,7 +250,7 @@ reference_1(Alg) ->
io:format("Failed: ~p~n",[Alg]),
io:format("Length ~p ~p~n",[length(Refval), length(Testval)]),
io:format("Head ~p ~p~n",[hd(Refval), hd(Testval)]),
- ok
+ exit(wrong_value)
end.
gen(Algo) ->
@@ -348,14 +356,23 @@ basic_normal_1(0, {#{type:=Alg}, _}, Sum, SumSq) ->
%% Test that the user can write algorithms.
plugin(Config) when is_list(Config) ->
- _ = lists:foldl(fun(_, S0) ->
- {V1, S1} = rand:uniform_s(10000, S0),
- true = is_integer(V1),
- {V2, S2} = rand:uniform_s(S1),
- true = is_float(V2),
- S2
- end, crypto_seed(), lists:seq(1, 200)),
- ok.
+ try crypto:strong_rand_bytes(1) of
+ <<_>> ->
+ _ = lists:foldl(
+ fun(_, S0) ->
+ {V1, S1} = rand:uniform_s(10000, S0),
+ true = is_integer(V1),
+ {V2, S2} = rand:uniform_s(S1),
+ true = is_float(V2),
+ S2
+ end, crypto_seed(), lists:seq(1, 200)),
+ ok
+ catch
+ error:low_entropy ->
+ {skip,low_entropy};
+ error:undef ->
+ {skip,no_crypto}
+ end.
%% Test implementation
crypto_seed() ->
@@ -389,7 +406,13 @@ crypto_uniform_n(N, State0) ->
measure(Suite) when is_atom(Suite) -> [];
measure(_Config) ->
ct:timetrap({minutes,15}), %% valgrind needs a lot of time
- Algos = [crypto64|algs()],
+ Algos =
+ try crypto:strong_rand_bytes(1) of
+ <<_>> -> [crypto64]
+ catch
+ error:low_entropy -> [];
+ error:undef -> []
+ end ++ algs(),
io:format("RNG uniform integer performance~n",[]),
_ = measure_1(random, fun(State) -> {int, random:uniform_s(10000, State)} end),
_ = [measure_1(Algo, fun(State) -> {int, rand:uniform_s(10000, State)} end) || Algo <- Algos],
@@ -434,6 +457,112 @@ measure_2(N, State0, Fun) when N > 0 ->
measure_2(0, _, _) -> ok.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+%% The jump sequence tests has two parts
+%% for those with the functional API (jump/1)
+%% and for those with the internal state
+%% in process dictionary (jump/0).
+
+-define(LOOP_JUMP, (?LOOP div 1000)).
+
+%% Check if each algorithm generates the proper jump sequence
+%% with the functional API.
+reference_jump_state(Config) when is_list(Config) ->
+ [reference_jump_1(Alg) || Alg <- algs()],
+ ok.
+
+reference_jump_1(Alg) ->
+ Refval = reference_jump_val(Alg),
+ Testval = gen_jump_1(Alg),
+ case Refval =:= Testval of
+ true -> ok;
+ false ->
+ io:format("Failed: ~p~n",[Alg]),
+ io:format("Length ~p ~p~n",[length(Refval), length(Testval)]),
+ io:format("Head ~p ~p~n",[hd(Refval), hd(Testval)]),
+ exit(wrong_value)
+ end.
+
+gen_jump_1(Algo) ->
+ Seed = case Algo of
+ exsplus -> %% Printed with orig 'C' code and this seed
+ rand:seed_s({exsplus, [12345678|12345678]});
+ exs1024 -> %% Printed with orig 'C' code and this seed
+ rand:seed_s({exs1024, {lists:duplicate(16, 12345678), []}});
+ exs64 -> %% Test exception of not_implemented notice
+ try rand:jump(rand:seed_s(exs64))
+ catch
+ error:not_implemented -> not_implemented
+ end;
+ _ -> % unimplemented
+ not_implemented
+ end,
+ case Seed of
+ not_implemented -> [not_implemented];
+ S -> gen_jump_1(?LOOP_JUMP, S, [])
+ end.
+
+gen_jump_1(N, State0 = {#{max:=Max}, _}, Acc) when N > 0 ->
+ {_, State1} = rand:uniform_s(Max, State0),
+ {Random, State2} = rand:uniform_s(Max, rand:jump(State1)),
+ case N rem (?LOOP_JUMP div 100) of
+ 0 -> gen_jump_1(N-1, State2, [Random|Acc]);
+ _ -> gen_jump_1(N-1, State2, Acc)
+ end;
+gen_jump_1(_, _, Acc) -> lists:reverse(Acc).
+
+%% Check if each algorithm generates the proper jump sequence
+%% with the internal state in the process dictionary.
+reference_jump_procdict(Config) when is_list(Config) ->
+ [reference_jump_0(Alg) || Alg <- algs()],
+ ok.
+
+reference_jump_0(Alg) ->
+ Refval = reference_jump_val(Alg),
+ Testval = gen_jump_0(Alg),
+ case Refval =:= Testval of
+ true -> ok;
+ false ->
+ io:format("Failed: ~p~n",[Alg]),
+ io:format("Length ~p ~p~n",[length(Refval), length(Testval)]),
+ io:format("Head ~p ~p~n",[hd(Refval), hd(Testval)]),
+ exit(wrong_value)
+ end.
+
+gen_jump_0(Algo) ->
+ Seed = case Algo of
+ exsplus -> %% Printed with orig 'C' code and this seed
+ rand:seed({exsplus, [12345678|12345678]});
+ exs1024 -> %% Printed with orig 'C' code and this seed
+ rand:seed({exs1024, {lists:duplicate(16, 12345678), []}});
+ exs64 -> %% Test exception of not_implemented notice
+ try
+ _ = rand:seed(exs64),
+ rand:jump()
+ catch
+ error:not_implemented -> not_implemented
+ end;
+ _ -> % unimplemented
+ not_implemented
+ end,
+ case Seed of
+ not_implemented -> [not_implemented];
+ S ->
+ {Seedmap=#{}, _} = S,
+ Max = maps:get(max, Seedmap),
+ gen_jump_0(?LOOP_JUMP, Max, [])
+ end.
+
+gen_jump_0(N, Max, Acc) when N > 0 ->
+ _ = rand:uniform(Max),
+ _ = rand:jump(),
+ Random = rand:uniform(Max),
+ case N rem (?LOOP_JUMP div 100) of
+ 0 -> gen_jump_0(N-1, Max, [Random|Acc]);
+ _ -> gen_jump_0(N-1, Max, Acc)
+ end;
+gen_jump_0(_, _, Acc) -> lists:reverse(Acc).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Data
reference_val(exs64) ->
[16#3737ad0c703ff6c3,16#3868a78fe71adbbd,16#1f01b62b4338b605,16#50876a917437965f,
@@ -515,3 +644,61 @@ reference_val(exsplus) ->
16#36f715a249f4ec2,16#1c27629826c50d3,16#914d9a6648726a,16#27f5bf5ce2301e8,
16#3dd493b8012970f,16#be13bed1e00e5c,16#ceef033b74ae10,16#3da38c6a50abe03,
16#15cbd1a421c7a8c,16#22794e3ec6ef3b1,16#26154d26e7ea99f,16#3a66681359a6ab6].
+
+%%%
+
+reference_jump_val(exsplus) ->
+ [82445318862816932, 145810727464480743, 16514517716894509, 247642377064868650,
+ 162385642339156908, 251810707075252101, 82288275771998924, 234412731596926322,
+ 49960883129071044, 200690077681656596, 213743196668671647, 131182800982967108,
+ 144200072021941728, 263557425008503277, 194858522616874272, 185869394820993172,
+ 80384502675241453, 262654144824057588, 90033295011291362, 4494510449302659,
+ 226005372746479588, 116780561309220553, 47048528594475843, 39168929349768743,
+ 139615163424415552, 55330632656603925, 237575574720486569, 102381140288455025,
+ 18452933910354323, 150248612130579752, 269358096791922740, 61313433522002187,
+ 160327361842676597, 185187983548528938, 57378981505594193, 167510799293984067,
+ 105117045862954303, 176126685946302943, 123590876906828803, 69185336947273487,
+ 9098689247665808, 49906154674145057, 131575138412788650, 161843880211677185,
+ 30743946051071186, 187578920583823612, 45008401528636978, 122454158686456658,
+ 111195992644229524, 17962783958752862, 13579507636941108, 130137843317798663,
+ 144202635170576832, 132539563255093922, 159785575703967124, 187241848364816640,
+ 183044737781926478, 12921559769912263, 83553932242922001, 96698298841984688,
+ 281664320227537824, 224233030818578263, 77812932110318774, 169729351013291728,
+ 164475402723178734, 242780633011249051, 51095111179609125, 19249189591963554,
+ 221412426221439180, 265700202856282653, 265342254311932308, 241218503498385511,
+ 255400887248486575, 212083616929812076, 227947034485840579, 268261881651571692,
+ 104846262373404908, 49690734329496661, 213259196633566308, 186966479726202436,
+ 282157378232384574, 11272948584603747, 166540426999573480, 50628164001018755,
+ 65235580992800860, 230664399047956956, 64575592354687978, 40519393736078511,
+ 108341851194332747, 115426411532008961, 120656817002338193, 234537867870809797,
+ 12504080415362731, 45083100453836317, 270968267812126657, 93505647407734103,
+ 252852934678537969, 258758309277167202, 74250882143432077, 141629095984552833];
+
+reference_jump_val(exs1024) ->
+ [2655961906500790629, 17003395417078685063, 10466831598958356428, 7603399148503548021,
+ 1650550950190587188, 12294992315080723704, 15743995773860389219, 5492181000145247327,
+ 14118165228742583601, 1024386975263610703, 10124872895886669513, 6445624517813169301,
+ 6238575554686562601, 14108646153524288915, 11804141635807832816, 8421575378006186238,
+ 6354993374304550369, 838493020029548163, 14759355804308819469, 12212491527912522022,
+ 16943204735100571602, 198964074252287588, 7325922870779721649, 15853102065526570574,
+ 16294058349151823341, 6153379962047409781, 15874031679495957261, 17299265255608442340,
+ 984658421210027171, 17408042033939375278, 3326465916992232353, 5222817718770538733,
+ 13262385796795170510, 15648751121811336061, 6718721549566546451, 7353765235619801875,
+ 16110995049882478788, 14559143407227563441, 4189805181268804683, 10938587948346538224,
+ 1635025506014383478, 12619562911869525411, 17469465615861488695, 125252234176411528,
+ 2004192558503448853, 13175467866790974840, 17712272336167363518, 1710549840100880318,
+ 17486892343528340916, 5337910082227550967, 8333082060923612691, 6284787745504163856,
+ 8072221024586708290, 6077032673910717705, 11495200863352251610, 11722792537523099594,
+ 14642059504258647996, 8595733246938141113, 17223366528010341891, 17447739753327015776,
+ 6149800490736735996, 11155866914574313276, 7123864553063709909, 15982886296520662323,
+ 5775920250955521517, 8624640108274906072, 8652974210855988961, 8715770416136907275,
+ 11841689528820039868, 10991309078149220415, 11758038663970841716, 7308750055935299261,
+ 15939068400245256963, 6920341533033919644, 8017706063646646166, 15814376391419160498,
+ 13529376573221932937, 16749061963269842448, 14639730709921425830, 3265850480169354066,
+ 4569394597532719321, 16594515239012200038, 13372824240764466517, 16892840440503406128,
+ 11260004846380394643, 2441660009097834955, 10566922722880085440, 11463315545387550692,
+ 5252492021914937692, 10404636333478845345, 11109538423683960387, 5525267334484537655,
+ 17936751184378118743, 4224632875737239207, 15888641556987476199, 9586888813112229805,
+ 9476861567287505094, 14909536929239540332, 17996844556292992842, 2699310519182298856];
+
+reference_jump_val(exs64) -> [not_implemented].
diff --git a/lib/stdlib/test/random_iolist.erl b/lib/stdlib/test/random_iolist.erl
index 555f063e0a..b62cf5b82b 100644
--- a/lib/stdlib/test/random_iolist.erl
+++ b/lib/stdlib/test/random_iolist.erl
@@ -24,17 +24,13 @@
-module(random_iolist).
--export([run/3, run2/3, standard_seed/0, compare/3, compare2/3,
+-export([run/3, standard_seed/0, compare/3,
random_iolist/1]).
run(Iter,Fun1,Fun2) ->
standard_seed(),
compare(Iter,Fun1,Fun2).
-run2(Iter,Fun1,Fun2) ->
- standard_seed(),
- compare2(Iter,Fun1,Fun2).
-
random_byte() ->
rand:uniform(256) - 1.
@@ -150,16 +146,6 @@ do_comp(List,F1,F2) ->
_ ->
true
end.
-
-do_comp(List,List2,F1,F2) ->
- X = F1(List,List2),
- Y = F2(List,List2),
- case X =:= Y of
- false ->
- exit({not_matching,List,List2,X,Y});
- _ ->
- true
- end.
compare(0,Fun1,Fun2) ->
do_comp(<<>>,Fun1,Fun2),
@@ -172,25 +158,3 @@ compare(N,Fun1,Fun2) ->
L = random_iolist(N),
do_comp(L,Fun1,Fun2),
compare(N-1,Fun1,Fun2).
-
-compare2(0,Fun1,Fun2) ->
- L = random_iolist(100),
- do_comp(<<>>,L,Fun1,Fun2),
- do_comp(L,<<>>,Fun1,Fun2),
- do_comp(<<>>,<<>>,Fun1,Fun2),
- do_comp([],L,Fun1,Fun2),
- do_comp(L,[],Fun1,Fun2),
- do_comp([],[],Fun1,Fun2),
- do_comp([[]|<<>>],L,Fun1,Fun2),
- do_comp(L,[[]|<<>>],Fun1,Fun2),
- do_comp([[]|<<>>],[[]|<<>>],Fun1,Fun2),
- do_comp([<<>>,[]|<<>>],L,Fun1,Fun2),
- do_comp(L,[<<>>,[]|<<>>],Fun1,Fun2),
- do_comp([<<>>,[]|<<>>],[<<>>,[]|<<>>],Fun1,Fun2),
- true;
-
-compare2(N,Fun1,Fun2) ->
- L = random_iolist(N),
- L2 = random_iolist(N),
- do_comp(L,L2,Fun1,Fun2),
- compare2(N-1,Fun1,Fun2).
diff --git a/lib/stdlib/test/random_unicode_list.erl b/lib/stdlib/test/random_unicode_list.erl
index 8db2fa8b56..2eeb28113d 100644
--- a/lib/stdlib/test/random_unicode_list.erl
+++ b/lib/stdlib/test/random_unicode_list.erl
@@ -24,7 +24,7 @@
-module(random_unicode_list).
--export([run/3, run/4, run2/3, standard_seed/0, compare/4, compare2/3,
+-export([run/3, run/4, standard_seed/0, compare/4,
random_unicode_list/2]).
run(I,F1,F2) ->
@@ -33,10 +33,6 @@ run(Iter,Fun1,Fun2,Enc) ->
standard_seed(),
compare(Iter,Fun1,Fun2,Enc).
-run2(Iter,Fun1,Fun2) ->
- standard_seed(),
- compare2(Iter,Fun1,Fun2).
-
int_to_utf8(I) when I =< 16#7F ->
<<I>>;
int_to_utf8(I) when I =< 16#7FF ->
@@ -225,16 +221,6 @@ do_comp(List,F1,F2) ->
_ ->
true
end.
-
-do_comp(List,List2,F1,F2) ->
- X = F1(List,List2),
- Y = F2(List,List2),
- case X =:= Y of
- false ->
- exit({not_matching,List,List2,X,Y});
- _ ->
- true
- end.
compare(0,Fun1,Fun2,_Enc) ->
do_comp(<<>>,Fun1,Fun2),
@@ -247,25 +233,3 @@ compare(N,Fun1,Fun2,Enc) ->
L = random_unicode_list(N,Enc),
do_comp(L,Fun1,Fun2),
compare(N-1,Fun1,Fun2,Enc).
-
-compare2(0,Fun1,Fun2) ->
- L = random_unicode_list(100,utf8),
- do_comp(<<>>,L,Fun1,Fun2),
- do_comp(L,<<>>,Fun1,Fun2),
- do_comp(<<>>,<<>>,Fun1,Fun2),
- do_comp([],L,Fun1,Fun2),
- do_comp(L,[],Fun1,Fun2),
- do_comp([],[],Fun1,Fun2),
- do_comp([[]|<<>>],L,Fun1,Fun2),
- do_comp(L,[[]|<<>>],Fun1,Fun2),
- do_comp([[]|<<>>],[[]|<<>>],Fun1,Fun2),
- do_comp([<<>>,[]|<<>>],L,Fun1,Fun2),
- do_comp(L,[<<>>,[]|<<>>],Fun1,Fun2),
- do_comp([<<>>,[]|<<>>],[<<>>,[]|<<>>],Fun1,Fun2),
- true;
-
-compare2(N,Fun1,Fun2) ->
- L = random_unicode_list(N,utf8),
- L2 = random_unicode_list(N,utf8),
- do_comp(L,L2,Fun1,Fun2),
- compare2(N-1,Fun1,Fun2).
diff --git a/lib/stdlib/test/re_testoutput1_replacement_test.erl b/lib/stdlib/test/re_testoutput1_replacement_test.erl
index df46305ce1..f14df547ef 100644
--- a/lib/stdlib/test/re_testoutput1_replacement_test.erl
+++ b/lib/stdlib/test/re_testoutput1_replacement_test.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(re_testoutput1_replacement_test).
--compile(export_all).
+-export([run/0]).
-compile(no_native).
%% This file is generated by running run_pcre_tests:gen_repl_test("re_SUITE_data/testoutput1")
run() ->
diff --git a/lib/stdlib/test/re_testoutput1_split_test.erl b/lib/stdlib/test/re_testoutput1_split_test.erl
index 4022f9b195..8218cd9bd2 100644
--- a/lib/stdlib/test/re_testoutput1_split_test.erl
+++ b/lib/stdlib/test/re_testoutput1_split_test.erl
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
%%
-module(re_testoutput1_split_test).
--compile(export_all).
+-export([run/0]).
-compile(no_native).
%% This file is generated by running run_pcre_tests:gen_split_test("re_SUITE_data/testoutput1")
join([]) -> [];
diff --git a/lib/stdlib/test/run_pcre_tests.erl b/lib/stdlib/test/run_pcre_tests.erl
index 5c6d33d0d1..205a7e4946 100644
--- a/lib/stdlib/test/run_pcre_tests.erl
+++ b/lib/stdlib/test/run_pcre_tests.erl
@@ -18,8 +18,7 @@
%% %CopyrightEnd%
%%
-module(run_pcre_tests).
-
--compile(export_all).
+-export([test/1,gen_split_test/1,gen_repl_test/1]).
test(RootDir) ->
put(verbose,false),
@@ -119,49 +118,6 @@ test([{RE0,Line,Options0,Tests}|T],PreCompile,XMode,REAsList) ->
end
end.
-loopexec(_,_,X,Y,_,_) when X > Y ->
- {match,[]};
-loopexec(P,Chal,X,Y,Unicode,Xopt) ->
- case re:run(Chal,P,[{offset,X}]++Xopt) of
- nomatch ->
- {match,[]};
- {match,[{A,B}|More]} ->
- {match,Rest} =
- case B>0 of
- true ->
- loopexec(P,Chal,A+B,Y,Unicode,Xopt);
- false ->
- {match,M} = case re:run(Chal,P,[{offset,X},notempty,anchored]++Xopt) of
- nomatch ->
- {match,[]};
- {match,Other} ->
- {match,fixup(Chal,Other,0)}
- end,
- NewA = forward(Chal,A,1,Unicode),
- {match,MM} = loopexec(P,Chal,NewA,Y,Unicode,Xopt),
- {match,M ++ MM}
- end,
- {match,fixup(Chal,[{A,B}|More],0)++Rest}
- end.
-
-forward(_Chal,A,0,_) ->
- A;
-forward(_Chal,A,N,false) ->
- A+N;
-forward(Chal,A,N,true) ->
- <<_:A/binary,Tl/binary>> = Chal,
- Forw = case Tl of
- <<1:1,1:1,0:1,_:5,_/binary>> ->
- 2;
- <<1:1,1:1,1:1,0:1,_:4,_/binary>> ->
- 3;
- <<1:1,1:1,1:1,1:1,0:1,_:3,_/binary>> ->
- 4;
- _ ->
- 1
- end,
- forward(Chal,A+Forw,N-1,true).
-
contains_eightbit(<<>>) ->
false;
contains_eightbit(<<X:8,_/binary>>) when X >= 128 ->
@@ -201,23 +157,6 @@ clean_duplicates([X|T],L) ->
end.
-global_fixup(_,nomatch) ->
- nomatch;
-global_fixup(P,{match,M}) ->
- {match,lists:flatten(global_fixup2(P,M))}.
-
-global_fixup2(_,[]) ->
- [];
-global_fixup2(P,[H|T]) ->
- [gfixup_one(P,0,H)|global_fixup2(P,T)].
-
-gfixup_one(_,_,[]) ->
- [];
-gfixup_one(P,I,[{Start,Len}|T]) ->
- <<_:Start/binary,R:Len/binary,_/binary>> = P,
- [{I,R}|gfixup_one(P,I+1,T)].
-
-
press([]) ->
[];
press([H|T]) ->
@@ -984,7 +923,7 @@ gen_split_test(OneFile) ->
ErlFileName = ErlModule++".erl",
{ok,F}= file:open(ErlFileName,[write]),
io:format(F,"-module(~s).~n",[ErlModule]),
- io:format(F,"-compile(export_all).~n",[]),
+ io:format(F,"-export([run/0]).~n",[]),
io:format(F,"-compile(no_native).~n",[]),
io:format(F,"%% This file is generated by running ~w:gen_split_test(~p)~n",
[?MODULE,OneFile]),
@@ -1027,7 +966,7 @@ dumponesplit(F,{RE,Line,O,TS}) ->
"$x =~~ s/\\\\/\\\\\\\\/g; $x =~~ s/\\\"/\\\\\"/g; "
"print \" <<\\\"$x\\\">> = "
"iolist_to_binary(join(re:split(\\\"~s\\\","
- "\\\"~s\\\",~p))), \\n\";'~n",
+ "\\\"~s\\\",~p))),\\n\";'~n",
[zsafe(safe(RE)),
SSS,
ysafe(safe(Str)),
@@ -1038,7 +977,7 @@ dumponesplit(F,{RE,Line,O,TS}) ->
"$x =~~ s/\\\\/\\\\\\\\/g; $x =~~ s/\\\"/\\\\\"/g; "
"print \" <<\\\"$x\\\">> = "
"iolist_to_binary(join(re:split(\\\"~s\\\","
- "\\\"~s\\\",~p))), \\n\";'~n",
+ "\\\"~s\\\",~p))),\\n\";'~n",
[zsafe(safe(RE)),
SSS,
ysafe(safe(Str)),
@@ -1049,7 +988,7 @@ dumponesplit(F,{RE,Line,O,TS}) ->
"$x =~~ s/\\\\/\\\\\\\\/g; $x =~~ s/\\\"/\\\\\"/g; "
"print \" <<\\\"$x\\\">> = "
"iolist_to_binary(join(re:split(\\\"~s\\\","
- "\\\"~s\\\",~p))), \\n\";'~n",
+ "\\\"~s\\\",~p))),\\n\";'~n",
[zsafe(safe(RE)),
SSS,
ysafe(safe(Str)),
@@ -1074,7 +1013,7 @@ gen_repl_test(OneFile) ->
ErlFileName = ErlModule++".erl",
{ok,F}= file:open(ErlFileName,[write]),
io:format(F,"-module(~s).~n",[ErlModule]),
- io:format(F,"-compile(export_all).~n",[]),
+ io:format(F,"-export([run/0]).~n",[]),
io:format(F,"-compile(no_native).~n",[]),
io:format(F,"%% This file is generated by running ~w:gen_repl_test(~p)~n",
[?MODULE,OneFile]),
diff --git a/lib/stdlib/test/shell_SUITE.erl b/lib/stdlib/test/shell_SUITE.erl
index 80585ca359..56002dda25 100644
--- a/lib/stdlib/test/shell_SUITE.erl
+++ b/lib/stdlib/test/shell_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2004-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2004-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -30,7 +30,8 @@
progex_bit_syntax/1, progex_records/1,
progex_lc/1, progex_funs/1,
otp_5990/1, otp_6166/1, otp_6554/1,
- otp_7184/1, otp_7232/1, otp_8393/1, otp_10302/1, otp_13719/1]).
+ otp_7184/1, otp_7232/1, otp_8393/1, otp_10302/1, otp_13719/1,
+ otp_14285/1]).
-export([ start_restricted_from_shell/1,
start_restricted_on_command_line/1,restricted_local/1]).
@@ -91,7 +92,7 @@ groups() ->
progex_funs]},
{tickets, [],
[otp_5990, otp_6166, otp_6554, otp_7184,
- otp_7232, otp_8393, otp_10302, otp_13719]}].
+ otp_7232, otp_8393, otp_10302, otp_13719, otp_14285]}].
init_per_suite(Config) ->
Config.
@@ -282,7 +283,7 @@ restricted_local(Config) when is_list(Config) ->
comm_err(<<"begin F=fun() -> hello end, foo(F) end.">>),
"exception error: undefined shell command banan/1" =
comm_err(<<"begin F=fun() -> hello end, banan(F) end.">>),
- "{error,"++_ = t(<<"begin F=fun() -> hello end, c(F) end.">>),
+ "Recompiling "++_ = t(<<"c(shell_SUITE).">>),
"exception exit: restricted shell does not allow l(" ++ _ =
comm_err(<<"begin F=fun() -> hello end, l(F) end.">>),
"exception error: variable 'F' is unbound" =
@@ -573,7 +574,7 @@ otp_5327(Config) when is_list(Config) ->
(catch evaluate(<<"<<32/unit:8>>.">>, [])),
ok.
-%% OTP-5435. sys_pre_expand not in the path.
+%% OTP-5435. compiler application not in the path.
otp_5435(Config) when is_list(Config) ->
true = <<103133:64/float>> =:=
evaluate(<<"<<103133:64/float>> = <<103133:64/float>>.">>, []),
@@ -591,8 +592,9 @@ start_node(Name) ->
otp_5435_2() ->
true = code:del_path(compiler),
- %% sys_pre_expand can no longer be found
- %% OTP-5876. But erl_expand_records can!
+ %% Make sure record evaluation is not dependent on the compiler
+ %% application being in the path.
+ %% OTP-5876.
[{attribute,_,record,{bar,_}},ok] =
scan(<<"rd(foo,{bar}),
rd(bar,{foo = (#foo{})#foo.bar}),
@@ -1793,7 +1795,7 @@ Test1_shell =
Test2 =
<<"-module(recs).
-record(person, {name, age, phone = [], dict = []}).
--compile(export_all).
+-export([t/0]).
t() -> ok.
@@ -1960,7 +1962,7 @@ ok.
progex_funs(Config) when is_list(Config) ->
Test1 =
<<"-module(funs).
- -compile(export_all).
+ -export([t/0]).
double([H|T]) -> [2*H|double(T)];
double([]) -> [].
@@ -2823,6 +2825,22 @@ otp_13719(Config) when is_list(Config) ->
file:delete(File),
ok.
+otp_14285(Config) ->
+ {ok,Node} = start_node(shell_suite_helper_4,
+ "-pa "++proplists:get_value(priv_dir,Config)++
+ " +pc unicode"),
+ Test1 =
+ <<"begin
+ io:setopts([{encoding,utf8}]),
+ [1024] = atom_to_list('\\x{400}'),
+ rd('\\x{400}', {'\\x{400}' = '\\x{400}'}),
+ ok = rl('\\x{400}')
+ end.">>,
+ "-record('\x{400}',{'\x{400}' = '\x{400}'}).\nok.\n" =
+ t({Node,Test1}),
+ test_server:stop_node(Node),
+ ok.
+
scan(B) ->
F = fun(Ts) ->
case erl_parse:parse_term(Ts) of
@@ -3030,7 +3048,7 @@ run_file(Config, Module, Test) ->
ok.
compile_file(Config, File, Test, Opts0) ->
- Opts = [export_all,return,{outdir,proplists:get_value(priv_dir, Config)}|Opts0],
+ Opts = [export_all,nowarn_export_all,return,{outdir,proplists:get_value(priv_dir, Config)}|Opts0],
ok = file:write_file(File, Test),
case compile:file(File, Opts) of
{ok, _M, _Ws} -> ok;
diff --git a/lib/stdlib/test/sofs_SUITE.erl b/lib/stdlib/test/sofs_SUITE.erl
index 13c12ad2f2..f67bf16f0f 100644
--- a/lib/stdlib/test/sofs_SUITE.erl
+++ b/lib/stdlib/test/sofs_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2001-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2001-2017. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.
@@ -1837,11 +1837,8 @@ digraph(Conf) when is_list(Conf) ->
ok.
digraph_fail(ExitReason, Fail) ->
- {'EXIT', {ExitReason, [{sofs,family_to_digraph,A,_}|_]}} = Fail,
- case {test_server:is_native(sofs),A} of
- {false,[_,_]} -> ok;
- {true,2} -> ok
- end.
+ {'EXIT', {ExitReason, [{sofs,family_to_digraph,2,_}|_]}} = Fail,
+ ok.
constant_function(Conf) when is_list(Conf) ->
E = empty_set(),
diff --git a/lib/stdlib/test/tar_SUITE.erl b/lib/stdlib/test/tar_SUITE.erl
index 6f3979bb77..2e1ae7bcff 100644
--- a/lib/stdlib/test/tar_SUITE.erl
+++ b/lib/stdlib/test/tar_SUITE.erl
@@ -20,11 +20,14 @@
-module(tar_SUITE).
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2, borderline/1, atomic/1, long_names/1,
+ init_per_group/2, end_per_group/2,
+ init_per_testcase/2,
+ borderline/1, atomic/1, long_names/1,
create_long_names/1, bad_tar/1, errors/1, extract_from_binary/1,
- extract_from_binary_compressed/1,
+ extract_from_binary_compressed/1, extract_filtered/1,
extract_from_open_file/1, symlinks/1, open_add_close/1, cooked_compressed/1,
- memory/1,unicode/1]).
+ memory/1,unicode/1,read_other_implementations/1,
+ sparse/1, init/1]).
-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
@@ -35,7 +38,10 @@ all() ->
[borderline, atomic, long_names, create_long_names,
bad_tar, errors, extract_from_binary,
extract_from_binary_compressed, extract_from_open_file,
- symlinks, open_add_close, cooked_compressed, memory, unicode].
+ extract_filtered,
+ symlinks, open_add_close, cooked_compressed, memory, unicode,
+ read_other_implementations,
+ sparse,init].
groups() ->
[].
@@ -52,6 +58,9 @@ init_per_group(_GroupName, Config) ->
end_per_group(_GroupName, Config) ->
Config.
+init_per_testcase(_Case, Config) ->
+ Ports = ordsets:from_list(erlang:ports()),
+ [{ports,Ports}|Config].
%% Test creating, listing and extracting one file from an archive,
%% multiple times with different file sizes. Also check that the file
@@ -81,20 +90,33 @@ borderline(Config) when is_list(Config) ->
%% Clean up.
delete_files([TempDir]),
- ok.
+ verify_ports(Config).
borderline_test(Size, TempDir) ->
- Archive = filename:join(TempDir, "ar_"++integer_to_list(Size)++".tar"),
- Name = filename:join(TempDir, "file_"++integer_to_list(Size)),
io:format("Testing size ~p", [Size]),
+ borderline_test(Size, TempDir, true),
+ borderline_test(Size, TempDir, false),
+ ok.
+
+borderline_test(Size, TempDir, IsUstar) ->
+ Prefix = case IsUstar of
+ true ->
+ "file_";
+ false ->
+ lists:duplicate(100, $f) ++ "ile_"
+ end,
+ SizeList = integer_to_list(Size),
+ Archive = filename:join(TempDir, "ar_"++ SizeList ++".tar"),
+ Name = filename:join(TempDir, Prefix++SizeList),
%% Create a file and archive it.
X0 = erlang:monotonic_time(),
- file:write_file(Name, random_byte_list(X0, Size)),
+ ok = file:write_file(Name, random_byte_list(X0, Size)),
ok = erl_tar:create(Archive, [Name]),
ok = file:delete(Name),
%% Verify listing and extracting.
+ IsUstar = is_ustar(Archive),
{ok, [Name]} = erl_tar:table(Archive),
ok = erl_tar:extract(Archive, [verbose]),
@@ -103,7 +125,12 @@ borderline_test(Size, TempDir) ->
true = match_byte_list(X0, binary_to_list(Bin)),
%% Verify that Unix tar can read it.
- tar_tf(Archive, Name),
+ case IsUstar of
+ true ->
+ tar_tf(Archive, Name);
+ false ->
+ ok
+ end,
ok.
@@ -248,7 +275,7 @@ atomic(Config) when is_list(Config) ->
%% Clean up.
delete_files([Tar1,Tar2,Tar3,Tar4|Names]),
- ok.
+ verify_ports(Config).
%% Returns a sequence of characters.
@@ -282,7 +309,9 @@ long_names(Config) when is_list(Config) ->
DataDir = proplists:get_value(data_dir, Config),
Long = filename:join(DataDir, "long_names.tar"),
run_in_short_tempdir(Config,
- fun() -> do_long_names(Long) end).
+ fun() -> do_long_names(Long) end),
+ verify_ports(Config).
+
do_long_names(Long) ->
%% Try table/2 and extract/2.
@@ -314,7 +343,8 @@ do_long_names(Long) ->
%% Creates a tar file from a deep directory structure (filenames are
%% longer than 100 characters).
create_long_names(Config) when is_list(Config) ->
- run_in_short_tempdir(Config, fun create_long_names/0).
+ run_in_short_tempdir(Config, fun create_long_names/0),
+ verify_ports(Config).
create_long_names() ->
{ok,Dir} = file:get_cwd(),
@@ -336,6 +366,7 @@ create_long_names() ->
ok = erl_tar:tt(TarName),
%% Extract and verify.
+ true = is_ustar(TarName),
ExtractDir = "extract_dir",
ok = file:make_dir(ExtractDir),
ok = erl_tar:extract(TarName, [{cwd,ExtractDir}]),
@@ -357,10 +388,10 @@ make_dirs([], Dir) ->
%% Try erl_tar:table/2 and erl_tar:extract/2 on some corrupted tar files.
bad_tar(Config) when is_list(Config) ->
try_bad("bad_checksum", bad_header, Config),
- try_bad("bad_octal", bad_header, Config),
+ try_bad("bad_octal", invalid_tar_checksum, Config),
try_bad("bad_too_short", eof, Config),
try_bad("bad_even_shorter", eof, Config),
- ok.
+ verify_ports(Config).
try_bad(Name0, Reason, Config) ->
%% Intentionally no macros here.
@@ -370,8 +401,10 @@ try_bad(Name0, Reason, Config) ->
Name = Name0 ++ ".tar",
io:format("~nTrying ~s", [Name]),
Full = filename:join(DataDir, Name),
- Opts = [verbose, {cwd, PrivDir}],
+ Dest = filename:join(PrivDir, Name0),
+ Opts = [verbose, {cwd, Dest}],
Expected = {error, Reason},
+ io:fwrite("Expected: ~p\n", [Expected]),
case {erl_tar:table(Full, Opts), erl_tar:extract(Full, Opts)} of
{Expected, Expected} ->
io:format("Result: ~p", [Expected]),
@@ -408,7 +441,7 @@ errors(Config) when is_list(Config) ->
%% Clean up.
delete_files([GoodTar,BadTar]),
- ok.
+ verify_ports(Config).
try_error(M, F, A, Error) ->
io:format("Trying ~p:~p(~p)", [M, F, A]),
@@ -458,7 +491,7 @@ extract_from_binary(Config) when is_list(Config) ->
%% Clean up.
delete_files([ExtractDir]),
- ok.
+ verify_ports(Config).
extract_from_binary_compressed(Config) when is_list(Config) ->
%% Test extracting a compressed tar archive from a binary.
@@ -491,7 +524,28 @@ extract_from_binary_compressed(Config) when is_list(Config) ->
%% Clean up the rest.
delete_files([ExtractDir]),
- ok.
+ verify_ports(Config).
+
+%% Test extracting a tar archive from a binary.
+extract_filtered(Config) when is_list(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Long = filename:join(DataDir, "no_fancy_stuff.tar"),
+ ExtractDir = filename:join(PrivDir, "extract_from_binary"),
+ ok = file:make_dir(ExtractDir),
+
+ ok = erl_tar:extract(Long, [{cwd,ExtractDir},{files,["no_fancy_stuff/EPLICENCE"]}]),
+
+ %% Verify.
+ Dir = filename:join(ExtractDir, "no_fancy_stuff"),
+ true = filelib:is_dir(Dir),
+ false = filelib:is_file(filename:join(Dir, "a_dir_list")),
+ true = filelib:is_file(filename:join(Dir, "EPLICENCE")),
+
+ %% Clean up.
+ delete_files([ExtractDir]),
+
+ verify_ports(Config).
%% Test extracting a tar archive from an open file.
extract_from_open_file(Config) when is_list(Config) ->
@@ -516,7 +570,7 @@ extract_from_open_file(Config) when is_list(Config) ->
%% Clean up.
delete_files([ExtractDir]),
- ok.
+ verify_ports(Config).
%% Test that archives containing symlinks can be created and extracted.
symlinks(Config) when is_list(Config) ->
@@ -535,6 +589,7 @@ symlinks(Config) when is_list(Config) ->
%% Clean up.
delete_files([Dir]),
+ verify_ports(Config),
Res.
make_symlink(Path, Link) ->
@@ -573,6 +628,7 @@ symlinks(Dir, BadSymlink, PointsTo) ->
ok = file:write_file(AFile, ALine),
ok = file:make_symlink(AFile, GoodSymlink),
ok = erl_tar:create(Tar, [BadSymlink, GoodSymlink, AFile], [verbose]),
+ true = is_ustar(Tar),
%% List contents of tar file.
@@ -581,6 +637,7 @@ symlinks(Dir, BadSymlink, PointsTo) ->
%% Also create another archive with the dereference flag.
ok = erl_tar:create(DerefTar, [AFile, GoodSymlink], [dereference, verbose]),
+ true = is_ustar(DerefTar),
%% Extract files to a new directory.
@@ -619,13 +676,51 @@ long_symlink(Dir) ->
ok = file:set_cwd(Dir),
AFile = "long_symlink",
- FarTooLong = "/tmp/aarrghh/this/path/is/far/longer/than/one/hundred/characters/which/is/the/maximum/number/of/characters/allowed",
- ok = file:make_symlink(FarTooLong, AFile),
- {error,Error} = erl_tar:create(Tar, [AFile], [verbose]),
- io:format("Error: ~s\n", [erl_tar:format_error(Error)]),
- {FarTooLong,symbolic_link_too_long} = Error,
+ RequiresPAX = "/tmp/aarrghh/this/path/is/far/longer/than/one/hundred/characters/which/is/the/maximum/number/of/characters/allowed",
+ ok = file:make_symlink(RequiresPAX, AFile),
+ ok = erl_tar:create(Tar, [AFile], [verbose]),
+ false = is_ustar(Tar),
+ NewDir = filename:join(Dir, "extracted"),
+ _ = file:make_dir(NewDir),
+ ok = erl_tar:extract(Tar, [{cwd, NewDir}, verbose]),
+ ok = file:set_cwd(NewDir),
+ {ok, #file_info{type=symlink}} = file:read_link_info(AFile),
+ {ok, RequiresPAX} = file:read_link(AFile),
ok.
+init(Config) when is_list(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ ok = file:set_cwd(PrivDir),
+ Dir = filename:join(PrivDir, "init"),
+ ok = file:make_dir(Dir),
+
+ [{FileOne,_,_}|_] = oac_files(),
+ TarOne = filename:join(Dir, "archive1.tar"),
+ {ok,Fd} = file:open(TarOne, [write]),
+
+ %% If the arity of the fun is wrong, badarg should be returned
+ {error, badarg} = erl_tar:init(Fd, write, fun file_op_bad/1),
+
+ %% Otherwise we should be good to go
+ {ok, Tar} = erl_tar:init(Fd, write, fun file_op/2),
+ ok = erl_tar:add(Tar, FileOne, []),
+ ok = erl_tar:close(Tar),
+ {ok, [FileOne]} = erl_tar:table(TarOne),
+
+ verify_ports(Config).
+
+file_op_bad(_) ->
+ throw({error, should_never_be_called}).
+
+file_op(write, {Fd, Data}) ->
+ file:write(Fd, Data);
+file_op(position, {Fd, Pos}) ->
+ file:position(Fd, Pos);
+file_op(read2, {Fd, Size}) ->
+ file:read(Fd, Size);
+file_op(close, Fd) ->
+ file:close(Fd).
+
open_add_close(Config) when is_list(Config) ->
PrivDir = proplists:get_value(priv_dir, Config),
ok = file:set_cwd(PrivDir),
@@ -643,21 +738,30 @@ open_add_close(Config) when is_list(Config) ->
TarOne = filename:join(Dir, "archive1.tar"),
{ok,AD} = erl_tar:open(TarOne, [write]),
ok = erl_tar:add(AD, FileOne, []),
- ok = erl_tar:add(AD, FileTwo, "second file", []),
- ok = erl_tar:add(AD, FileThree, [verbose]),
+
+ %% Add with {NameInArchive,Name}
+ ok = erl_tar:add(AD, {"second file", FileTwo}, []),
+
+ %% Add with {binary, Bin}
+ {ok,FileThreeBin} = file:read_file(FileThree),
+ ok = erl_tar:add(AD, {FileThree, FileThreeBin}, [verbose]),
+
+ %% Add with Name
ok = erl_tar:add(AD, FileThree, "chunked", [{chunks,11411},verbose]),
ok = erl_tar:add(AD, ADir, [verbose]),
ok = erl_tar:add(AD, AnotherDir, [verbose]),
ok = erl_tar:close(AD),
+ true = is_ustar(TarOne),
ok = erl_tar:t(TarOne),
ok = erl_tar:tt(TarOne),
- {ok,[FileOne,"second file",FileThree,"chunked",ADir,SomeContent]} = erl_tar:table(TarOne),
+ Expected = {ok,[FileOne,"second file",FileThree,"chunked",ADir,SomeContent]},
+ Expected = erl_tar:table(TarOne),
delete_files(["oac_file","oac_small","oac_big",Dir,AnotherDir,ADir]),
- ok.
+ verify_ports(Config).
oac_files() ->
Files = [{"oac_file", 1459, $x},
@@ -688,7 +792,8 @@ cooked_compressed(Config) when is_list(Config) ->
%% Clean up.
delete_files([filename:join(PrivDir, "ddll_SUITE_data")]),
- ok.
+
+ verify_ports(Config).
%% Test that an archive can be created directly from binaries and
%% that an archive can be extracted into binaries.
@@ -716,7 +821,45 @@ memory(Config) when is_list(Config) ->
%% Clean up.
ok = delete_files([Name1,Name2]),
- ok.
+
+ verify_ports(Config).
+
+read_other_implementations(Config) when is_list(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ Files = ["v7.tar", "gnu.tar", "bsd.tar",
+ "star.tar", "pax_mtime.tar"],
+ do_read_other_implementations(Files, DataDir),
+ verify_ports(Config).
+
+do_read_other_implementations([], _DataDir) ->
+ ok;
+do_read_other_implementations([File|Rest], DataDir) ->
+ io:format("~nTrying ~s", [File]),
+ Full = filename:join(DataDir, File),
+ {ok, _} = erl_tar:table(Full),
+ {ok, _} = erl_tar:extract(Full, [memory]),
+ do_read_other_implementations(Rest, DataDir).
+
+
+%% Test handling of sparse files
+sparse(Config) when is_list(Config) ->
+ DataDir = proplists:get_value(data_dir, Config),
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Sparse01Empty = "sparse01_empty.tar",
+ Sparse01 = "sparse01.tar",
+ Sparse10Empty = "sparse10_empty.tar",
+ Sparse10 = "sparse10.tar",
+ do_sparse([Sparse01Empty, Sparse01, Sparse10Empty, Sparse10], DataDir, PrivDir),
+ verify_ports(Config).
+
+do_sparse([], _DataDir, _PrivDir) ->
+ ok;
+do_sparse([Name|Rest], DataDir, PrivDir) ->
+ io:format("~nTrying sparse file ~s", [Name]),
+ Full = filename:join(DataDir, Name),
+ {ok, [_]} = erl_tar:table(Full),
+ {ok, _} = erl_tar:extract(Full, [memory]),
+ do_sparse(Rest, DataDir, PrivDir).
%% Test filenames with characters outside the US ASCII range.
unicode(Config) when is_list(Config) ->
@@ -753,6 +896,9 @@ do_unicode(PrivDir) ->
Names = lists:sort(unicode_create_files()),
Tar = "unicöde.tar",
ok = erl_tar:create(Tar, ["unicöde"], []),
+
+ %% Unicode filenames require PAX format.
+ false = is_ustar(Tar),
{ok,Names0} = erl_tar:table(Tar, []),
Names = lists:sort(Names0),
_ = [ok = file:delete(Name) || Name <- Names],
@@ -850,3 +996,26 @@ start_node(Name, Args) ->
ct:log("Node ~p started~n", [Node]),
Node
end.
+
+%% Test that the given tar file is a plain USTAR archive,
+%% without any PAX extensions.
+is_ustar(File) ->
+ {ok,Bin} = file:read_file(File),
+ <<_:257/binary,"ustar",0,_/binary>> = Bin,
+ <<_:156/binary,Type:8,_/binary>> = Bin,
+ case Type of
+ $x -> false;
+ $g -> false;
+ _ -> true
+ end.
+
+
+verify_ports(Config) ->
+ PortsBefore = proplists:get_value(ports, Config),
+ PortsAfter = ordsets:from_list(erlang:ports()),
+ case ordsets:subtract(PortsAfter, PortsBefore) of
+ [] ->
+ ok;
+ [_|_]=Rem ->
+ error({leaked_ports,Rem})
+ end.
diff --git a/lib/stdlib/test/tar_SUITE_data/bsd.tar b/lib/stdlib/test/tar_SUITE_data/bsd.tar
new file mode 100644
index 0000000000..8c31864be0
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/bsd.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/gnu.tar b/lib/stdlib/test/tar_SUITE_data/gnu.tar
new file mode 100644
index 0000000000..60268065c1
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/gnu.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/pax_mtime.tar b/lib/stdlib/test/tar_SUITE_data/pax_mtime.tar
new file mode 100644
index 0000000000..1b6e80ffac
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/pax_mtime.tar
Binary files differ
diff --git a/lib/stdlib/test/dets_SUITE_data/version_r3b02.dets b/lib/stdlib/test/tar_SUITE_data/sparse00.tar
index 058cd15b31..61a04de90b 100644
--- a/lib/stdlib/test/dets_SUITE_data/version_r3b02.dets
+++ b/lib/stdlib/test/tar_SUITE_data/sparse00.tar
Binary files differ
diff --git a/lib/stdlib/test/dets_SUITE_data/dets_test_v8b.dets b/lib/stdlib/test/tar_SUITE_data/sparse01.tar
index d0aa20fe06..61a04de90b 100644
--- a/lib/stdlib/test/dets_SUITE_data/dets_test_v8b.dets
+++ b/lib/stdlib/test/tar_SUITE_data/sparse01.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/sparse01_empty.tar b/lib/stdlib/test/tar_SUITE_data/sparse01_empty.tar
new file mode 100644
index 0000000000..efa6d060f4
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/sparse01_empty.tar
Binary files differ
diff --git a/lib/stdlib/test/dets_SUITE_data/dets_test_v8b_little_endian.dets b/lib/stdlib/test/tar_SUITE_data/sparse10.tar
index bf490afa1a..61a04de90b 100644
--- a/lib/stdlib/test/dets_SUITE_data/dets_test_v8b_little_endian.dets
+++ b/lib/stdlib/test/tar_SUITE_data/sparse10.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/sparse10_empty.tar b/lib/stdlib/test/tar_SUITE_data/sparse10_empty.tar
new file mode 100644
index 0000000000..efa6d060f4
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/sparse10_empty.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/star.tar b/lib/stdlib/test/tar_SUITE_data/star.tar
new file mode 100644
index 0000000000..b0631e3b13
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/star.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/v7.tar b/lib/stdlib/test/tar_SUITE_data/v7.tar
new file mode 100644
index 0000000000..9918e006bb
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/v7.tar
Binary files differ
diff --git a/lib/stdlib/test/timer_SUITE.erl b/lib/stdlib/test/timer_SUITE.erl
index 5fc95b16a6..9062cbae80 100644
--- a/lib/stdlib/test/timer_SUITE.erl
+++ b/lib/stdlib/test/timer_SUITE.erl
@@ -353,7 +353,7 @@ res_combine({error,Es}, [{error,E}|T]) ->
system_time() ->
- erlang:monotonic_time(milli_seconds).
+ erlang:monotonic_time(millisecond).
%% ------------------------------------------------------- %%
diff --git a/lib/stdlib/test/timer_simple_SUITE.erl b/lib/stdlib/test/timer_simple_SUITE.erl
index ff5116b8b6..1a582ae95a 100644
--- a/lib/stdlib/test/timer_simple_SUITE.erl
+++ b/lib/stdlib/test/timer_simple_SUITE.erl
@@ -457,7 +457,7 @@ append([],X) ->
X.
system_time() ->
- erlang:monotonic_time(micro_seconds).
+ erlang:monotonic_time(microsecond).
%% ------------------------------------------------------- %%
diff --git a/lib/stdlib/test/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl
index 1dfcda4ed0..f0feda217a 100644
--- a/lib/stdlib/test/zip_SUITE.erl
+++ b/lib/stdlib/test/zip_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2006-2017. All Rights Reserved.
+%% Copyright Ericsson AB 2006-2016. All Rights Reserved.
%%
%% Licensed under the Apache License, Version 2.0 (the "License");
%% you may not use this file except in compliance with the License.