aboutsummaryrefslogtreecommitdiffstats
path: root/lib/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'lib/stdlib')
-rw-r--r--lib/stdlib/doc/src/c.xml26
-rw-r--r--lib/stdlib/doc/src/erl_tar.xml72
-rw-r--r--lib/stdlib/doc/src/ets.xml4
-rw-r--r--lib/stdlib/doc/src/filelib.xml54
-rw-r--r--lib/stdlib/doc/src/filename.xml37
-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/gen_statem.xml167
-rw-r--r--lib/stdlib/doc/src/notes.xml2
-rw-r--r--lib/stdlib/doc/src/shell.xml10
-rw-r--r--lib/stdlib/doc/src/sys.xml4
-rw-r--r--lib/stdlib/src/Makefile4
-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.erl260
-rw-r--r--lib/stdlib/src/dets.erl7
-rw-r--r--lib/stdlib/src/edlin_expand.erl95
-rw-r--r--lib/stdlib/src/erl_eval.erl1
-rw-r--r--lib/stdlib/src/erl_expand_records.erl18
-rw-r--r--lib/stdlib/src/erl_parse.yrl47
-rw-r--r--lib/stdlib/src/erl_tar.erl2562
-rw-r--r--lib/stdlib/src/erl_tar.hrl394
-rw-r--r--lib/stdlib/src/ets.erl18
-rw-r--r--lib/stdlib/src/filelib.erl122
-rw-r--r--lib/stdlib/src/filename.erl140
-rw-r--r--lib/stdlib/src/gen_event.erl2
-rw-r--r--lib/stdlib/src/gen_fsm.erl2
-rw-r--r--lib/stdlib/src/gen_statem.erl867
-rw-r--r--lib/stdlib/src/io_lib.erl2
-rw-r--r--lib/stdlib/src/io_lib_format.erl5
-rw-r--r--lib/stdlib/src/io_lib_pretty.erl121
-rw-r--r--lib/stdlib/src/otp_internal.erl37
-rw-r--r--lib/stdlib/src/proplists.erl2
-rw-r--r--lib/stdlib/src/qlc.erl6
-rw-r--r--lib/stdlib/src/shell_default.erl3
-rw-r--r--lib/stdlib/src/sofs.erl357
-rw-r--r--lib/stdlib/src/stdlib.appup.src4
-rw-r--r--lib/stdlib/src/zip.erl62
-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.erl9
-rw-r--r--lib/stdlib/test/edlin_expand_SUITE.erl79
-rw-r--r--lib/stdlib/test/erl_lint_SUITE.erl104
-rw-r--r--lib/stdlib/test/erl_pp_SUITE.erl13
-rw-r--r--lib/stdlib/test/erl_scan_SUITE.erl15
-rw-r--r--lib/stdlib/test/ets_SUITE.erl217
-rw-r--r--lib/stdlib/test/ets_tough_SUITE.erl58
-rw-r--r--lib/stdlib/test/filelib_SUITE.erl55
-rw-r--r--lib/stdlib/test/filename_SUITE.erl75
-rw-r--r--lib/stdlib/test/gen_statem_SUITE.erl105
-rw-r--r--lib/stdlib/test/io_SUITE.erl262
-rw-r--r--lib/stdlib/test/lists_SUITE.erl2
-rw-r--r--lib/stdlib/test/qlc_SUITE.erl18
-rw-r--r--lib/stdlib/test/rand_SUITE.erl6
-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.erl2
-rw-r--r--lib/stdlib/test/sofs_SUITE.erl9
-rw-r--r--lib/stdlib/test/tar_SUITE.erl178
-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.tarbin0 -> 61440 bytes
-rw-r--r--lib/stdlib/test/tar_SUITE_data/sparse01.tarbin0 -> 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.tarbin0 -> 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/zip_SUITE.erl36
74 files changed, 4799 insertions, 2291 deletions
diff --git a/lib/stdlib/doc/src/c.xml b/lib/stdlib/doc/src/c.xml
index 55a77d1bc5..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>
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..05401a2d40 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>
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 2a413835d0..0ccca37a9d 100644
--- a/lib/stdlib/doc/src/filename.xml
+++ b/lib/stdlib/doc/src/filename.xml
@@ -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
@@ -511,6 +513,33 @@ true
</func>
<func>
+ <name name="safe_relative_path" arity="1"/>
+ <fsummary>Sanitize a relative path to avoid directory traversal attacks.</fsummary>
+ <desc>
+ <p>Sanitizes the relative path by eliminating ".." and "."
+ components to protect against directory traversal attacks.
+ Either returns the sanitized path name, or the atom
+ <c>unsafe</c> if the path is unsafe.
+ The path is considered unsafe in the following circumstances:</p>
+ <list type="bulleted">
+ <item><p>The path is not relative.</p></item>
+ <item><p>A ".." component would climb up above the root of
+ the relative path.</p></item>
+ </list>
+ <p><em>Examples:</em></p>
+ <pre>
+1> <input>filename:safe_relative_path("dir/sub_dir/..").</input>
+"dir"
+2> <input>filename:safe_relative_path("dir/..").</input>
+[]
+3> <input>filename:safe_relative_path("dir/../..").</input>
+unsafe
+4> <input>filename:safe_relative_path("/abs/path").</input>
+unsafe</pre>
+ </desc>
+ </func>
+
+ <func>
<name name="split" arity="1"/>
<fsummary>Split a filename into its path components.</fsummary>
<desc>
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/gen_statem.xml b/lib/stdlib/doc/src/gen_statem.xml
index fd498ee82e..5eb13db1aa 100644
--- a/lib/stdlib/doc/src/gen_statem.xml
+++ b/lib/stdlib/doc/src/gen_statem.xml
@@ -4,7 +4,7 @@
<erlref>
<header>
<copyright>
- <year>2016</year>
+ <year>2016-2017</year>
<holder>Ericsson AB. All Rights Reserved.</holder>
</copyright>
<legalnotice>
@@ -587,8 +587,8 @@ handle_event(_, _, State, Data) ->
<name name="state_enter"/>
<desc>
<p>
- If the state machine should use <em>state enter calls</em>
- is selected when starting the <c>gen_statem</c>
+ Whether the state machine should use <em>state enter calls</em>
+ or not is selected when starting the <c>gen_statem</c>
and after code change using the return value from
<seealso marker="#Module:callback_mode/0"><c>Module:callback_mode/0</c></seealso>.
</p>
@@ -606,7 +606,16 @@ handle_event(_, _, State, Data) ->
See
<seealso marker="#Module:StateName/3"><c>Module:StateName/3</c></seealso>
and
- <seealso marker="#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>.
+ <seealso marker="#Module:handle_event/4"><c>Module:handle_event/4</c></seealso>.
+ Such a call can be repeated by returning a
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state</c>
+ </seealso>
+ or
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state_and_data</c>
+ </seealso>
+ tuple from the state callback.
</p>
<p>
If
@@ -625,7 +634,8 @@ handle_event(_, _, State, Data) ->
right before entering the initial state even though this
formally is not a state change.
In this case <c>OldState</c> will be the same as <c>State</c>,
- which can not happen for a subsequent state change.
+ which can not happen for a subsequent state change,
+ but will happen when repeating the state enter call.
</p>
</desc>
</datatype>
@@ -640,7 +650,15 @@ handle_event(_, _, State, Data) ->
<list type="ordered">
<item>
<p>
- If the state changes or is the initial state, and
+ If the state changes, is the initial state,
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state</c>
+ </seealso>
+ or
+ <seealso marker="#type-state_callback_result">
+ <c>repeat_state_and_data</c>
+ </seealso>
+ is used, and also
<seealso marker="#type-state_enter"><em>state enter calls</em></seealso>
are used, the <c>gen_statem</c> calls
the new state callback with arguments
@@ -983,6 +1001,33 @@ handle_event(_, _, State, Data) ->
</desc>
</datatype>
<datatype>
+ <name name="init_result"/>
+ <desc>
+ <p>
+ For a succesful initialization,
+ <c><anno>State</anno></c> is the initial
+ <seealso marker="#type-state"><c>state()</c></seealso>
+ and <c><anno>Data</anno></c> the initial server
+ <seealso marker="#type-data"><c>data()</c></seealso>
+ of the <c>gen_statem</c>.
+ </p>
+ <p>
+ The <seealso marker="#type-action"><c>Actions</c></seealso>
+ are executed when entering the first
+ <seealso marker="#type-state">state</seealso> just as for a
+ <seealso marker="#state callback">state callback</seealso>,
+ except that the action <c>postpone</c> is forced to
+ <c>false</c> since there is no event to postpone.
+ </p>
+ <p>
+ For an unsuccesful initialization,
+ <c>{stop,<anno>Reason</anno>}</c>
+ or <c>ignore</c> should be used; see
+ <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>.
+ </p>
+ </desc>
+ </datatype>
+ <datatype>
<name name="state_enter_result"/>
<desc>
<p>
@@ -1068,6 +1113,37 @@ handle_event(_, _, State, Data) ->
<c>{next_state,CurrentState,CurrentData,<anno>Actions</anno>}</c>.
</p>
</item>
+ <tag><c>repeat_state</c></tag>
+ <item>
+ <p>
+ The <c>gen_statem</c> keeps the current state, or
+ does a state transition to the current state if you like,
+ sets <c><anno>NewData</anno></c>,
+ and executes all <c><anno>Actions</anno></c>.
+ If the <c>gen_statem</c> runs with
+ <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>,
+ the state enter call is repeated, see type
+ <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>,
+ otherwise <c>repeat_state</c> is the same as
+ <c>keep_state</c>.
+ </p>
+ </item>
+ <tag><c>repeat_state_and_data</c></tag>
+ <item>
+ <p>
+ The <c>gen_statem</c> keeps the current state and data, or
+ does a state transition to the current state if you like,
+ and executes all <c><anno>Actions</anno></c>.
+ This is the same as
+ <c>{repeat_state,CurrentData,<anno>Actions</anno>}</c>.
+ If the <c>gen_statem</c> runs with
+ <seealso marker="#type-state_enter"><em>state enter calls</em></seealso>,
+ the state enter call is repeated, see type
+ <seealso marker="#type-transition_option"><c>transition_option()</c></seealso>,
+ otherwise <c>repeat_state_and_data</c> is the same as
+ <c>keep_state_and_data</c>.
+ </p>
+ </item>
<tag><c>stop</c></tag>
<item>
<p>
@@ -1609,29 +1685,33 @@ handle_event(_, _, State, Data) ->
It is recommended to use an atom as <c>Reason</c> since
it will be wrapped in an <c>{error,Reason}</c> tuple.
</p>
+ <p>
+ Also note when upgrading a <c>gen_statem</c>,
+ this function and hence
+ the <c>Change={advanced,Extra}</c> parameter in the
+ <seealso marker="sasl:appup"><c>appup</c></seealso> file
+ is not only needed to update the internal state
+ or to act on the <c>Extra</c> argument.
+ It is also needed if an upgrade or downgrade should change
+ <seealso marker="#type-callback_mode"><em>callback mode</em></seealso>,
+ or else the callback mode after the code change
+ will not be honoured,
+ most probably causing a server crash.
+ </p>
</desc>
</func>
<func>
- <name>Module:init(Args) -> Result</name>
+ <name>Module:init(Args) -> Result(StateType)</name>
<fsummary>
Optional function for initializing process and internal state.
</fsummary>
<type>
<v>Args = term()</v>
- <v>Result = {ok,State,Data}</v>
- <v>&nbsp;| {ok,State,Data,Actions}</v>
- <v>&nbsp;| {stop,Reason} | ignore</v>
- <v>State = <seealso marker="#type-state">state()</seealso></v>
- <v>
- Data = <seealso marker="#type-data">data()</seealso>
- </v>
<v>
- Actions =
- [<seealso marker="#type-action">action()</seealso>] |
- <seealso marker="#type-action">action()</seealso>
+ Result(StateType) =
+ <seealso marker="#type-init_result">init_result(StateType)</seealso>
</v>
- <v>Reason = term()</v>
</type>
<desc>
<marker id="Module:init-1"/>
@@ -1644,30 +1724,9 @@ handle_event(_, _, State, Data) ->
the implementation state and server data.
</p>
<p>
- <c>Args</c> is the <c>Args</c> argument provided to the start
+ <c>Args</c> is the <c>Args</c> argument provided to that start
function.
</p>
- <p>
- If the initialization is successful, the function is to
- return <c>{ok,State,Data}</c> or
- <c>{ok,State,Data,Actions}</c>.
- <c>State</c> is the initial
- <seealso marker="#type-state"><c>state()</c></seealso>
- and <c>Data</c> the initial server
- <seealso marker="#type-data"><c>data()</c></seealso>.
- </p>
- <p>
- The <seealso marker="#type-action"><c>Actions</c></seealso>
- are executed when entering the first
- <seealso marker="#type-state">state</seealso> just as for a
- <seealso marker="#state callback">state callback</seealso>.
- </p>
- <p>
- If the initialization fails,
- the function is to return <c>{stop,Reason}</c>
- or <c>ignore</c>; see
- <seealso marker="#start_link/3"><c>start_link/3,4</c></seealso>.
- </p>
<note>
<p>
This callback is optional, so a callback module does not need
@@ -1873,22 +1932,33 @@ handle_event(_, _, State, Data) ->
<seealso marker="#type-enter_action">actions</seealso>
that may be returned:
<seealso marker="#type-postpone"><c>postpone()</c></seealso>
- and
+ is not allowed since a <em>state enter call</em> is not
+ an event so there is no event to postpone, and
<seealso marker="#type-action"><c>{next_event,_,_}</c></seealso>
- are not allowed.
+ is not allowed since using <em>state enter calls</em>
+ should not affect how events are consumed and produced.
You may also not change states from this call.
Should you return <c>{next_state,NextState, ...}</c>
with <c>NextState =/= State</c> the <c>gen_statem</c> crashes.
- You are advised to use <c>{keep_state,...}</c> or
- <c>keep_state_and_data</c>.
+ It is possible to use <c>{repeat_state, ...}</c>,
+ <c>{repeat_state_and_data,_}</c> or
+ <c>repeat_state_and_data</c> but all of them makes little
+ sense since you immediately will be called again with a new
+ <em>state enter call</em> making this just a weird way
+ of looping, and there are better ways to loop in Erlang.
+ You are advised to use <c>{keep_state,...}</c>,
+ <c>{keep_state_and_data,_}</c> or
+ <c>keep_state_and_data</c> since you can not change states
+ from a <em>state enter call</em> anyway.
</p>
<p>
Note the fact that you can use
<seealso marker="erts:erlang#throw/1"><c>throw</c></seealso>
to return the result, which can be useful.
For example to bail out with <c>throw(keep_state_and_data)</c>
- from deep within complex code that is in no position to
- return <c>{next_state,State,Data}</c>.
+ from deep within complex code that can not
+ return <c>{next_state,State,Data}</c> because
+ <c>State</c> or <c>Data</c> is no longer in scope.
</p>
</desc>
</func>
@@ -1903,6 +1973,11 @@ handle_event(_, _, State, Data) ->
<v>Ignored = term()</v>
</type>
<desc>
+ <note>
+ <p>This callback is optional, so callback modules need not
+ export it. The <c>gen_statem</c> module provides a default
+ implementation without cleanup.</p>
+ </note>
<p>
This function is called by a <c>gen_statem</c>
when it is about to terminate. It is to be the opposite of
diff --git a/lib/stdlib/doc/src/notes.xml b/lib/stdlib/doc/src/notes.xml
index 0143686bb2..0e8bf3d27c 100644
--- a/lib/stdlib/doc/src/notes.xml
+++ b/lib/stdlib/doc/src/notes.xml
@@ -3163,7 +3163,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/shell.xml b/lib/stdlib/doc/src/shell.xml
index d6e8036d4e..f52bc39deb 100644
--- a/lib/stdlib/doc/src/shell.xml
+++ b/lib/stdlib/doc/src/shell.xml
@@ -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>
diff --git a/lib/stdlib/doc/src/sys.xml b/lib/stdlib/doc/src/sys.xml
index 9091a46df9..45171f814d 100644
--- a/lib/stdlib/doc/src/sys.xml
+++ b/lib/stdlib/doc/src/sys.xml
@@ -83,8 +83,8 @@
<p>If the modules used to implement the process change dynamically
during runtime, the process must understand one more message. An
example is the <seealso marker="gen_event"><c>gen_event</c></seealso>
- processes. The message is <c>{get_modules, From}</c>.
- The reply to this message is <c>From ! {modules, Modules}</c>, where
+ processes. The message is <c>{_Label, {From, Ref}, get_modules}</c>.
+ The reply to this message is <c>From ! {Ref, Modules}</c>, where
<c>Modules</c> is a list of the currently active modules in the
process.</p>
<p>This message is used by the release handler to find which
diff --git a/lib/stdlib/src/Makefile b/lib/stdlib/src/Makefile
index d6c0ff8d8d..ed3dfb342c 100644
--- a/lib/stdlib/src/Makefile
+++ b/lib/stdlib/src/Makefile
@@ -130,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)
@@ -228,7 +228,7 @@ $(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/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 d36630214c..52df2319dd 100644
--- a/lib/stdlib/src/c.erl
+++ b/lib/stdlib/src/c.erl
@@ -23,7 +23,7 @@
%% 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,mm/0,lm/0,
@@ -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"
@@ -72,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(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.
-c(File, Opts0) when is_list(Opts0) ->
- Opts = [report_errors,report_warnings|Opts0],
+%% 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.
@@ -113,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]),
@@ -135,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
diff --git a/lib/stdlib/src/dets.erl b/lib/stdlib/src/dets.erl
index 5bc9475fc8..e81383775b 100644
--- a/lib/stdlib/src/dets.erl
+++ b/lib/stdlib/src/dets.erl
@@ -1063,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, {match_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));
diff --git a/lib/stdlib/src/edlin_expand.erl b/lib/stdlib/src/edlin_expand.erl
index 5f821caef0..a1a97af4c5 100644
--- a/lib/stdlib/src/edlin_expand.erl
+++ b/lib/stdlib/src/edlin_expand.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2005-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2005-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.
@@ -101,44 +101,77 @@ match(Prefix, Alts, Extra0) ->
%% Return the list of names L in multiple columns.
format_matches(L) ->
- S = format_col(lists:sort(L), []),
+ {S1, Dots} = format_col(lists:sort(L), []),
+ S = case Dots of
+ true ->
+ {_, Prefix} = longest_common_head(vals(L)),
+ PrefixLen = length(Prefix),
+ case PrefixLen =< 3 of
+ true -> S1; % Do not replace the prefix with "...".
+ false ->
+ LeadingDotsL = leading_dots(L, PrefixLen),
+ {S2, _} = format_col(lists:sort(LeadingDotsL), []),
+ S2
+ end;
+ false -> S1
+ end,
["\n" | S].
format_col([], _) -> [];
-format_col(L, Acc) -> format_col(L, field_width(L), 0, Acc).
-
-format_col(X, Width, Len, Acc) when Width + Len > 79 ->
- format_col(X, Width, 0, ["\n" | Acc]);
-format_col([A|T], Width, Len, Acc0) ->
- H = case A of
- %% If it's a tuple {string(), integer()}, we assume it's an
- %% arity, and meant to be printed.
- {H0, I} when is_integer(I) ->
- H0 ++ "/" ++ integer_to_list(I);
- {H1, _} -> H1;
- H2 -> H2
- end,
- Acc = [io_lib:format("~-*ts", [Width,H]) | Acc0],
- format_col(T, Width, Len+Width, Acc);
-format_col([], _, _, Acc) ->
- lists:reverse(Acc, "\n").
-
-field_width(L) -> field_width(L, 0).
-
-field_width([{H,_}|T], W) ->
+format_col(L, Acc) ->
+ LL = 79,
+ format_col(L, field_width(L, LL), 0, Acc, LL, false).
+
+format_col(X, Width, Len, Acc, LL, Dots) when Width + Len > LL ->
+ format_col(X, Width, 0, ["\n" | Acc], LL, Dots);
+format_col([A|T], Width, Len, Acc0, LL, Dots) ->
+ {H0, R} = format_val(A),
+ Hmax = LL - length(R),
+ {H, NewDots} =
+ case length(H0) > Hmax of
+ true -> {io_lib:format("~-*ts", [Hmax - 3, H0]) ++ "...", true};
+ false -> {H0, Dots}
+ end,
+ Acc = [io_lib:format("~-*ts", [Width, H ++ R]) | Acc0],
+ format_col(T, Width, Len+Width, Acc, LL, NewDots);
+format_col([], _, _, Acc, _LL, Dots) ->
+ {lists:reverse(Acc, "\n"), Dots}.
+
+format_val({H, I}) when is_integer(I) ->
+ %% If it's a tuple {string(), integer()}, we assume it's an
+ %% arity, and meant to be printed.
+ {H, "/" ++ integer_to_list(I)};
+format_val({H, _}) ->
+ {H, ""};
+format_val(H) ->
+ {H, ""}.
+
+field_width(L, LL) -> field_width(L, 0, LL).
+
+field_width([{H,_}|T], W, LL) ->
case length(H) of
- L when L > W -> field_width(T, L);
- _ -> field_width(T, W)
+ L when L > W -> field_width(T, L, LL);
+ _ -> field_width(T, W, LL)
end;
-field_width([H|T], W) ->
+field_width([H|T], W, LL) ->
case length(H) of
- L when L > W -> field_width(T, L);
- _ -> field_width(T, W)
+ L when L > W -> field_width(T, L, LL);
+ _ -> field_width(T, W, LL)
end;
-field_width([], W) when W < 40 ->
+field_width([], W, LL) when W < LL - 3 ->
W + 4;
-field_width([], _) ->
- 40.
+field_width([], _, LL) ->
+ LL.
+
+vals([]) -> [];
+vals([{S, _}|L]) -> [S|vals(L)];
+vals([S|L]) -> [S|vals(L)].
+
+leading_dots([], _Len) -> [];
+leading_dots([{H, I}|L], Len) ->
+ [{"..." ++ nthtail(Len, H), I}|leading_dots(L, Len)];
+leading_dots([H|L], Len) ->
+ ["..." ++ nthtail(Len, H)|leading_dots(L, Len)].
longest_common_head([]) ->
no;
diff --git a/lib/stdlib/src/erl_eval.erl b/lib/stdlib/src/erl_eval.erl
index 40a34aa30f..eafee346eb 100644
--- a/lib/stdlib/src/erl_eval.erl
+++ b/lib/stdlib/src/erl_eval.erl
@@ -1306,6 +1306,7 @@ partial_eval(Expr) ->
ev_expr({op,_,Op,L,R}) -> erlang:Op(ev_expr(L), ev_expr(R));
ev_expr({op,_,Op,A}) -> erlang:Op(ev_expr(A));
ev_expr({integer,_,X}) -> X;
+ev_expr({char,_,X}) -> X;
ev_expr({float,_,X}) -> X;
ev_expr({atom,_,X}) -> X;
ev_expr({tuple,_,Es}) ->
diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl
index 2280464bff..16220bceb4 100644
--- a/lib/stdlib/src/erl_expand_records.erl
+++ b/lib/stdlib/src/erl_expand_records.erl
@@ -30,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
- calltype=#{}, % Call types
- 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()],
@@ -72,7 +72,7 @@ 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([{function,L,N,A,Cs0} | Fs0], St0) ->
@@ -546,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);
diff --git a/lib/stdlib/src/erl_parse.yrl b/lib/stdlib/src/erl_parse.yrl
index 9cd95705af..922455a6f2 100644
--- a/lib/stdlib/src/erl_parse.yrl
+++ b/lib/stdlib/src/erl_parse.yrl
@@ -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.
@@ -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'].
@@ -156,6 +154,7 @@ type -> '#' atom '{' field_types '}' : {type, ?anno('$1'),
record, ['$2'|'$4']}.
type -> binary_type : '$1'.
type -> integer : '$1'.
+type -> char : '$1'.
type -> 'fun' '(' ')' : {type, ?anno('$1'), 'fun', []}.
type -> 'fun' '(' fun_type_100 ')' : '$3'.
@@ -268,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'.
@@ -327,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 :
@@ -1056,13 +1050,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}}.
@@ -1076,11 +1070,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]};
@@ -1573,13 +1580,17 @@ new_anno(Term) ->
Abstr :: erl_parse_tree().
anno_to_term(Abstract) ->
- map_anno(fun erl_anno:to_term/1, 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
Term :: term().
anno_from_term(Term) ->
- map_anno(fun erl_anno:from_term/1, Term).
+ F = fun(T, Acc) -> {erl_anno:from_term(T), Acc} end,
+ {NewTerm, []} = modify_anno1(Term, [], F),
+ NewTerm.
%% Forms.
modify_anno1({function,F,A}, Ac, _Mf) ->
diff --git a/lib/stdlib/src/erl_tar.erl b/lib/stdlib/src/erl_tar.erl
index a383a0fc67..086e77cd28 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,1608 @@ 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} ->
+ foldl_read(Reader, Fun, Accu, Opts);
+ {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/ets.erl b/lib/stdlib/src/ets.erl
index 20de06fd0b..d6fd1e3ea1 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().
@@ -488,7 +488,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 +505,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/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 c4586171ca..b5df5c9d37 100644
--- a/lib/stdlib/src/filename.erl
+++ b/lib/stdlib/src/filename.erl
@@ -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,8 +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]).
--export([find_src/1, find_src/2, flatten/1]).
+ rootname/1, rootname/2, split/1, flatten/1, nativename/1,
+ safe_relative_path/1]).
+-export([find_src/1, find_src/2]). % deprecated
-export([basedir/2, basedir/3]).
%% Undocumented and unsupported exports.
@@ -750,7 +754,45 @@ separators() ->
_ -> {false, false}
end.
+-spec safe_relative_path(Filename) -> 'unsafe' | SafeFilename when
+ Filename :: file:name_all(),
+ SafeFilename :: file:name_all().
+
+safe_relative_path(Path) ->
+ case pathtype(Path) of
+ relative ->
+ Cs0 = split(Path),
+ safe_relative_path_1(Cs0, []);
+ _ ->
+ unsafe
+ end.
+safe_relative_path_1(["."|T], Acc) ->
+ safe_relative_path_1(T, Acc);
+safe_relative_path_1([<<".">>|T], Acc) ->
+ safe_relative_path_1(T, Acc);
+safe_relative_path_1([".."|T], Acc) ->
+ climb(T, Acc);
+safe_relative_path_1([<<"..">>|T], Acc) ->
+ climb(T, Acc);
+safe_relative_path_1([H|T], Acc) ->
+ safe_relative_path_1(T, [H|Acc]);
+safe_relative_path_1([], []) ->
+ [];
+safe_relative_path_1([], Acc) ->
+ join(lists:reverse(Acc)).
+
+climb(_, []) ->
+ unsafe;
+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) --
@@ -793,14 +835,7 @@ separators() ->
| {'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
@@ -816,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.
@@ -884,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/gen_event.erl b/lib/stdlib/src/gen_event.erl
index 4839fe4f2c..0aebf1bdc5 100644
--- a/lib/stdlib/src/gen_event.erl
+++ b/lib/stdlib/src/gen_event.erl
@@ -778,7 +778,7 @@ stop_handlers([], _) ->
[].
%% Message from the release_handler.
-%% The list of modules got to be a set !
+%% The list of modules got to be a set, i.e. no duplicate elements!
get_modules(MSL) ->
Mods = [Handler#handler.module || Handler <- MSL],
ordsets:to_list(ordsets:from_list(Mods)).
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_statem.erl b/lib/stdlib/src/gen_statem.erl
index 018aca90e6..cacc932ec4 100644
--- a/lib/stdlib/src/gen_statem.erl
+++ b/lib/stdlib/src/gen_statem.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2016. All Rights Reserved.
+%% Copyright Ericsson AB 2016-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.
@@ -47,15 +47,17 @@
%% Type exports for templates and callback modules
-export_type(
[event_type/0,
- init_result/0,
callback_mode_result/0,
- state_function_result/0,
- handle_event_result/0,
+ init_result/1,
state_enter_result/1,
event_handler_result/1,
reply_action/0,
enter_action/0,
action/0]).
+%% Old types, not advertised
+-export_type(
+ [state_function_result/0,
+ handle_event_result/0]).
%% Type that is exported just to be documented
-export_type([transition_option/0]).
@@ -143,9 +145,10 @@
{'reply', % Reply to a caller
From :: from(), Reply :: term()}.
--type init_result() ::
- {ok, state(), data()} |
- {ok, state(), data(), [action()] | action()} |
+-type init_result(StateType) ::
+ {ok, State :: StateType, Data :: data()} |
+ {ok, State :: StateType, Data :: data(),
+ Actions :: [action()] | action()} |
'ignore' |
{'stop', Reason :: term()}.
@@ -182,12 +185,23 @@
'keep_state_and_data' | % {keep_state_and_data,[]}
{'keep_state_and_data', % Keep state and data -> only actions
Actions :: [ActionType] | ActionType} |
+ %%
+ {'repeat_state', % {repeat_state,NewData,[]}
+ NewData :: data()} |
+ {'repeat_state', % Repeat state, change data
+ NewData :: data(),
+ Actions :: [ActionType] | ActionType} |
+ 'repeat_state_and_data' | % {repeat_state_and_data,[]}
+ {'repeat_state_and_data', % Repeat state and data -> only actions
+ Actions :: [ActionType] | ActionType} |
+ %%
'stop' | % {stop,normal}
{'stop', % Stop the server
Reason :: term()} |
{'stop', % Stop the server
Reason :: term(),
NewData :: data()} |
+ %%
{'stop_and_reply', % Reply then stop the server
Reason :: term(),
Replies :: [reply_action()] | reply_action()} |
@@ -201,7 +215,7 @@
%% the server is not running until this function has returned
%% an {ok, ...} tuple. Thereafter the state callbacks are called
%% for all events to this server.
--callback init(Args :: term()) -> init_result().
+-callback init(Args :: term()) -> init_result(state()).
%% This callback shall return the callback mode of the callback module.
%%
@@ -275,6 +289,8 @@
-optional_callbacks(
[init/1, % One may use enter_loop/5,6,7 instead
format_status/2, % Has got a default implementation
+ terminate/3, % Has got a default implementation
+ code_change/4, % Only needed by advanced soft upgrade
%%
state_name/3, % Example for callback_mode() =:= state_functions:
%% there has to be a StateName/3 callback function
@@ -304,12 +320,16 @@ event_type({call,From}) ->
from(From);
event_type(Type) ->
case Type of
+ {call,From} ->
+ from(From);
cast ->
true;
info ->
true;
timeout ->
true;
+ state_timeout ->
+ true;
internal ->
true;
_ ->
@@ -588,6 +608,22 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
true ->
[Actions,{postpone,false}]
end,
+ TimerRefs = #{},
+ %% Key: timer ref
+ %% Value: the timer type i.e the timer's event type
+ %%
+ TimerTypes = #{},
+ %% Key: timer type i.e the timer's event type
+ %% Value: timer ref
+ %%
+ %% We add a timer to both timer_refs and timer_types
+ %% when we start it. When we request an asynchronous
+ %% timer cancel we remove it from timer_types. When
+ %% the timer cancel message arrives we remove it from
+ %% timer_refs.
+ %%
+ Hibernate = false,
+ CancelTimers = 0,
S = #{
callback_mode => undefined,
state_enter => false,
@@ -596,25 +632,25 @@ enter(Module, Opts, State, Data, Server, Actions, Parent) ->
state => State,
data => Data,
postponed => P,
- %% The rest of the fields are set from to the arguments to
- %% loop_event_actions/10 when it finally loops back to loop/3
- %% in loop_events/10
%%
- %% Marker for initial state, cleared immediately when used
- init_state => true
+ %% The following fields are finally set from to the arguments to
+ %% loop_event_actions/9 when it finally loops back to loop/3
+ %% in loop_event_result/11
+ timer_refs => TimerRefs,
+ timer_types => TimerTypes,
+ hibernate => Hibernate,
+ cancel_timers => CancelTimers
},
NewDebug = sys_debug(Debug, S, State, {enter,Event,State}),
case call_callback_mode(S) of
{ok,NewS} ->
- TimerRefs = #{},
- TimerTypes = #{},
loop_event_actions(
- Parent, NewDebug, NewS, TimerRefs, TimerTypes,
- Events, Event, State, Data, NewActions);
+ Parent, NewDebug, NewS,
+ Events, Event, State, Data, NewActions, true);
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- NewDebug, S, [Event|Events])
+ Class, Reason, Stacktrace, NewDebug,
+ S, [Event|Events])
end.
%%%==========================================================================
@@ -683,9 +719,7 @@ system_continue(Parent, Debug, S) ->
loop(Parent, Debug, S).
system_terminate(Reason, _Parent, Debug, S) ->
- terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S, []).
+ terminate(exit, Reason, ?STACKTRACE(), Debug, S, []).
system_code_change(
#{module := Module,
@@ -796,23 +830,22 @@ wakeup_from_hibernate(Parent, Debug, S) ->
%% and detours through sys:handle_system_message/7 and proc_lib:hibernate/3
%% Entry point for system_continue/3
-loop(Parent, Debug, #{hibernate := Hibernate} = S) ->
- case Hibernate of
- true ->
- %% Does not return but restarts process at
- %% wakeup_from_hibernate/3 that jumps to loop_receive/3
- proc_lib:hibernate(
- ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]),
- error(
- {should_not_have_arrived_here_but_instead_in,
- {wakeup_from_hibernate,3}});
- false ->
- loop_receive(Parent, Debug, S)
- end.
+loop(Parent, Debug, #{hibernate := true, cancel_timers := 0} = S) ->
+ loop_hibernate(Parent, Debug, S);
+loop(Parent, Debug, S) ->
+ loop_receive(Parent, Debug, S).
+
+loop_hibernate(Parent, Debug, S) ->
+ %% Does not return but restarts process at
+ %% wakeup_from_hibernate/3 that jumps to loop_receive/3
+ proc_lib:hibernate(
+ ?MODULE, wakeup_from_hibernate, [Parent,Debug,S]),
+ error(
+ {should_not_have_arrived_here_but_instead_in,
+ {wakeup_from_hibernate,3}}).
%% Entry point for wakeup_from_hibernate/3
-loop_receive(
- Parent, Debug, #{timer_refs := TimerRefs, timer_types := TimerTypes} = S) ->
+loop_receive(Parent, Debug, S) ->
receive
Msg ->
case Msg of
@@ -821,30 +854,87 @@ loop_receive(
%% Does not return but tail recursively calls
%% system_continue/3 that jumps to loop/3
sys:handle_system_msg(
- Req, Pid, Parent, ?MODULE, Debug, S, Hibernate);
+ Req, Pid, Parent, ?MODULE, Debug, S,
+ Hibernate);
{'EXIT',Parent,Reason} = EXIT ->
- %% EXIT is not a 2-tuple and therefore
- %% not an event and has no event_type(),
- %% but this will stand out in the crash report...
- terminate(
- exit, Reason, ?STACKTRACE(), Debug, S, [EXIT]);
+ %% EXIT is not a 2-tuple therefore
+ %% not an event but this will stand out
+ %% in the crash report...
+ Q = [EXIT],
+ terminate(exit, Reason, ?STACKTRACE(), Debug, S, Q);
{timeout,TimerRef,TimerMsg} ->
+ #{timer_refs := TimerRefs,
+ timer_types := TimerTypes,
+ hibernate := Hibernate} = S,
case TimerRefs of
#{TimerRef := TimerType} ->
- Event = {TimerType,TimerMsg},
- %% Unregister the triggered timeout
+ %% We know of this timer; is it a running
+ %% timer or a timer being cancelled that
+ %% managed to send a late timeout message?
+ case TimerTypes of
+ #{TimerType := TimerRef} ->
+ %% The timer type maps back to this
+ %% timer ref, so it was a running timer
+ Event = {TimerType,TimerMsg},
+ %% Unregister the triggered timeout
+ NewTimerRefs =
+ maps:remove(TimerRef, TimerRefs),
+ NewTimerTypes =
+ maps:remove(TimerType, TimerTypes),
+ loop_receive_result(
+ Parent, Debug,
+ S#{
+ timer_refs := NewTimerRefs,
+ timer_types := NewTimerTypes},
+ Hibernate,
+ Event);
+ _ ->
+ %% This was a late timeout message
+ %% from timer being cancelled, so
+ %% ignore it and expect a cancel_timer
+ %% msg shortly
+ loop_receive(Parent, Debug, S)
+ end;
+ _ ->
+ %% Not our timer; present it as an event
+ Event = {info,Msg},
loop_receive_result(
- Parent, Debug, S,
- maps:remove(TimerRef, TimerRefs),
- maps:remove(TimerType, TimerTypes),
- Event);
+ Parent, Debug, S, Hibernate, Event)
+ end;
+ {cancel_timer,TimerRef,_} ->
+ #{timer_refs := TimerRefs,
+ cancel_timers := CancelTimers,
+ hibernate := Hibernate} = S,
+ case TimerRefs of
+ #{TimerRef := _} ->
+ %% We must have requested a cancel
+ %% of this timer so it is already
+ %% removed from TimerTypes
+ NewTimerRefs =
+ maps:remove(TimerRef, TimerRefs),
+ NewCancelTimers = CancelTimers - 1,
+ NewS =
+ S#{
+ timer_refs := NewTimerRefs,
+ cancel_timers := NewCancelTimers},
+ if
+ Hibernate =:= true, NewCancelTimers =:= 0 ->
+ %% No more cancel_timer msgs to expect;
+ %% we can hibernate
+ loop_hibernate(Parent, Debug, NewS);
+ NewCancelTimers >= 0 -> % Assert
+ loop_receive(Parent, Debug, NewS)
+ end;
_ ->
+ %% Not our cancel_timer msg;
+ %% present it as an event
Event = {info,Msg},
loop_receive_result(
- Parent, Debug, S,
- TimerRefs, TimerTypes, Event)
+ Parent, Debug, S, Hibernate, Event)
end;
_ ->
+ %% External msg
+ #{hibernate := Hibernate} = S,
Event =
case Msg of
{'$gen_call',From,Request} ->
@@ -855,208 +945,212 @@ loop_receive(
{info,Msg}
end,
loop_receive_result(
- Parent, Debug, S,
- TimerRefs, TimerTypes, Event)
+ Parent, Debug, S, Hibernate, Event)
end
end.
loop_receive_result(
- Parent, Debug, #{state := State} = S,
- TimerRefs, TimerTypes, Event) ->
- %% The fields 'timer_refs', 'timer_types' and 'hibernate'
- %% are now invalid in state map S - they will be recalculated
- %% and restored when we return to loop/3
- %%
+ Parent, Debug,
+ #{state := State,
+ timer_types := TimerTypes, cancel_timers := CancelTimers} = S,
+ Hibernate, Event) ->
+ %% From now the 'hibernate' field in S is invalid
+ %% and will be restored when looping back
+ %% in loop_event_result/11
NewDebug = sys_debug(Debug, S, State, {in,Event}),
- %% Here the queue of not yet handled events is created
+ %% Here is the queue of not yet handled events created
Events = [],
- Hibernate = false,
- loop_event(
- Parent, NewDebug, S, TimerRefs, TimerTypes, Events, Event, Hibernate).
+ %% Cancel any running event timer
+ case
+ cancel_timer_by_type(timeout, TimerTypes, CancelTimers)
+ of
+ {_,CancelTimers} ->
+ %% No timer cancelled
+ loop_event(Parent, NewDebug, S, Events, Event, Hibernate);
+ {NewTimerTypes,NewCancelTimers} ->
+ %% The timer is removed from NewTimerTypes but
+ %% remains in TimerRefs until we get
+ %% the cancel_timer msg
+ NewS =
+ S#{
+ timer_types := NewTimerTypes,
+ cancel_timers := NewCancelTimers},
+ loop_event(Parent, NewDebug, NewS, Events, Event, Hibernate)
+ end.
%% Entry point for handling an event, received or enqueued
loop_event(
- Parent, Debug, #{state := State, data := Data} = S, TimerRefs, TimerTypes,
+ Parent, Debug,
+ #{state := State, data := Data} = S,
Events, {Type,Content} = Event, Hibernate) ->
%%
- %% If Hibernate is true here it can only be
+ %% If (this old) Hibernate is true here it can only be
%% because it was set from an event action
- %% and we did not go into hibernation since there
- %% were events in queue, so we do what the user
+ %% and we did not go into hibernation since there were
+ %% events in queue, so we do what the user
%% might rely on i.e collect garbage which
%% would have happened if we actually hibernated
%% and immediately was awakened
Hibernate andalso garbage_collect(),
case call_state_function(S, Type, Content, State, Data) of
{ok,Result,NewS} ->
- %% Cancel event timeout
- {NewTimerRefs,NewTimerTypes} =
- cancel_timer_by_type(
- timeout, TimerRefs, TimerTypes),
- {NewData,NextState,Actions} =
+ {NextState,NewData,Actions,EnterCall} =
parse_event_result(
- true, Debug, NewS, Result,
- Events, Event, State, Data),
+ true, Debug, NewS,
+ Events, Event, State, Data, Result),
loop_event_actions(
- Parent, Debug, S, NewTimerRefs, NewTimerTypes,
- Events, Event, NextState, NewData, Actions);
+ Parent, Debug, NewS,
+ Events, Event, NextState, NewData, Actions, EnterCall);
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace, Debug, S, [Event|Events])
+ Class, Reason, Stacktrace, Debug, S,
+ [Event|Events])
end.
loop_event_actions(
Parent, Debug,
- #{state := State, state_enter := StateEnter} = S, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData, Actions) ->
+ #{state := State, state_enter := StateEnter} = S,
+ Events, Event, NextState, NewData,
+ Actions, EnterCall) ->
+ %% Hibernate is reborn here as false being
+ %% the default value from parse_actions/4
case parse_actions(Debug, S, State, Actions) of
{ok,NewDebug,Hibernate,TimeoutsR,Postpone,NextEventsR} ->
if
- StateEnter, NextState =/= State ->
+ StateEnter, EnterCall ->
loop_event_enter(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Parent, NewDebug, S,
Events, Event, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR);
- StateEnter ->
- case maps:is_key(init_state, S) of
- true ->
- %% Avoid infinite loop in initial state
- %% with state entry events
- NewS = maps:remove(init_state, S),
- loop_event_enter(
- Parent, NewDebug, NewS, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData,
- Hibernate, TimeoutsR, Postpone, NextEventsR);
- false ->
- loop_event_result(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData,
- Hibernate, TimeoutsR, Postpone, NextEventsR)
- end;
true ->
loop_event_result(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
+ Parent, NewDebug, S,
Events, Event, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR)
end;
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- Debug, S#{data := NewData}, [Event|Events])
+ Class, Reason, Stacktrace, Debug, S,
+ [Event|Events])
end.
loop_event_enter(
- Parent, Debug, #{state := State} = S, TimerRefs, TimerTypes,
+ Parent, Debug, #{state := State} = S,
Events, Event, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR) ->
case call_state_function(S, enter, State, NextState, NewData) of
{ok,Result,NewS} ->
- {NewerData,_,Actions} =
- parse_event_result(
- false, Debug, NewS, Result,
- Events, Event, NextState, NewData),
- loop_event_enter_actions(
- Parent, Debug, NewS, TimerRefs, TimerTypes,
- Events, Event, NextState, NewerData,
- Hibernate, TimeoutsR, Postpone, NextEventsR, Actions);
+ case parse_event_result(
+ false, Debug, NewS,
+ Events, Event, NextState, NewData, Result) of
+ {_,NewerData,Actions,EnterCall} ->
+ loop_event_enter_actions(
+ Parent, Debug, NewS,
+ Events, Event, NextState, NewerData,
+ Hibernate, TimeoutsR, Postpone, NextEventsR,
+ Actions, EnterCall)
+ end;
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- Debug, S#{state := NextState, data := NewData},
+ Class, Reason, Stacktrace, Debug,
+ S#{
+ state := NextState,
+ data := NewData,
+ hibernate := Hibernate},
[Event|Events])
end.
loop_event_enter_actions(
- Parent, Debug, S, TimerRefs, TimerTypes,
+ Parent, Debug, #{state_enter := StateEnter} = S,
Events, Event, NextState, NewData,
- Hibernate, TimeoutsR, Postpone, NextEventsR, Actions) ->
+ Hibernate, TimeoutsR, Postpone, NextEventsR,
+ Actions, EnterCall) ->
case
parse_enter_actions(
- Debug, S, NextState, Actions,
- Hibernate, TimeoutsR)
+ Debug, S, NextState, Actions, Hibernate, TimeoutsR)
of
{ok,NewDebug,NewHibernate,NewTimeoutsR,_,_} ->
- loop_event_result(
- Parent, NewDebug, S, TimerRefs, TimerTypes,
- Events, Event, NextState, NewData,
- NewHibernate, NewTimeoutsR, Postpone, NextEventsR);
+ if
+ StateEnter, EnterCall ->
+ loop_event_enter(
+ Parent, NewDebug, S,
+ Events, Event, NextState, NewData,
+ NewHibernate, NewTimeoutsR, Postpone, NextEventsR);
+ true ->
+ loop_event_result(
+ Parent, NewDebug, S,
+ Events, Event, NextState, NewData,
+ NewHibernate, NewTimeoutsR, Postpone, NextEventsR)
+ end;
{Class,Reason,Stacktrace} ->
terminate(
- Class, Reason, Stacktrace,
- Debug, S#{state := NextState, data := NewData},
+ Class, Reason, Stacktrace, Debug,
+ S#{
+ state := NextState,
+ data := NewData,
+ hibernate := Hibernate},
[Event|Events])
end.
loop_event_result(
- Parent, Debug,
- #{state := State, postponed := P_0} = S, TimerRefs_0, TimerTypes_0,
- Events, Event, NextState, NewData,
+ Parent, Debug_0,
+ #{state := State, postponed := P_0,
+ timer_refs := TimerRefs_0, timer_types := TimerTypes_0,
+ cancel_timers := CancelTimers_0} = S_0,
+ Events_0, Event_0, NextState, NewData,
Hibernate, TimeoutsR, Postpone, NextEventsR) ->
%%
%% All options have been collected and next_events are buffered.
%% Do the actual state transition.
%%
- {NewDebug,P_1} = % Move current event to postponed if Postpone
+ {Debug_1,P_1} = % Move current event to postponed if Postpone
case Postpone of
true ->
- {sys_debug(Debug, S, State, {postpone,Event,State}),
- [Event|P_0]};
+ {sys_debug(Debug_0, S_0, State, {postpone,Event_0,State}),
+ [Event_0|P_0]};
false ->
- {sys_debug(Debug, S, State, {consume,Event,State}),
+ {sys_debug(Debug_0, S_0, State, {consume,Event_0,State}),
P_0}
end,
- {Events_1,NewP,{TimerRefs_1,TimerTypes_1}} =
+ {Events_1,P_2,{TimerTypes_1,CancelTimers_1}} =
%% Move all postponed events to queue and cancel the
%% state timeout if the state changes
if
NextState =:= State ->
- {Events,P_1,{TimerRefs_0,TimerTypes_0}};
+ {Events_0,P_1,{TimerTypes_0,CancelTimers_0}};
true ->
- {lists:reverse(P_1, Events),[],
+ {lists:reverse(P_1, Events_0),
+ [],
cancel_timer_by_type(
- state_timeout, TimerRefs_0, TimerTypes_0)}
+ state_timeout, TimerTypes_0, CancelTimers_0)}
+ %% The state timer is removed from TimerTypes_1
+ %% but remains in TimerRefs_0 until we get
+ %% the cancel_timer msg
end,
- {TimerRefs_2,TimerTypes_2,TimeoutEvents} =
- %% Stop and start timers non-event timers
- parse_timers(TimerRefs_1, TimerTypes_1, TimeoutsR),
+ {TimerRefs_2,TimerTypes_2,CancelTimers_2,TimeoutEvents} =
+ %% Stop and start non-event timers
+ parse_timers(TimerRefs_0, TimerTypes_1, CancelTimers_1, TimeoutsR),
%% Place next events last in reversed queue
Events_2R = lists:reverse(Events_1, NextEventsR),
%% Enqueue immediate timeout events and start event timer
- {NewTimerRefs,NewTimerTypes,Events_3R} =
- process_timeout_events(
- TimerRefs_2, TimerTypes_2, TimeoutEvents, Events_2R),
- NewEvents = lists:reverse(Events_3R),
- loop_events(
- Parent, NewDebug, S, NewTimerRefs, NewTimerTypes,
- NewEvents, Hibernate, NextState, NewData, NewP).
-
-%% Loop until out of enqueued events
-%%
-loop_events(
- Parent, Debug, S, TimerRefs, TimerTypes,
- [] = _Events, Hibernate, State, Data, P) ->
- %% Update S and loop back to loop/3 to receive a new event
- NewS =
- S#{
- state := State,
- data := Data,
- postponed := P,
- hibernate => Hibernate,
- timer_refs => TimerRefs,
- timer_types => TimerTypes},
- loop(Parent, Debug, NewS);
-loop_events(
- Parent, Debug, S, TimerRefs, TimerTypes,
- [Event|Events], Hibernate, State, Data, P) ->
- %% Update S and continue with enqueued events
- NewS =
- S#{
- state := State,
- data := Data,
- postponed := P},
- loop_event(
- Parent, Debug, NewS, TimerRefs, TimerTypes, Events, Event, Hibernate).
-
+ Events_3R = prepend_timeout_events(TimeoutEvents, Events_2R),
+ S_1 =
+ S_0#{
+ state := NextState,
+ data := NewData,
+ postponed := P_2,
+ timer_refs := TimerRefs_2,
+ timer_types := TimerTypes_2,
+ cancel_timers := CancelTimers_2,
+ hibernate := Hibernate},
+ case lists:reverse(Events_3R) of
+ [] ->
+ %% Get a new event
+ loop(Parent, Debug_1, S_1);
+ [Event|Events] ->
+ %% Loop until out of enqueued events
+ loop_event(Parent, Debug_1, S_1, Events, Event, Hibernate)
+ end.
%%---------------------------------------------------------------------------
@@ -1069,19 +1163,6 @@ call_callback_mode(#{module := Module} = S) ->
catch
CallbackMode ->
callback_mode_result(S, CallbackMode);
- error:undef ->
- %% Process undef to check for the simple mistake
- %% of calling a nonexistent state function
- %% to make the undef more precise
- case erlang:get_stacktrace() of
- [{Module,callback_mode,[]=Args,_}
- |Stacktrace] ->
- {error,
- {undef_callback,{Module,callback_mode,Args}},
- Stacktrace};
- Stacktrace ->
- {error,undef,Stacktrace}
- end;
Class:Reason ->
{Class,Reason,erlang:get_stacktrace()}
end.
@@ -1126,8 +1207,7 @@ parse_callback_mode(_, _CBMode, StateEnter) ->
call_state_function(
- #{callback_mode := undefined} = S,
- Type, Content, State, Data) ->
+ #{callback_mode := undefined} = S, Type, Content, State, Data) ->
case call_callback_mode(S) of
{ok,NewS} ->
call_state_function(NewS, Type, Content, State, Data);
@@ -1135,13 +1215,12 @@ call_state_function(
Error
end;
call_state_function(
- #{callback_mode := CallbackMode,
- module := Module} = S,
+ #{callback_mode := CallbackMode, module := Module} = S,
Type, Content, State, Data) ->
try
case CallbackMode of
state_functions ->
- erlang:apply(Module, State, [Type,Content,Data]);
+ Module:State(Type, Content, Data);
handle_event_function ->
Module:handle_event(Type, Content, State, Data)
end
@@ -1151,41 +1230,6 @@ call_state_function(
catch
Result ->
{ok,Result,S};
- error:badarg ->
- case erlang:get_stacktrace() of
- [{erlang,apply,
- [Module,State,[Type,Content,Data]=Args],
- _}
- |Stacktrace]
- when CallbackMode =:= state_functions ->
- %% We get here e.g if apply fails
- %% due to State not being an atom
- {error,
- {undef_state_function,{Module,State,Args}},
- Stacktrace};
- Stacktrace ->
- {error,badarg,Stacktrace}
- end;
- error:undef ->
- %% Process undef to check for the simple mistake
- %% of calling a nonexistent state function
- %% to make the undef more precise
- case erlang:get_stacktrace() of
- [{Module,State,[Type,Content,Data]=Args,_}
- |Stacktrace]
- when CallbackMode =:= state_functions ->
- {error,
- {undef_state_function,{Module,State,Args}},
- Stacktrace};
- [{Module,handle_event,[Type,Content,State,Data]=Args,_}
- |Stacktrace]
- when CallbackMode =:= handle_event_function ->
- {error,
- {undef_state_function,{Module,handle_event,Args}},
- Stacktrace};
- Stacktrace ->
- {error,undef,Stacktrace}
- end;
Class:Reason ->
{Class,Reason,erlang:get_stacktrace()}
end.
@@ -1193,65 +1237,83 @@ call_state_function(
%% Interpret all callback return variants
parse_event_result(
- AllowStateChange, Debug, S, Result, Events, Event, State, Data) ->
+ AllowStateChange, Debug, S,
+ Events, Event, State, Data, Result) ->
case Result of
stop ->
terminate(
- exit, normal, ?STACKTRACE(), Debug, S, [Event|Events]);
+ exit, normal, ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events]);
{stop,Reason} ->
terminate(
- exit, Reason, ?STACKTRACE(), Debug, S, [Event|Events]);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events]);
{stop,Reason,NewData} ->
terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S#{data := NewData}, [Event|Events]);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := NewData},
+ [Event|Events]);
+ %%
{stop_and_reply,Reason,Replies} ->
- Q = [Event|Events],
reply_then_terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S, Q, Replies);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events], Replies);
{stop_and_reply,Reason,Replies,NewData} ->
- Q = [Event|Events],
reply_then_terminate(
- exit, Reason, ?STACKTRACE(),
- Debug, S#{data := NewData}, Q, Replies);
+ exit, Reason, ?STACKTRACE(), Debug,
+ S#{state := State, data := NewData},
+ [Event|Events], Replies);
+ %%
{next_state,State,NewData} ->
- {NewData,State,[]};
+ {State,NewData,[],false};
{next_state,NextState,NewData} when AllowStateChange ->
- {NewData,NextState,[]};
+ {NextState,NewData,[],true};
{next_state,State,NewData,Actions} ->
- {NewData,State,Actions};
+ {State,NewData,Actions,false};
{next_state,NextState,NewData,Actions} when AllowStateChange ->
- {NewData,NextState,Actions};
+ {NextState,NewData,Actions,true};
+ %%
{keep_state,NewData} ->
- {NewData,State,[]};
+ {State,NewData,[],false};
{keep_state,NewData,Actions} ->
- {NewData,State,Actions};
+ {State,NewData,Actions,false};
keep_state_and_data ->
- {Data,State,[]};
+ {State,Data,[],false};
{keep_state_and_data,Actions} ->
- {Data,State,Actions};
+ {State,Data,Actions,false};
+ %%
+ {repeat_state,NewData} ->
+ {State,NewData,[],true};
+ {repeat_state,NewData,Actions} ->
+ {State,NewData,Actions,true};
+ repeat_state_and_data ->
+ {State,Data,[],true};
+ {repeat_state_and_data,Actions} ->
+ {State,Data,Actions,true};
+ %%
_ ->
terminate(
error,
{bad_return_from_state_function,Result},
- ?STACKTRACE(),
- Debug, S, [Event|Events])
+ ?STACKTRACE(), Debug,
+ S#{state := State, data := Data},
+ [Event|Events])
end.
-parse_enter_actions(
- Debug, S, State, Actions,
- Hibernate, TimeoutsR) ->
+parse_enter_actions(Debug, S, State, Actions, Hibernate, TimeoutsR) ->
Postpone = forbidden,
NextEventsR = forbidden,
parse_actions(
Debug, S, State, listify(Actions),
Hibernate, TimeoutsR, Postpone, NextEventsR).
-
+
parse_actions(Debug, S, State, Actions) ->
Hibernate = false,
- TimeoutsR = [],
+ TimeoutsR = [{timeout,infinity,infinity}], %% Will cancel event timer
Postpone = false,
NextEventsR = [],
parse_actions(
@@ -1279,64 +1341,29 @@ parse_actions(
{bad_action_from_state_function,Action},
?STACKTRACE()}
end;
+ %%
%% Actions that set options
{hibernate,NewHibernate} when is_boolean(NewHibernate) ->
parse_actions(
Debug, S, State, Actions,
NewHibernate, TimeoutsR, Postpone, NextEventsR);
- {hibernate,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
hibernate ->
+ NewHibernate = true,
parse_actions(
Debug, S, State, Actions,
- true, TimeoutsR, Postpone, NextEventsR);
- {state_timeout,Time,_} = StateTimeout
- when is_integer(Time), Time >= 0;
- Time =:= infinity ->
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, [StateTimeout|TimeoutsR], Postpone, NextEventsR);
- {state_timeout,_,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
- {timeout,infinity,_} ->
- %% Ignore - timeout will never happen and already cancelled
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, TimeoutsR, Postpone, NextEventsR);
- {timeout,Time,_} = Timeout when is_integer(Time), Time >= 0 ->
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR);
- {timeout,_,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
- infinity -> % Ignore - timeout will never happen
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, TimeoutsR, Postpone, NextEventsR);
- Time when is_integer(Time), Time >= 0 ->
- Timeout = {timeout,Time,Time},
- parse_actions(
- Debug, S, State, Actions,
- Hibernate, [Timeout|TimeoutsR], Postpone, NextEventsR);
+ NewHibernate, TimeoutsR, Postpone, NextEventsR);
+ %%
{postpone,NewPostpone}
when is_boolean(NewPostpone), Postpone =/= forbidden ->
parse_actions(
Debug, S, State, Actions,
Hibernate, TimeoutsR, NewPostpone, NextEventsR);
- {postpone,_} ->
- {error,
- {bad_action_from_state_function,Action},
- ?STACKTRACE()};
postpone when Postpone =/= forbidden ->
+ NewPostpone = true,
parse_actions(
Debug, S, State, Actions,
- Hibernate, TimeoutsR, true, NextEventsR);
+ Hibernate, TimeoutsR, NewPostpone, NextEventsR);
+ %%
{next_event,Type,Content} ->
case event_type(Type) of
true when NextEventsR =/= forbidden ->
@@ -1351,96 +1378,150 @@ parse_actions(
{bad_action_from_state_function,Action},
?STACKTRACE()}
end;
- _ ->
+ %%
+ {state_timeout,_,_} = Timeout ->
+ parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout);
+ {timeout,_,_} = Timeout ->
+ parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout);
+ Time ->
+ parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Time)
+ end.
+
+parse_actions_timeout(
+ Debug, S, State, Actions,
+ Hibernate, TimeoutsR, Postpone, NextEventsR, Timeout) ->
+ Time =
+ case Timeout of
+ {_,T,_} -> T;
+ T -> T
+ end,
+ case validate_time(Time) of
+ true ->
+ parse_actions(
+ Debug, S, State, Actions,
+ Hibernate, [Timeout|TimeoutsR],
+ Postpone, NextEventsR);
+ false ->
{error,
- {bad_action_from_state_function,Action},
+ {bad_action_from_state_function,Timeout},
?STACKTRACE()}
end.
+validate_time(Time) when is_integer(Time), Time >= 0 -> true;
+validate_time(infinity) -> true;
+validate_time(_) -> false.
%% Stop and start timers as well as create timeout zero events
%% and pending event timer
%%
%% Stop and start timers non-event timers
-parse_timers(TimerRefs, TimerTypes, TimeoutsR) ->
- parse_timers(TimerRefs, TimerTypes, TimeoutsR, #{}, []).
+parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR) ->
+ parse_timers(TimerRefs, TimerTypes, CancelTimers, TimeoutsR, #{}, []).
%%
-parse_timers(TimerRefs, TimerTypes, [], _Seen, TimeoutEvents) ->
- {TimerRefs,TimerTypes,TimeoutEvents};
parse_timers(
- TimerRefs, TimerTypes, [Timeout|TimeoutsR], Seen, TimeoutEvents) ->
- {TimerType,Time,TimerMsg} = Timeout,
+ TimerRefs, TimerTypes, CancelTimers, [], _Seen, TimeoutEvents) ->
+ {TimerRefs,TimerTypes,CancelTimers,TimeoutEvents};
+parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, [Timeout|TimeoutsR],
+ Seen, TimeoutEvents) ->
+ case Timeout of
+ {TimerType,Time,TimerMsg} ->
+ parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents,
+ TimerType, Time, TimerMsg);
+ Time ->
+ parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents,
+ timeout, Time, Time)
+ end.
+
+parse_timers(
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents,
+ TimerType, Time, TimerMsg) ->
case Seen of
#{TimerType := _} ->
%% Type seen before - ignore
parse_timers(
- TimerRefs, TimerTypes, TimeoutsR, Seen, TimeoutEvents);
+ TimerRefs, TimerTypes, CancelTimers, TimeoutsR,
+ Seen, TimeoutEvents);
#{} ->
%% Unseen type - handle
NewSeen = Seen#{TimerType => true},
- %% Cancel any running timer
- {NewTimerRefs,NewTimerTypes} =
- cancel_timer_by_type(TimerType, TimerRefs, TimerTypes),
- if
- Time =:= infinity ->
- %% Ignore - timer will never fire
+ case Time of
+ infinity ->
+ %% Cancel any running timer
+ {NewTimerTypes,NewCancelTimers} =
+ cancel_timer_by_type(
+ TimerType, TimerTypes, CancelTimers),
parse_timers(
- NewTimerRefs, NewTimerTypes, TimeoutsR,
+ TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR,
NewSeen, TimeoutEvents);
- TimerType =:= timeout ->
- %% Handle event timer later
- parse_timers(
- NewTimerRefs, NewTimerTypes, TimeoutsR,
- NewSeen, [Timeout|TimeoutEvents]);
- Time =:= 0 ->
+ 0 ->
+ %% Cancel any running timer
+ {NewTimerTypes,NewCancelTimers} =
+ cancel_timer_by_type(
+ TimerType, TimerTypes, CancelTimers),
%% Handle zero time timeouts later
TimeoutEvent = {TimerType,TimerMsg},
parse_timers(
- NewTimerRefs, NewTimerTypes, TimeoutsR,
+ TimerRefs, NewTimerTypes, NewCancelTimers, TimeoutsR,
NewSeen, [TimeoutEvent|TimeoutEvents]);
- true ->
- %% Start a new timer
- TimerRef = erlang:start_timer(Time, self(), TimerMsg),
- parse_timers(
- NewTimerRefs#{TimerRef => TimerType},
- NewTimerTypes#{TimerType => TimerRef},
- TimeoutsR, NewSeen, TimeoutEvents)
+ _ ->
+ %% (Re)start the timer
+ TimerRef =
+ erlang:start_timer(Time, self(), TimerMsg),
+ case TimerTypes of
+ #{TimerType := OldTimerRef} ->
+ %% Cancel the running timer
+ cancel_timer(OldTimerRef),
+ NewCancelTimers = CancelTimers + 1,
+ %% Insert the new timer into
+ %% both TimerRefs and TimerTypes
+ parse_timers(
+ TimerRefs#{TimerRef => TimerType},
+ TimerTypes#{TimerType => TimerRef},
+ NewCancelTimers, TimeoutsR,
+ NewSeen, TimeoutEvents);
+ #{} ->
+ parse_timers(
+ TimerRefs#{TimerRef => TimerType},
+ TimerTypes#{TimerType => TimerRef},
+ CancelTimers, TimeoutsR,
+ NewSeen, TimeoutEvents)
+ end
end
end.
-%% Enqueue immediate timeout events and start event timer
-process_timeout_events(TimerRefs, TimerTypes, [], EventsR) ->
- {TimerRefs, TimerTypes, EventsR};
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{timeout,0,TimerMsg}|TimeoutEvents], []) ->
- %% No enqueued events - insert a timeout zero event
- TimeoutEvent = {timeout,TimerMsg},
- process_timeout_events(
- TimerRefs, TimerTypes,
- TimeoutEvents, [TimeoutEvent]);
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{timeout,Time,TimerMsg}], []) ->
- %% No enqueued events - start event timer
- TimerRef = erlang:start_timer(Time, self(), TimerMsg),
- process_timeout_events(
- TimerRefs#{TimerRef => timeout}, TimerTypes#{timeout => TimerRef},
- [], []);
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{timeout,_Time,_TimerMsg}|TimeoutEvents], EventsR) ->
- %% There will be some other event so optimize by not starting
- %% an event timer to just have to cancel it again
- process_timeout_events(
- TimerRefs, TimerTypes,
- TimeoutEvents, EventsR);
-process_timeout_events(
- TimerRefs, TimerTypes,
- [{_TimeoutType,_TimeoutMsg} = TimeoutEvent|TimeoutEvents], EventsR) ->
- process_timeout_events(
- TimerRefs, TimerTypes,
- TimeoutEvents, [TimeoutEvent|EventsR]).
+%% Enqueue immediate timeout events (timeout 0 events)
+%%
+%% Event timer timeout 0 events gets special treatment since
+%% an event timer is cancelled by any received event,
+%% so if there are enqueued events before the event timer
+%% timeout 0 event - the event timer is cancelled hence no event.
+%%
+%% Other (state_timeout) timeout 0 events that are after
+%% the event timer timeout 0 events are considered to
+%% belong to timers that were started after the event timer
+%% timeout 0 event fired, so they do not cancel the event timer.
+%%
+prepend_timeout_events([], EventsR) ->
+ EventsR;
+prepend_timeout_events([{timeout,_} = TimeoutEvent|TimeoutEvents], []) ->
+ prepend_timeout_events(TimeoutEvents, [TimeoutEvent]);
+prepend_timeout_events([{timeout,_}|TimeoutEvents], EventsR) ->
+ prepend_timeout_events(TimeoutEvents, EventsR);
+prepend_timeout_events([TimeoutEvent|TimeoutEvents], EventsR) ->
+ %% Just prepend all others
+ prepend_timeout_events(TimeoutEvents, [TimeoutEvent|EventsR]).
@@ -1448,18 +1529,11 @@ process_timeout_events(
%% Server helpers
reply_then_terminate(
- Class, Reason, Stacktrace,
- Debug, #{state := State} = S, Q, Replies) ->
- if
- is_list(Replies) ->
- do_reply_then_terminate(
- Class, Reason, Stacktrace,
- Debug, S, Q, Replies, State);
- true ->
- do_reply_then_terminate(
- Class, Reason, Stacktrace,
- Debug, S, Q, [Replies], State)
- end.
+ Class, Reason, Stacktrace, Debug,
+ #{state := State} = S, Q, Replies) ->
+ do_reply_then_terminate(
+ Class, Reason, Stacktrace, Debug,
+ S, Q, listify(Replies), State).
%%
do_reply_then_terminate(
Class, Reason, Stacktrace, Debug, S, Q, [], _State) ->
@@ -1485,21 +1559,25 @@ do_reply(Debug, S, State, From, Reply) ->
terminate(
- Class, Reason, Stacktrace,
- Debug,
+ Class, Reason, Stacktrace, Debug,
#{module := Module, state := State, data := Data, postponed := P} = S,
Q) ->
- try Module:terminate(Reason, State, Data) of
- _ -> ok
- catch
- _ -> ok;
- C:R ->
- ST = erlang:get_stacktrace(),
- error_info(
- C, R, ST, S, Q, P,
- format_status(terminate, get(), S)),
- sys:print_log(Debug),
- erlang:raise(C, R, ST)
+ case erlang:function_exported(Module, terminate, 3) of
+ true ->
+ try Module:terminate(Reason, State, Data) of
+ _ -> ok
+ catch
+ _ -> ok;
+ C:R ->
+ ST = erlang:get_stacktrace(),
+ error_info(
+ C, R, ST, S, Q, P,
+ format_status(terminate, get(), S)),
+ sys:print_log(Debug),
+ erlang:raise(C, R, ST)
+ end;
+ false ->
+ ok
end,
_ =
case Reason of
@@ -1637,28 +1715,21 @@ listify(Item) ->
[Item].
%% Cancel timer if running, otherwise no op
-cancel_timer_by_type(TimerType, TimerRefs, TimerTypes) ->
+%%
+%% This is an asynchronous cancel so the timer is not really cancelled
+%% until we get a cancel_timer msg i.e {cancel_timer,TimerRef,_}.
+%% In the mean time we might get a timeout message.
+%%
+%% Remove the timer from TimerTypes.
+%% When we get the cancel_timer msg we remove it from TimerRefs.
+cancel_timer_by_type(TimerType, TimerTypes, CancelTimers) ->
case TimerTypes of
#{TimerType := TimerRef} ->
cancel_timer(TimerRef),
- {maps:remove(TimerRef, TimerRefs),
- maps:remove(TimerType, TimerTypes)};
+ {maps:remove(TimerType, TimerTypes),CancelTimers + 1};
#{} ->
- {TimerRefs,TimerTypes}
+ {TimerTypes,CancelTimers}
end.
-%%cancel_timer(undefined) ->
-%% ok;
-cancel_timer(TRef) ->
- case erlang:cancel_timer(TRef) of
- false ->
- %% We have to assume that TRef is the ref of a running timer
- %% and if so the timer has expired
- %% hence we must wait for the timeout message
- receive
- {timeout,TRef,_} ->
- ok
- end;
- _TimeLeft ->
- ok
- end.
+cancel_timer(TimerRef) ->
+ ok = erlang:cancel_timer(TimerRef, [{async,true}]).
diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl
index ad98bc0420..a91143a764 100644
--- a/lib/stdlib/src/io_lib.erl
+++ b/lib/stdlib/src/io_lib.erl
@@ -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
diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl
index c7b75961cb..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),
diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl
index 94376408d1..aabccfc5d9 100644
--- a/lib/stdlib/src/io_lib_pretty.erl
+++ b/lib/stdlib/src/io_lib_pretty.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.
@@ -139,6 +139,10 @@ max_cs(M, _Len) ->
M.
-define(ATM(T), is_list(element(1, T))).
+-define(ATM_PAIR(Pair),
+ ?ATM(element(2, element(1, Pair))) % Key
+ andalso
+ ?ATM(element(3, element(1, Pair)))). % Value
-define(ATM_FLD(Field), ?ATM(element(4, element(1, Field)))).
pp({_S, Len} = If, Col, Ll, M, _TInd, _Ind, LD, W)
@@ -151,9 +155,8 @@ pp({{tuple,true,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
pp({{tuple,false,L}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
[${, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $,, W + 1), $}];
pp({{map,Pairs},_Len}, Col, Ll, M, TInd, Ind, LD, W) ->
- [$#,${, pp_list(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, $,, W + 1), $}];
-pp({{map_pair,K,V},_Len}, Col, Ll, M, TInd, Ind, LD, W) ->
- [pp(K, Col, Ll, M, TInd, Ind, LD, W), " => ", pp(V, Col, Ll, M, TInd, Ind, LD, W)];
+ [$#, ${, pp_map(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, W + 1),
+ $}];
pp({{record,[{Name,NLen} | L]}, _Len}, Col, Ll, M, TInd, Ind, LD, W) ->
[Name, ${, pp_record(L, NLen, Col, Ll, M, TInd, Ind, LD, W + NLen+1), $}];
pp({{bin,S}, _Len}, Col, Ll, M, _TInd, Ind, LD, W) ->
@@ -178,6 +181,46 @@ pp_tag_tuple([{Tag,Tlen} | L], Col, Ll, M, TInd, Ind, LD, W) ->
[Tag, S | pp_list(L, Tcol, Ll, M, TInd, Indent, LD, S, W+Tlen+1)]
end.
+pp_map([], _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "";
+pp_map({dots, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "...";
+pp_map([P | Ps], Col, Ll, M, TInd, Ind, LD, W) ->
+ {PS, PW} = pp_pair(P, Col, Ll, M, TInd, Ind, last_depth(Ps, LD), W),
+ [PS | pp_pairs_tail(Ps, Col, Col + PW, Ll, M, TInd, Ind, LD, PW)].
+
+pp_pairs_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
+ "";
+pp_pairs_tail({dots, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) ->
+ ",...";
+pp_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) ->
+ LD1 = last_depth(Ps, LD),
+ ELen = 1 + Len,
+ if
+ LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P);
+ LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) ->
+ [$,, write_pair(P) |
+ pp_pairs_tail(Ps, Col0, Col+ELen, Ll, M, TInd, Ind, LD, W+ELen)];
+ true ->
+ {PS, PW} = pp_pair(P, Col0, Ll, M, TInd, Ind, LD1, 0),
+ [$,, $\n, Ind, PS |
+ pp_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, TInd, Ind, LD, PW)]
+ end.
+
+pp_pair({_, Len}=Pair, Col, Ll, M, _TInd, _Ind, LD, W)
+ when Len < Ll - Col - LD, Len + W + LD =< M ->
+ {write_pair(Pair), if
+ ?ATM_PAIR(Pair) ->
+ Len;
+ true ->
+ Ll % force nl
+ end};
+pp_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W) ->
+ I = map_value_indent(TInd),
+ Ind = indent(I, Ind0),
+ {[pp(K, Col0, Ll, M, TInd, Ind0, LD, W), " =>\n",
+ Ind | pp(V, Col0 + I, Ll, M, TInd, Ind, LD, 0)], Ll}. % force nl
+
pp_record([], _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
"";
pp_record({dots, _}, _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) ->
@@ -216,7 +259,11 @@ pp_field({_, Len}=Fl, Col, Ll, M, _TInd, _Ind, LD, W)
end};
pp_field({{field, Name, NameL, F}, _Len}, Col0, Ll, M, TInd, Ind0, LD, W0) ->
{Col, Ind, S, W} = rec_indent(NameL, TInd, Col0, Ind0, W0 + NameL),
- {[Name, " = ", S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl
+ Sep = case S of
+ [$\n | _] -> " =";
+ _ -> " = "
+ end,
+ {[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
@@ -305,8 +352,8 @@ write({{list, L}, _}) ->
[$[, write_list(L, $|), $]];
write({{map, Pairs}, _}) ->
[$#,${, write_list(Pairs, $,), $}];
-write({{map_pair, K, V}, _}) ->
- [write(K)," => ",write(V)];
+write({{map_pair, _K, _V}, _}=Pair) ->
+ write_pair(Pair);
write({{record, [{Name,_} | L]}, _}) ->
[Name, ${, write_fields(L), $}];
write({{bin, S}, _}) ->
@@ -314,6 +361,9 @@ write({{bin, S}, _}) ->
write({S, _}) ->
S.
+write_pair({{map_pair, K, V}, _}) ->
+ [write(K), " => ", write(V)].
+
write_fields([]) ->
"";
write_fields({dots, _}) ->
@@ -347,7 +397,7 @@ write_tail(E, S) ->
%% The depth (D) is used for extracting and counting the characters to
%% print. The structure is kept so that the returned intermediate
-%% format can be formatted. The separators (list, tuple, record) are
+%% format can be formatted. The separators (list, tuple, record, map) are
%% counted but need to be added later.
%% D =/= 0
@@ -423,21 +473,22 @@ print_length(Term, _D, _RF, _Enc, _Str) ->
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, 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)}.
print_length_map_pairs([], _D, _RF, _Enc, _Str) ->
[];
print_length_map_pairs(_Pairs, 1, _RF, _Enc, _Str) ->
{dots, 3};
-print_length_map_pairs([{K,V}|Pairs], D, RF, Enc, Str) ->
- [print_length_map_pair(K,V,D-1,RF,Enc,Str) |
- print_length_map_pairs(Pairs,D-1,RF,Enc,Str)].
+print_length_map_pairs([{K, V} | Pairs], D, RF, Enc, Str) ->
+ [print_length_map_pair(K, V, D - 1, RF, Enc, Str) |
+ print_length_map_pairs(Pairs, D - 1, RF, Enc, Str)].
print_length_map_pair(K, V, D, RF, Enc, Str) ->
{KS, KL} = print_length(K, D, RF, Enc, Str),
{VS, VL} = print_length(V, D, RF, Enc, Str),
- {{map_pair, {KS,KL}, {VS,VL}}, KL + VL}.
+ KL1 = KL + 4,
+ {{map_pair, {KS, KL1}, {VS, VL}}, KL1 + VL}.
print_length_tuple(_Tuple, 1, _RF, _Enc, _Str) ->
{"{...}", 5};
@@ -630,6 +681,8 @@ cind({{tuple,true,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_tag_tuple(L, Col, Ll, M, Ind, LD, W + 1);
cind({{tuple,false,L}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_list(L, Col + 1, Ll, M, Ind, LD, W + 1);
+cind({{map,Pairs},_Len}, Col, Ll, M, Ind, LD, W) ->
+ cind_map(Pairs, Col + 2, Ll, M, Ind, LD, W + 2);
cind({{record,[{_Name,NLen} | L]}, _Len}, Col, Ll, M, Ind, LD, W) ->
cind_record(L, NLen, Col, Ll, M, Ind, LD, W + NLen + 1);
cind({{bin,_S}, _Len}, _Col, _Ll, _M, Ind, _LD, _W) ->
@@ -655,6 +708,48 @@ cind_tag_tuple([{_Tag,Tlen} | L], Col, Ll, M, Ind, LD, W) ->
throw(no_good)
end.
+cind_map([P | Ps], Col, Ll, M, Ind, LD, W) ->
+ PW = cind_pair(P, Col, Ll, M, Ind, last_depth(Ps, LD), W),
+ cind_pairs_tail(Ps, Col, Col + PW, Ll, M, Ind, LD, W + PW);
+cind_map(_, _Col, _Ll, _M, Ind, _LD, _W) ->
+ Ind.
+
+cind_pairs_tail([{_, Len}=P | Ps], Col0, Col, Ll, M, Ind, LD, W) ->
+ LD1 = last_depth(Ps, LD),
+ ELen = 1 + Len,
+ if
+ LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P);
+ LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) ->
+ cind_pairs_tail(Ps, Col0, Col + ELen, Ll, M, Ind, LD, W + ELen);
+ true ->
+ PW = cind_pair(P, Col0, Ll, M, Ind, LD1, 0),
+ cind_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, Ind, LD, PW)
+ end;
+cind_pairs_tail(_, _Col0, _Col, _Ll, _M, Ind, _LD, _W) ->
+ Ind.
+
+cind_pair({{map_pair, _Key, _Value}, Len}=Pair, Col, Ll, M, _Ind, LD, W)
+ when Len < Ll - Col - LD, Len + W + LD =< M ->
+ if
+ ?ATM_PAIR(Pair) ->
+ Len;
+ true ->
+ Ll
+ end;
+cind_pair({{map_pair, K, V}, _Len}, Col0, Ll, M, Ind, LD, W0) ->
+ cind(K, Col0, Ll, M, Ind, LD, W0),
+ I = map_value_indent(Ind),
+ cind(V, Col0 + I, Ll, M, Ind, LD, 0),
+ Ll.
+
+map_value_indent(TInd) ->
+ case TInd > 0 of
+ true ->
+ TInd;
+ false ->
+ 4
+ end.
+
cind_record([F | Fs], Nlen, Col0, Ll, M, Ind, LD, W0) ->
Nind = Nlen + 1,
{Col, W} = cind_rec(Nind, Col0, Ll, M, Ind, W0),
diff --git a/lib/stdlib/src/otp_internal.erl b/lib/stdlib/src/otp_internal.erl
index 4161ced9ab..2a0e3118d0 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\" "
@@ -408,7 +405,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, _, _) ->
@@ -463,21 +460,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) ->
@@ -551,6 +550,20 @@ obsolete_1(overload, _, _) ->
obsolete_1(rpc, safe_multi_server_call, A) when A =:= 2; A =:= 3 ->
{removed, {rpc, multi_server_call, A}};
+%% 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/proplists.erl b/lib/stdlib/src/proplists.erl
index 21de8c45c1..340dfdcac9 100644
--- a/lib/stdlib/src/proplists.erl
+++ b/lib/stdlib/src/proplists.erl
@@ -83,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.erl b/lib/stdlib/src/qlc.erl
index f3665824f2..8c4d835432 100644
--- a/lib/stdlib/src/qlc.erl
+++ b/lib/stdlib/src/qlc.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.
@@ -1292,6 +1292,10 @@ abstr_term(Fun, Line) when is_function(Fun) ->
end;
abstr_term(PPR, Line) when is_pid(PPR); is_port(PPR); is_reference(PPR) ->
{special, Line, lists:flatten(io_lib:write(PPR))};
+abstr_term(Map, Line) when is_map(Map) ->
+ {map,Line,
+ [{map_field_assoc,Line,abstr_term(K, Line),abstr_term(V, Line)} ||
+ {K,V} <- maps:to_list(Map)]};
abstr_term(Simple, Line) ->
erl_parse:abstract(Simple, erl_anno:line(Line)).
diff --git a/lib/stdlib/src/shell_default.erl b/lib/stdlib/src/shell_default.erl
index cd63ab28b5..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,lm/0,mm/0,
+-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().
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.appup.src b/lib/stdlib/src/stdlib.appup.src
index 979161fef7..3c9e95e3a9 100644
--- a/lib/stdlib/src/stdlib.appup.src
+++ b/lib/stdlib/src/stdlib.appup.src
@@ -18,7 +18,7 @@
%% %CopyrightEnd%
{"%VSN%",
%% Up from - max one major revision back
- [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.*
+ [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}], % OTP-19.*
%% Down to - max one major revision back
- [{<<"3\\.[0-1](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.*
+ [{<<"3\\.[0-3](\\.[0-9]+)*">>,[restart_new_emulator]}] % OTP-19.*
}.
diff --git a/lib/stdlib/src/zip.erl b/lib/stdlib/src/zip.erl
index 340cc21390..fadf96146e 100644
--- a/lib/stdlib/src/zip.erl
+++ b/lib/stdlib/src/zip.erl
@@ -179,19 +179,6 @@
external_attr,
local_header_offset}).
-%% Unix extra fields (not yet supported)
--define(UNIX_EXTRA_FIELD_TAG, 16#000d).
--record(unix_extra_field, {atime,
- mtime,
- uid,
- gid}).
-
-%% extended timestamps (not yet supported)
--define(EXTENDED_TIMESTAMP_TAG, 16#5455).
-%% -record(extended_timestamp, {mtime,
-%% atime,
-%% ctime}).
-
-define(END_OF_CENTRAL_DIR_MAGIC, 16#06054b50).
-define(END_OF_CENTRAL_DIR_SZ, (4+2+2+2+2+4+4+2)).
@@ -381,9 +368,12 @@ do_unzip(F, Options) ->
{Info, In1} = get_central_dir(In0, RawIterator, Input),
%% get rid of zip-comment
Z = zlib:open(),
- Files = get_z_files(Info, Z, In1, Opts, []),
- zlib:close(Z),
- Input(close, In1),
+ Files = try
+ get_z_files(Info, Z, In1, Opts, [])
+ after
+ zlib:close(Z),
+ Input(close, In1)
+ end,
{ok, Files}.
%% Iterate over all files in a zip archive
@@ -460,11 +450,20 @@ do_zip(F, Files, Options) ->
#zip_opts{output = Output, open_opts = OpO} = Opts,
Out0 = Output({open, F, OpO}, []),
Z = zlib:open(),
- {Out1, LHS, Pos} = put_z_files(Files, Z, Out0, 0, Opts, []),
- zlib:close(Z),
- Out2 = put_central_dir(LHS, Pos, Out1, Opts),
- Out3 = Output({close, F}, Out2),
- {ok, Out3}.
+ try
+ {Out1, LHS, Pos} = put_z_files(Files, Z, Out0, 0, Opts, []),
+ zlib:close(Z),
+ Out2 = put_central_dir(LHS, Pos, Out1, Opts),
+ Out3 = Output({close, F}, Out2),
+ {ok, Out3}
+ catch
+ C:R ->
+ Stk = erlang:get_stacktrace(),
+ zlib:close(Z),
+ Output({close, F}, Out0),
+ erlang:raise(C, R, Stk)
+ end.
+
%% List zip directory contents
%%
@@ -1379,12 +1378,7 @@ cd_file_header_to_file_info(FileName,
gid = 0},
add_extra_info(FI, ExtraField).
-%% add extra info to file (some day when we implement it)
-add_extra_info(FI, <<?EXTENDED_TIMESTAMP_TAG:16/little, _Rest/binary>>) ->
- FI; % not yet supported, some other day...
-add_extra_info(FI, <<?UNIX_EXTRA_FIELD_TAG:16/little, Rest/binary>>) ->
- _UnixExtra = unix_extra_field_and_var_from_bin(Rest),
- FI; % not yet supported, and not widely used
+%% Currently, we ignore all the extra fields.
add_extra_info(FI, _) ->
FI.
@@ -1572,20 +1566,6 @@ dos_date_time_from_datetime({{Year, Month, Day}, {Hour, Min, Sec}}) ->
<<DosDate:16>> = <<YearFrom1980:7, Month:4, Day:5>>,
{DosDate, DosTime}.
-unix_extra_field_and_var_from_bin(<<TSize:16/little,
- ATime:32/little,
- MTime:32/little,
- UID:16/little,
- GID:16/little,
- Var:TSize/binary>>) ->
- {#unix_extra_field{atime = ATime,
- mtime = MTime,
- uid = UID,
- gid = GID},
- Var};
-unix_extra_field_and_var_from_bin(_) ->
- throw(bad_unix_extra_field).
-
%% A pwrite-like function for iolists (used by memory-option)
pwrite_binary(B, Pos, Bin) when byte_size(B) =:= Pos ->
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 aa31fdde5a..95c9b47465 100644
--- a/lib/stdlib/test/dets_SUITE.erl
+++ b/lib/stdlib/test/dets_SUITE.erl
@@ -3012,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),
diff --git a/lib/stdlib/test/edlin_expand_SUITE.erl b/lib/stdlib/test/edlin_expand_SUITE.erl
index 718d91c6a3..1f694ea549 100644
--- a/lib/stdlib/test/edlin_expand_SUITE.erl
+++ b/lib/stdlib/test/edlin_expand_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2010-2016. All Rights Reserved.
+%% Copyright Ericsson AB 2010-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.
@@ -21,7 +21,8 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_testcase/2, end_per_testcase/2,
init_per_group/2,end_per_group/2]).
--export([normal/1, quoted_fun/1, quoted_module/1, quoted_both/1, erl_1152/1]).
+-export([normal/1, quoted_fun/1, quoted_module/1, quoted_both/1, erl_1152/1,
+ erl_352/1]).
-include_lib("common_test/include/ct.hrl").
@@ -36,7 +37,7 @@ suite() ->
{timetrap,{minutes,1}}].
all() ->
- [normal, quoted_fun, quoted_module, quoted_both, erl_1152].
+ [normal, quoted_fun, quoted_module, quoted_both, erl_1152, erl_352].
groups() ->
[].
@@ -153,6 +154,78 @@ erl_1152(Config) when is_list(Config) ->
"\n"++"foo"++" "++[1089]++_ = do_format(["foo",[1089]]),
ok.
+erl_352(Config) when is_list(Config) ->
+ erl_352_test(3, 3),
+
+ erl_352_test(3, 75),
+ erl_352_test(3, 76, [trailing]),
+ erl_352_test(4, 74),
+ erl_352_test(4, 75, [leading]),
+ erl_352_test(4, 76, [leading, trailing]),
+
+ erl_352_test(75, 3),
+ erl_352_test(76, 3, [leading]),
+ erl_352_test(74, 4),
+ erl_352_test(75, 4, [leading]),
+ erl_352_test(76, 4, [leading]),
+
+ erl_352_test(74, 74, [leading]),
+ erl_352_test(74, 75, [leading]),
+ erl_352_test(74, 76, [leading, trailing]).
+
+erl_352_test(PrefixLen, SuffixLen) ->
+ erl_352_test(PrefixLen, SuffixLen, []).
+
+erl_352_test(PrefixLen, SuffixLen, Dots) ->
+ io:format("\nPrefixLen = ~w, SuffixLen = ~w\n", [PrefixLen, SuffixLen]),
+
+ PrefixM = lists:duplicate(PrefixLen, $p),
+ SuffixM = lists:duplicate(SuffixLen, $s),
+ LM = [PrefixM ++ S ++ SuffixM || S <- ["1", "2"]],
+ StrM = do_format(LM),
+ check_leading(StrM, "", PrefixM, SuffixM, Dots),
+
+ PrefixF = lists:duplicate(PrefixLen, $p),
+ SuffixF = lists:duplicate(SuffixLen-2, $s),
+ LF = [{PrefixF ++ S ++ SuffixF, 1} || S <- ["1", "2"]],
+ StrF = do_format(LF),
+ true = check_leading(StrF, "/1", PrefixF, SuffixF, Dots),
+
+ ok.
+
+check_leading(FormStr, ArityStr, Prefix, Suffix, Dots) ->
+ List = string:tokens(FormStr, "\n "),
+ io:format("~p\n", [List]),
+ true = lists:all(fun(L) -> length(L) < 80 end, List),
+ case lists:member(leading, Dots) of
+ true ->
+ true = lists:all(fun(L) ->
+ {"...", Rest} = lists:split(3, L),
+ check_trailing(Rest, ArityStr,
+ Suffix, Dots)
+ end, List);
+ false ->
+ true = lists:all(fun(L) ->
+ {Prefix, Rest} =
+ lists:split(length(Prefix), L),
+ check_trailing(Rest, ArityStr,
+ Suffix, Dots)
+ end, List)
+ end.
+
+check_trailing([I|Str], ArityStr, Suffix, Dots) ->
+ true = lists:member(I, [$1, $2]),
+ case lists:member(trailing, Dots) of
+ true ->
+ {Rest, "..." ++ ArityStr} =
+ lists:split(length(Str) - (3 + length(ArityStr)), Str),
+ true = lists:prefix(Rest, Suffix);
+ false ->
+ {Rest, ArityStr} =
+ lists:split(length(Str) - length(ArityStr), Str),
+ Rest =:= Suffix
+ end.
+
do_expand(String) ->
edlin_expand:expand(lists:reverse(String)).
diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl
index c86e17f70c..c7dcd9ae16 100644
--- a/lib/stdlib/test/erl_lint_SUITE.erl
+++ b/lib/stdlib/test/erl_lint_SUITE.erl
@@ -64,7 +64,7 @@
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]).
suite() ->
[{ct_hooks,[ts_install_cth]},
@@ -84,7 +84,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].
groups() ->
[{unused_vars_warn, [],
@@ -2002,22 +2002,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]},
@@ -2026,37 +2026,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,
@@ -2064,14 +2064,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\").
@@ -2083,11 +2084,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,
@@ -2097,11 +2098,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) -> crypto:md5(X).">>,
[],
{warnings,
- [{1,erl_lint,{deprecated,{erlang,hash,2},
- {erlang,phash2,2},"a future release"}}]}},
+ [{1,erl_lint,{deprecated,{crypto,md5,1},
+ {crypto,hash,2}, "a future release"}}]}},
{call_removed_function,
<<"t(X) -> regexp:match(X).">>,
@@ -3869,6 +3870,55 @@ 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).
+
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 13c5662741..31ea3210a8 100644
--- a/lib/stdlib/test/erl_pp_SUITE.erl
+++ b/lib/stdlib/test/erl_pp_SUITE.erl
@@ -825,12 +825,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()} |"
diff --git a/lib/stdlib/test/erl_scan_SUITE.erl b/lib/stdlib/test/erl_scan_SUITE.erl
index 4ae734eb65..7d0ba967f9 100644
--- a/lib/stdlib/test/erl_scan_SUITE.erl
+++ b/lib/stdlib/test/erl_scan_SUITE.erl
@@ -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,9 +903,9 @@ more_chars() ->
%% OTP-10302. Unicode characters scanner/parser.
otp_10302(Config) when is_list(Config) ->
%% From unicode():
- {error,{1,erl_scan,{illegal,atom}},1} =
+ {ok,[{atom,1,'aсb'}],1} =
erl_scan:string("'a"++[1089]++"b'", 1),
- {error,{{1,1},erl_scan,{illegal,atom}},{1,12}} =
+ {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),
diff --git a/lib/stdlib/test/ets_SUITE.erl b/lib/stdlib/test/ets_SUITE.erl
index f68d5eca3f..8581440d58 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,
@@ -82,27 +82,6 @@
%% 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").
@@ -228,7 +207,7 @@ memory_check_summary(_Config) ->
%% 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 +375,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 +402,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 +548,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) ->
@@ -594,7 +579,7 @@ select_fail_do(Opts) ->
%% 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) ->
@@ -704,12 +689,12 @@ adjust_xmem([_T1,_T2,_T3,_T4], {A0,B0,C0,D0} = _Mem0, EstCnt) ->
%% 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) ->
@@ -774,7 +759,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) ->
@@ -808,7 +793,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) ->
@@ -881,7 +866,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) ->
@@ -957,7 +942,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) ->
@@ -1187,7 +1172,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),
@@ -1199,8 +1184,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}]),
@@ -1485,7 +1471,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) ->
@@ -1647,7 +1633,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) ->
@@ -1868,7 +1854,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(),
@@ -1915,7 +1901,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]),
@@ -1953,7 +1939,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]),
@@ -1964,7 +1950,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(),
@@ -2104,7 +2091,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(),
@@ -2244,7 +2231,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]),
@@ -2325,7 +2312,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(),
@@ -2475,7 +2462,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(),
@@ -2490,7 +2477,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(),
@@ -2565,7 +2553,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(),
@@ -2629,7 +2617,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(),
@@ -2675,7 +2663,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(),
@@ -2801,12 +2789,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});
@@ -2886,7 +2875,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(),
@@ -2899,7 +2888,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(),
@@ -2923,7 +2912,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]))}.
@@ -2957,7 +2946,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.
@@ -3048,7 +3038,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(),
@@ -3086,7 +3076,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(),
@@ -3103,7 +3094,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,
@@ -3301,10 +3293,14 @@ exit_large_table_owner(Config) when is_list(Config) ->
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).
@@ -3472,7 +3468,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) ->
@@ -3489,7 +3486,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(),
@@ -3514,7 +3511,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(),
@@ -3572,7 +3569,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(),
@@ -3597,7 +3594,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(),
@@ -3633,7 +3630,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(),
@@ -3660,7 +3657,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(),
@@ -3760,7 +3757,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(),
@@ -3796,7 +3793,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(),
@@ -3814,7 +3811,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(),
@@ -3872,7 +3869,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(),
@@ -3904,7 +3901,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(),
@@ -3970,7 +3967,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(),
@@ -4234,7 +4233,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(),
@@ -4257,7 +4256,7 @@ 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(),
@@ -4285,7 +4284,7 @@ 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,
@@ -4370,7 +4369,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(),
@@ -4453,26 +4452,26 @@ time_match(Tab,Match) ->
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) ->
[];
@@ -4811,7 +4810,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,
@@ -4847,7 +4846,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]),
@@ -4877,7 +4876,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).
@@ -5446,7 +5445,7 @@ smp_select_delete(Config) when is_list(Config) ->
%% 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(),
@@ -5848,12 +5847,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
@@ -6096,7 +6091,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.
@@ -6232,11 +6227,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) ->
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..87fba815d2 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,52 @@ 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) ->
+ BeamFile = code:which(lists),
+ 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(erl_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 b7c4d3a6e5..dc3daa56c1 100644
--- a/lib/stdlib/test/filename_SUITE.erl
+++ b/lib/stdlib/test/filename_SUITE.erl
@@ -29,6 +29,7 @@
dirname_bin/1, extension_bin/1, join_bin/1, t_nativename_bin/1]).
-export([pathtype_bin/1,rootname_bin/1,split_bin/1]).
-export([t_basedir_api/1, t_basedir_xdg/1, t_basedir_windows/1]).
+-export([safe_relative_path/1]).
-include_lib("common_test/include/ct.hrl").
@@ -41,7 +42,8 @@ all() ->
find_src,
absname_bin, absname_bin_2,
{group,p},
- t_basedir_xdg, t_basedir_windows].
+ t_basedir_xdg, t_basedir_windows,
+ safe_relative_path].
groups() ->
[{p, [parallel],
@@ -421,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),
@@ -768,6 +772,71 @@ t_nativename_bin(Config) when is_list(Config) ->
filename:nativename(<<"/usr/tmp//arne/">>)
end.
+safe_relative_path(Config) ->
+ PrivDir = proplists:get_value(priv_dir, Config),
+ Root = filename:join(PrivDir, ?FUNCTION_NAME),
+ ok = file:make_dir(Root),
+ ok = file:set_cwd(Root),
+
+ ok = file:make_dir("a"),
+ ok = file:set_cwd("a"),
+ ok = file:make_dir("b"),
+ ok = file:set_cwd("b"),
+ ok = file:make_dir("c"),
+
+ ok = file:set_cwd(Root),
+
+ "a" = test_srp("a"),
+ "a/b" = test_srp("a/b"),
+ "a/b" = test_srp("a/./b"),
+ "a/b" = test_srp("a/./b/."),
+
+ "" = test_srp("a/.."),
+ "" = test_srp("a/./.."),
+ "" = test_srp("a/../."),
+ "a" = test_srp("a/b/.."),
+ "a" = test_srp("a/../a"),
+ "a" = test_srp("a/../a/../a"),
+ "a/b/c" = test_srp("a/../a/b/c"),
+
+ unsafe = test_srp("a/../.."),
+ unsafe = test_srp("a/../../.."),
+ unsafe = test_srp("a/./../.."),
+ unsafe = test_srp("a/././../../.."),
+ unsafe = test_srp("a/b/././../../.."),
+
+ unsafe = test_srp(PrivDir), %Absolute path.
+
+ ok.
+
+test_srp(RelPath) ->
+ Res = do_test_srp(RelPath),
+ Res = case do_test_srp(list_to_binary(RelPath)) of
+ Bin when is_binary(Bin) ->
+ binary_to_list(Bin);
+ Other ->
+ Other
+ end.
+
+do_test_srp(RelPath) ->
+ {ok,Root} = file:get_cwd(),
+ ok = file:set_cwd(RelPath),
+ {ok,Cwd} = file:get_cwd(),
+ ok = file:set_cwd(Root),
+ case filename:safe_relative_path(RelPath) of
+ unsafe ->
+ true = length(Cwd) < length(Root),
+ unsafe;
+ "" ->
+ "";
+ SafeRelPath ->
+ ok = file:set_cwd(SafeRelPath),
+ {ok,Cwd} = file:get_cwd(),
+ true = length(Cwd) >= length(Root),
+ ok = file:set_cwd(Root),
+ SafeRelPath
+ end.
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% basedirs
t_basedir_api(Config) when is_list(Config) ->
diff --git a/lib/stdlib/test/gen_statem_SUITE.erl b/lib/stdlib/test/gen_statem_SUITE.erl
index 8f2ba0cab2..ac27c9fc79 100644
--- a/lib/stdlib/test/gen_statem_SUITE.erl
+++ b/lib/stdlib/test/gen_statem_SUITE.erl
@@ -38,7 +38,7 @@ all() ->
{group, abnormal},
{group, abnormal_handle_event},
shutdown, stop_and_reply, state_enter, event_order,
- state_timeout, code_change,
+ state_timeout, event_types, code_change,
{group, sys},
hibernate, enter_loop].
@@ -600,15 +600,26 @@ state_enter(_Config) ->
(internal, Prev, N) ->
Self ! {internal,start,Prev,N},
{keep_state,N + 1};
+ ({call,From}, repeat, N) ->
+ {repeat_state,N + 1,
+ [{reply,From,{repeat,start,N}}]};
({call,From}, echo, N) ->
- {next_state,wait,N + 1,{reply,From,{echo,start,N}}};
+ {next_state,wait,N + 1,
+ {reply,From,{echo,start,N}}};
({call,From}, {stop,Reason}, N) ->
- {stop_and_reply,Reason,[{reply,From,{stop,N}}],N + 1}
+ {stop_and_reply,Reason,
+ [{reply,From,{stop,N}}],N + 1}
end,
wait =>
- fun (enter, Prev, N) ->
+ fun (enter, Prev, N) when N < 5 ->
+ {repeat_state,N + 1,
+ {reply,{Self,N},{enter,Prev}}};
+ (enter, Prev, N) ->
Self ! {enter,wait,Prev,N},
{keep_state,N + 1};
+ ({call,From}, repeat, N) ->
+ {repeat_state_and_data,
+ [{reply,From,{repeat,wait,N}}]};
({call,From}, echo, N) ->
{next_state,start,N + 1,
[{next_event,internal,wait},
@@ -620,11 +631,15 @@ state_enter(_Config) ->
[{enter,start,start,1}] = flush(),
{echo,start,2} = gen_statem:call(STM, echo),
- [{enter,wait,start,3}] = flush(),
- {wait,[4|_]} = sys:get_state(STM),
- {echo,wait,4} = gen_statem:call(STM, echo),
- [{enter,start,wait,5},{internal,start,wait,6}] = flush(),
- {stop,7} = gen_statem:call(STM, {stop,bye}),
+ [{3,{enter,start}},{4,{enter,start}},{enter,wait,start,5}] = flush(),
+ {wait,[6|_]} = sys:get_state(STM),
+ {repeat,wait,6} = gen_statem:call(STM, repeat),
+ [{enter,wait,wait,6}] = flush(),
+ {echo,wait,7} = gen_statem:call(STM, echo),
+ [{enter,start,wait,8},{internal,start,wait,9}] = flush(),
+ {repeat,start,10} = gen_statem:call(STM, repeat),
+ [{enter,start,start,11}] = flush(),
+ {stop,12} = gen_statem:call(STM, {stop,bye}),
[{'EXIT',STM,bye}] = flush(),
{noproc,_} =
@@ -801,6 +816,74 @@ state_timeout(_Config) ->
+%% Test that all event types can be sent with {next_event,EventType,_}
+event_types(_Config) ->
+ process_flag(trap_exit, true),
+
+ Machine =
+ %% Abusing the internal format of From...
+ #{init =>
+ fun () ->
+ {ok, start, undefined}
+ end,
+ start =>
+ fun ({call,_} = Call, Req, undefined) ->
+ {next_state, state1, undefined,
+ [{next_event,internal,1},
+ {next_event,state_timeout,2},
+ {next_event,timeout,3},
+ {next_event,info,4},
+ {next_event,cast,5},
+ {next_event,Call,Req}]}
+ end,
+ state1 =>
+ fun (internal, 1, undefined) ->
+ {next_state, state2, undefined}
+ end,
+ state2 =>
+ fun (state_timeout, 2, undefined) ->
+ {next_state, state3, undefined}
+ end,
+ state3 =>
+ fun (timeout, 3, undefined) ->
+ {next_state, state4, undefined}
+ end,
+ state4 =>
+ fun (info, 4, undefined) ->
+ {next_state, state5, undefined}
+ end,
+ state5 =>
+ fun (cast, 5, undefined) ->
+ {next_state, state6, undefined}
+ end,
+ state6 =>
+ fun ({call,From}, stop, undefined) ->
+ {stop_and_reply, shutdown,
+ [{reply,From,stopped}]}
+ end},
+ {ok,STM} =
+ gen_statem:start_link(
+ ?MODULE, {map_statem,Machine,[]}, [{debug,[trace]}]),
+
+ stopped = gen_statem:call(STM, stop),
+ receive
+ {'EXIT',STM,shutdown} ->
+ ok
+ after 500 ->
+ ct:fail(did_not_stop)
+ end,
+
+ {noproc,_} =
+ ?EXPECT_FAILURE(gen_statem:call(STM, hej), Reason),
+ case flush() of
+ [] ->
+ ok;
+ Other2 ->
+ ct:fail({unexpected,Other2})
+ end.
+
+
+
sys1(Config) ->
{ok,Pid} = gen_statem:start(?MODULE, start_arg(Config, []), []),
{status, Pid, {module,gen_statem}, _} = sys:get_status(Pid),
@@ -1722,6 +1805,10 @@ handle_event(
{keep_state,[NewData|Machine]};
{keep_state,NewData,Ops} ->
{keep_state,[NewData|Machine],Ops};
+ {repeat_state,NewData} ->
+ {repeat_state,[NewData|Machine]};
+ {repeat_state,NewData,Ops} ->
+ {repeat_state,[NewData|Machine],Ops};
Other ->
Other
end;
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index 7d48cbc97c..d546e8fad2 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_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.
@@ -30,7 +30,7 @@
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]).
+ maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1]).
-export([pretty/2]).
@@ -61,7 +61,7 @@ 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].
+ format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175].
%% Error cases for output.
error_1(Config) when is_list(Config) ->
@@ -415,13 +415,13 @@ otp_6354(Config) when is_list(Config) ->
bt(<<"#rrrrr{\n"
" f1 = 1,\n"
" f2 = #rrrrr{f1 = a,f2 = b,f3 = c},\n"
- " f3 = \n"
+ " f3 =\n"
" #rrrrr{\n"
" f1 = h,f2 = i,\n"
- " f3 = \n"
+ " f3 =\n"
" #rrrrr{\n"
" f1 = aa,\n"
- " f2 = \n"
+ " f2 =\n"
" #rrrrr{\n"
" f1 = #rrrrr{f1 = a,f2 = b,f3 = c},\n"
" f2 = 2,f3 = 3},\n"
@@ -431,17 +431,17 @@ otp_6354(Config) when is_list(Config) ->
2,3},bb}}},
-1)),
bt(<<"#d{aaaaaaaaaaaaaaaaaaaa = 1,\n"
- " bbbbbbbbbbbbbbbbbbbb = \n"
+ " bbbbbbbbbbbbbbbbbbbb =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = a,bbbbbbbbbbbbbbbbbbbb = b,\n"
" cccccccccccccccccccc = c,dddddddddddddddddddd = d,\n"
" eeeeeeeeeeeeeeeeeeee = e},\n"
" cccccccccccccccccccc = 3,\n"
- " dddddddddddddddddddd = \n"
+ " dddddddddddddddddddd =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = h,bbbbbbbbbbbbbbbbbbbb = i,\n"
- " cccccccccccccccccccc = \n"
+ " cccccccccccccccccccc =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = aa,"
"bbbbbbbbbbbbbbbbbbbb = bb,\n"
- " cccccccccccccccccccc = \n"
+ " cccccccccccccccccccc =\n"
" #d{aaaaaaaaaaaaaaaaaaaa = 1,"
"bbbbbbbbbbbbbbbbbbbb = 2,\n"
" cccccccccccccccccccc = 3,"
@@ -534,21 +534,21 @@ otp_6354(Config) when is_list(Config) ->
p({A,{A,{A,{A,{A,{A,{A,
{g,{h,{i,{j,{k,{l,{m,{n,{o,{a}}}}}}}}}}}}}}}}}, 100)),
bt(<<"#c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
- " f1 = \n"
+ " f1 =\n"
" #c{\n"
" f1 = #c{f1 = #c{f1 = #c{f1 = a,"
"f2 = b},f2 = b},f2 = b},\n"
@@ -564,13 +564,13 @@ otp_6354(Config) when is_list(Config) ->
p({c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b},
b},b},b},b},b},b}, -1)),
bt(<<"#rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" #rrrrr{\n"
- " f1 = \n"
+ " f1 =\n"
" {rrrrr,{rrrrr,a,#rrrrr{f1 = {rrrrr,1,2},f2 = a,"
"f3 = b}},b},\n"
" f2 = {rrrrr,c,d},\n"
@@ -2106,3 +2106,221 @@ coverage(_Config) ->
io:format("~s\n", [S2]),
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),
+ "#{...}" = p(#{a => 1}, 1),
+ "#{#{} => a}" = p(#{#{} => a}, 2),
+ "#{a => 1,...}" = p(#{a => 1, b => 2}, 2),
+ "#{a => 1,b => 2}" = p(#{a => 1, b => 2}, -1),
+
+ M = #{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,
+ kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,
+ keeeeeeeeeeeeeeeeeee => v5},
+ "#{...}" = p(M, 1),
+ mt("#{kaaaaaaaaaaaaaaaaaaaa => v1,...}", p(M, 2)),
+ mt("#{kaaaaaaaaaaaaaaaaaaaa => 1,kbbbbbbbbbbbbbbbbbbbb => 2,...}",
+ p(M, 3)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,...}", p(M, 4)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,...}",
+ p(M, 5)),
+
+ mt("#{kaaaaaaaaaaaaaaaaaaa => v1,kbbbbbbbbbbbbbbbbbbb => v2,\n"
+ " kccccccccccccccccccc => v3,kddddddddddddddddddd => v4,\n"
+ " keeeeeeeeeeeeeeeeeee => v5}", p(M, 6)),
+
+ weak("#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2,\n"
+ " cccccccccccccccccccc => {3},\n"
+ " dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}",
+ p(#{aaaaaaaaaaaaaaaaaaa => 1,bbbbbbbbbbbbbbbbbbbb => 2,
+ cccccccccccccccccccc => {3},
+ dddddddddddddddddddd => 4,eeeeeeeeeeeeeeeeeeee => 5}, -1)),
+
+ M2 = #{dddddddddddddddddddd => {1}, {aaaaaaaaaaaaaaaaaaaa} => 2,
+ {bbbbbbbbbbbbbbbbbbbb} => 3,{cccccccccccccccccccc} => 4,
+ {eeeeeeeeeeeeeeeeeeee} => 5},
+ "#{...}" = p(M2, 1),
+ weak("#{dddddddddddddddddddd => {...},...}", p(M2, 2)),
+ weak("#{dddddddddddddddddddd => {1},{...} => 2,...}", p(M2, 3)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {...} => 3,...}", p(M2, 4)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {...} => 4,...}", p(M2, 5)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {cccccccccccccccccccc} => 4,\n"
+ " {...} => 5}", p(M2, 6)),
+
+ weak("#{dddddddddddddddddddd => {1},\n"
+ " {aaaaaaaaaaaaaaaaaaaa} => 2,\n"
+ " {bbbbbbbbbbbbbbbbbbbb} => 3,\n"
+ " {cccccccccccccccccccc} => 4,\n"
+ " {eeeeeeeeeeeeeeeeeeee} => 5}", p(M2, 7)),
+
+ M3 = #{kaaaaaaaaaaaaaaaaaaa => vuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu,
+ kbbbbbbbbbbbbbbbbbbb => vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,
+ kccccccccccccccccccc => vxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx,
+ kddddddddddddddddddd => vyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy,
+ keeeeeeeeeeeeeeeeeee => vzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz},
+
+ mt("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu,\n"
+ " bbbbbbbbbbbbbbbbbbbb =>\n"
+ " vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv,\n"
+ " cccccccccccccccccccc =>\n"
+ " xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx,\n"
+ " dddddddddddddddddddd =>\n"
+ " yyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyyy,\n"
+ " eeeeeeeeeeeeeeeeeeee =>\n"
+ " zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz}", p(M3, -1)),
+
+ R4 = {c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,{c,a,b},b},b},b},b},b},
+ b},b},b},b},b},b},
+ M4 = #{aaaaaaaaaaaaaaaaaaaa => R4,
+ bbbbbbbbbbbbbbbbbbbb => R4,
+ cccccccccccccccccccc => R4,
+ dddddddddddddddddddd => R4,
+ eeeeeeeeeeeeeeeeeeee => R4},
+
+ weak("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " #c{f1 = #c{f1 = #c{...},f2 = b},f2 = b},\n"
+ " bbbbbbbbbbbbbbbbbbbb => #c{f1 = #c{f1 = {...},...},f2 = b},\n"
+ " cccccccccccccccccccc => #c{f1 = #c{...},f2 = b},\n"
+ " dddddddddddddddddddd => #c{f1 = {...},...},\n"
+ " eeeeeeeeeeeeeeeeeeee => #c{...}}", p(M4, 7)),
+
+ M5 = #{aaaaaaaaaaaaaaaaaaaa => R4},
+ mt("#{aaaaaaaaaaaaaaaaaaaa =>\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 =\n"
+ " #c{\n"
+ " f1 = #c{f1 = #c{f1 = #c{f1 = a,f2 = b},f2 = b},"
+ "f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b},\n"
+ " f2 = b}}", p(M5, -1)),
+ ok.
+
+%% Just check number of newlines and dots ('...').
+-define(WEAK, true).
+
+-ifdef(WEAK).
+
+weak(S, R) ->
+ (nl(S) =:= nl(R) andalso
+ dots(S) =:= dots(S)).
+
+nl(S) ->
+ [C || C <- S, C =:= $\n].
+
+dots(S) ->
+ [C || C <- S, C =:= $\.].
+
+-else. % WEAK
+
+weak(S, R) ->
+ mt(S, R).
+
+-endif. % WEAK
+
+%% If EXACT is defined: mt() matches strings exactly.
+%%
+%% if EXACT is not defined: do not match the strings exactly, but
+%% compare them assuming that all map keys and all map values are
+%% equal (by assuming all map keys and all map values have the same
+%% length and begin with $k and $v respectively).
+
+%-define(EXACT, true).
+
+-ifdef(EXACT).
+
+mt(S, R) ->
+ S =:= R.
+
+-else. % EXACT
+
+mt(S, R) ->
+ anon(S) =:= anon(R).
+
+anon(S) ->
+ {ok, Ts0, _} = erl_scan:string(S, 1, [text]),
+ Ts = anon1(Ts0),
+ text(Ts).
+
+anon1([]) -> [];
+anon1([{atom,Anno,Atom}=T|Ts]) ->
+ case erl_anno:text(Anno) of
+ "k" ++ _ ->
+ NewAnno = erl_anno:set_text("key", Anno),
+ [{atom,NewAnno,Atom}|anon1(Ts)];
+ "v" ++ _ ->
+ NewAnno = erl_anno:set_text("val", Anno),
+ [{atom,NewAnno,Atom}|anon1(Ts)];
+ _ ->
+ [T|anon1(Ts)]
+ end;
+anon1([T|Ts]) ->
+ [T|anon1(Ts)].
+
+text(Ts) ->
+ lists:append(text1(Ts)).
+
+text1([]) -> [];
+text1([T|Ts]) ->
+ Anno = element(2, T),
+ [erl_anno:text(Anno) | text1(Ts)].
+
+-endif. % EXACT
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/qlc_SUITE.erl b/lib/stdlib/test/qlc_SUITE.erl
index c08e138ad3..2b5d52287e 100644
--- a/lib/stdlib/test/qlc_SUITE.erl
+++ b/lib/stdlib/test/qlc_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.
@@ -886,11 +886,12 @@ eval_unique(Config) when is_list(Config) ->
[a] = qlc:e(Q2, {unique_all, true})
">>,
- <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1]],unique)],
+ <<"Q = qlc:q([SQV || SQV <- qlc:q([X || X <- [1,2,1,#{a => 1}]],
+ unique)],
unique),
{call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} =
qlc:info(Q, [{format,abstract_code},unique_all]),
- [1,2] = qlc:e(Q)">>,
+ [1,2,#{a := 1}] = qlc:e(Q)">>,
<<"Q = qlc:q([X || X <- [1,2,1]]),
{call,_,_,[{lc,_,{var,_,'X'},[{generate,_,{var,_,'X'},_}]},_]} =
@@ -2637,7 +2638,16 @@ info(Config) when is_list(Config) ->
{cons, _, _, _}]},
{nil,_}}]}]} = i(QH, {format, abstract_code}),
[{5},{6}] = qlc:e(QH),
- [{4},{5},{6}] = qlc:e(F(3))">>
+ [{4},{5},{6}] = qlc:e(F(3))">>,
+
+ <<"Fun = fun ?MODULE:i/2,
+ L = [{#{k => #{v => Fun}}, Fun}],
+ H = qlc:q([Q || Q <- L, Q =:= {#{k => #{v => Fun}}, Fun}]),
+ L = qlc:e(H),
+ {call,_,_,[{lc,_,{var,_,'Q'},
+ [{generate,_,_,_},
+ {op,_,_,_,_}]}]} =
+ qlc:info(H, [{format,abstract_code}])">>
],
run(Config, Ts),
diff --git a/lib/stdlib/test/rand_SUITE.erl b/lib/stdlib/test/rand_SUITE.erl
index 8e7ac223a7..fe5eaccda5 100644
--- a/lib/stdlib/test/rand_SUITE.erl
+++ b/lib/stdlib/test/rand_SUITE.erl
@@ -283,13 +283,13 @@ gen(_, _, Acc) -> lists:reverse(Acc).
%% Check that the algorithms generate sound values.
basic_stats_uniform_1(Config) when is_list(Config) ->
- ct:timetrap({minutes,6}), %% valgrind needs a lot of time
+ ct:timetrap({minutes,15}), %% valgrind needs a lot of time
[basic_uniform_1(?LOOP, rand:seed_s(Alg), 0.0, array:new([{default, 0}]))
|| Alg <- algs()],
ok.
basic_stats_uniform_2(Config) when is_list(Config) ->
- ct:timetrap({minutes,6}), %% valgrind needs a lot of time
+ ct:timetrap({minutes,15}), %% valgrind needs a lot of time
[basic_uniform_2(?LOOP, rand:seed_s(Alg), 0, array:new([{default, 0}]))
|| Alg <- algs()],
ok.
@@ -396,7 +396,7 @@ crypto_uniform_n(N, State0) ->
%% Not a test but measures the time characteristics of the different algorithms
measure(Suite) when is_atom(Suite) -> [];
measure(_Config) ->
- ct:timetrap({minutes,6}), %% valgrind needs a lot of time
+ ct:timetrap({minutes,15}), %% valgrind needs a lot of time
Algos = [crypto64|algs()],
io:format("RNG uniform integer performance~n",[]),
_ = measure_1(random, fun(State) -> {int, random:uniform_s(10000, State)} end),
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 a40800d760..563e0001e4 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 02987971fa..b39cb53a55 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 ae56db59d6..b62674d6e0 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]) ->
@@ -981,7 +920,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]),
@@ -1024,7 +963,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)),
@@ -1035,7 +974,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)),
@@ -1046,7 +985,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)),
@@ -1071,7 +1010,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 15ccdea284..4864bc3d72 100644
--- a/lib/stdlib/test/shell_SUITE.erl
+++ b/lib/stdlib/test/shell_SUITE.erl
@@ -282,7 +282,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" =
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..d6b6d3f80c 100644
--- a/lib/stdlib/test/tar_SUITE.erl
+++ b/lib/stdlib/test/tar_SUITE.erl
@@ -22,9 +22,10 @@
-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,
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 +36,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() ->
[].
@@ -84,17 +88,30 @@ borderline(Config) when is_list(Config) ->
ok.
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 +120,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.
@@ -336,6 +358,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,7 +380,7 @@ 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.
@@ -370,8 +393,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]),
@@ -493,6 +518,27 @@ extract_from_binary_compressed(Config) when is_list(Config) ->
ok.
+%% 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]),
+
+ ok.
+
%% Test extracting a tar archive from an open file.
extract_from_open_file(Config) when is_list(Config) ->
DataDir = proplists:get_value(data_dir, Config),
@@ -573,6 +619,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 +628,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 +667,50 @@ 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),
ok.
+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,17 +728,26 @@ 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]),
@@ -718,6 +812,41 @@ memory(Config) when is_list(Config) ->
ok = delete_files([Name1,Name2]),
ok.
+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).
+
+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).
+
+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) ->
run_unicode_node(Config, "+fnu"),
@@ -753,6 +882,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 +982,15 @@ 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.
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/tar_SUITE_data/sparse00.tar b/lib/stdlib/test/tar_SUITE_data/sparse00.tar
new file mode 100644
index 0000000000..61a04de90b
--- /dev/null
+++ b/lib/stdlib/test/tar_SUITE_data/sparse00.tar
Binary files differ
diff --git a/lib/stdlib/test/tar_SUITE_data/sparse01.tar b/lib/stdlib/test/tar_SUITE_data/sparse01.tar
new file mode 100644
index 0000000000..61a04de90b
--- /dev/null
+++ 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/tar_SUITE_data/sparse10.tar b/lib/stdlib/test/tar_SUITE_data/sparse10.tar
new file mode 100644
index 0000000000..61a04de90b
--- /dev/null
+++ 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/zip_SUITE.erl b/lib/stdlib/test/zip_SUITE.erl
index 7d90795c9e..f0feda217a 100644
--- a/lib/stdlib/test/zip_SUITE.erl
+++ b/lib/stdlib/test/zip_SUITE.erl
@@ -27,7 +27,7 @@
openzip_api/1, zip_api/1, open_leak/1, unzip_jar/1,
unzip_traversal_exploit/1,
compress_control/1,
- foldl/1]).
+ foldl/1,fd_leak/1]).
-include_lib("common_test/include/ct.hrl").
-include_lib("kernel/include/file.hrl").
@@ -40,7 +40,7 @@ all() ->
unzip_to_binary, zip_to_binary, unzip_options,
zip_options, list_dir_options, aliases, openzip_api,
zip_api, open_leak, unzip_jar, compress_control, foldl,
- unzip_traversal_exploit].
+ unzip_traversal_exploit,fd_leak].
groups() ->
[].
@@ -882,3 +882,35 @@ foldl(Config) ->
{error, enoent} = zip:foldl(ZipFun, [], File),
ok.
+
+fd_leak(Config) ->
+ ok = file:set_cwd(proplists:get_value(priv_dir, Config)),
+ DataDir = proplists:get_value(data_dir, Config),
+ Name = filename:join(DataDir, "bad_file_header.zip"),
+ BadExtract = fun() ->
+ {error,bad_file_header} = zip:extract(Name),
+ ok
+ end,
+ do_fd_leak(BadExtract, 1),
+
+ BadCreate = fun() ->
+ {error,enoent} = zip:zip("failed.zip",
+ ["none"]),
+ ok
+ end,
+ do_fd_leak(BadCreate, 1),
+
+ ok.
+
+do_fd_leak(_Bad, 10000) ->
+ ok;
+do_fd_leak(Bad, N) ->
+ try Bad() of
+ ok ->
+ do_fd_leak(Bad, N + 1)
+ catch
+ C:R ->
+ Stk = erlang:get_stacktrace(),
+ io:format("Bad error after ~p attempts\n", [N]),
+ erlang:raise(C, R, Stk)
+ end.